GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-25 18:58:56 -06:00
Code Issues Packages Projects Releases Wiki Activity

code polishing for the literal category support

Browse Source
This commit is contained in:
kr.angelov
2006-06-08 21:23:29 +00:00
parent 98d0af8d73
commit 694f6eb984
12 changed files with 120 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Formalism/CFG.hs
View File

@@ -33,8 +33,8 @@ type CFChart c n t = CFGrammar (Edge c) n t
-- building syntax charts from grammars -- building syntax charts from grammars
grammar2chart :: (Ord n, Ord e) => CFGrammar e n t -> SyntaxChart n e grammar2chart :: (Ord n, Ord e) => CFGrammar e n t -> SyntaxChart n e
grammar2chart cfchart = accumAssoc groupPairs $ grammar2chart cfchart = accumAssoc groupSyntaxNodes $
[ (lhs, (name, filterCats rhs)) | [ (lhs, SNode name (filterCats rhs)) |
CFRule lhs rhs name <- cfchart ] CFRule lhs rhs name <- cfchart ]

4
src/GF/Formalism/GCFG.hs
View File

@@ -29,10 +29,6 @@ data Abstract cat name = Abs cat [cat] name
data Concrete lin term = Cnc lin [lin] term data Concrete lin term = Cnc lin [lin] term
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
abstract2chart :: (Ord n, Ord e) => [Abstract e n] -> SyntaxChart n e
abstract2chart rules = accumAssoc groupPairs $
[ (e, (n, es)) | Abs e es n <- rules ]
---------------------------------------------------------------------- ----------------------------------------------------------------------
instance (Print c, Print n, Print l, Print t) => Print (Rule n c l t) where instance (Print c, Print n, Print l, Print t) => Print (Rule n c l t) where

30
src/GF/Formalism/Utilities.hs
View File

@@ -112,7 +112,28 @@ inputMany toks = MkInput inEdges inBounds inFrom inTo inToken
-- | The values of the chart, a list of key-daughters pairs, -- | The values of the chart, a list of key-daughters pairs,
-- has unique keys. In essence, it is a map from 'n' to daughters. -- has unique keys. In essence, it is a map from 'n' to daughters.
-- The daughters should be a set (not necessarily sorted) of rhs's. -- The daughters should be a set (not necessarily sorted) of rhs's.
type SyntaxChart n e = Assoc e [(n, [[e]])] type SyntaxChart n e = Assoc e [SyntaxNode n [e]]
data SyntaxNode n e = SMeta
| SNode n [e]
| SString String
| SInt Integer
| SFloat Double
deriving (Eq,Ord)
groupSyntaxNodes :: Ord n => [SyntaxNode n e] -> [SyntaxNode n [e]]
groupSyntaxNodes [] = []
groupSyntaxNodes (SNode n0 es0:xs) = (SNode n0 (es0:ess)) : groupSyntaxNodes xs'
where
(ess,xs') = span xs
span [] = ([],[])
span xs@(SNode n es:xs')
| n0 == n = let (ess,xs) = span xs' in (es:ess,xs)
| otherwise = ([],xs)
groupSyntaxNodes (SString s:xs) = (SString s) : groupSyntaxNodes xs
groupSyntaxNodes (SInt n:xs) = (SInt n) : groupSyntaxNodes xs
groupSyntaxNodes (SFloat f:xs) = (SFloat f) : groupSyntaxNodes xs
-- better(?) representation of forests: -- better(?) representation of forests:
-- data Forest n = F (SMap n (SList [Forest n])) Bool -- data Forest n = F (SMap n (SList [Forest n])) Bool
@@ -240,7 +261,12 @@ chart2forests :: (Ord n, Ord e) =>
chart2forests chart isMeta = concatMap edge2forests chart2forests chart isMeta = concatMap edge2forests
where edge2forests edge = if isMeta edge then [FMeta] where edge2forests edge = if isMeta edge then [FMeta]
else map item2forest $ chart ? edge else map item2forest $ chart ? edge
item2forest (name, children) = FNode name $ children >>= mapM edge2forests item2forest (SMeta) = FMeta
item2forest (SNode name children) = FNode name $ children >>= mapM edge2forests
item2forest (SString s) = FString s
item2forest (SInt n) = FInt n
item2forest (SFloat f) = FFloat f
{- {-
-- more intelligent(?) implementation, -- more intelligent(?) implementation,

130
src/GF/Parsing/FCFG/Active.hs
View File

@@ -35,7 +35,7 @@ import Data.Array
-- * parsing -- * parsing
parse :: (Ord c, Ord n, Ord t) => String -> FCFParser c n t parse :: (Ord c, Ord n, Ord t) => String -> FCFParser c n t
parse strategy pinfo starts toks = xchart2forests chart pinfo starts toks parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
where chart = process strategy pinfo toks axioms emptyXChart where chart = process strategy pinfo toks axioms emptyXChart
axioms | isBU strategy = terminal pinfo toks ++ initialScan pinfo toks axioms | isBU strategy = terminal pinfo toks ++ initialScan pinfo toks
@@ -45,115 +45,91 @@ isBU s = s=="b"
isTD s = s=="t" isTD s = s=="t"
-- used in prediction -- used in prediction
emptyChildren :: Abstract c n -> [RangeRec] emptyChildren :: RuleId -> FCFPInfo c n t -> SyntaxNode RuleId RangeRec
emptyChildren (Abs _ rhs _) = replicate (length rhs) [] emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
where
FRule (Abs _ rhs _) _ = allRules pinfo ! ruleid
updateChildren :: [RangeRec] -> Int -> RangeRec -> [[RangeRec]] updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> [SyntaxNode RuleId RangeRec]
updateChildren recs i rec = updateNthM update i recs updateChildren (SNode ruleid recs) i rec = do
where update rec' = do guard (null rec' || rec' == rec) recs <- updateNthM update i recs
return rec return (SNode ruleid recs)
where
update rec' = guard (null rec' || rec' == rec) >> return rec
makeMaxRange (Range _ j) = Range j j makeMaxRange (Range _ j) = Range j j
makeMaxRange EmptyRange = EmptyRange makeMaxRange EmptyRange = EmptyRange
process :: (Ord c, Ord n, Ord t) => String -> FCFPInfo c n t -> Input t -> [Item c] -> XChart c -> XChart c process :: (Ord c, Ord n, Ord t) => String -> FCFPInfo c n t -> Input t -> [(c,Item)] -> XChart c -> XChart c
process strategy pinfo toks [] chart = chart process strategy pinfo toks [] chart = chart
process strategy pinfo toks (item:items) chart = process strategy pinfo toks items $! univRule item chart process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
where where
univRule item@(Active ruleid found rng lbl ppos recs) chart univRule cat item@(Active found rng lbl ppos node@(SNode ruleid _)) chart
| inRange (bounds lin) ppos = | inRange (bounds lin) ppos =
case lin ! ppos of case lin ! ppos of
FSymCat c r d -> case insertXChart chart item c of FSymCat c r d -> case insertXChart chart item c of
Nothing -> chart Nothing -> chart
Just chart -> let items = do item <- lookupXChartFinal chart c Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c
let found' = case item of rng <- concatRange rng (found' !! r)
Final _ found' _ -> found' node <- updateChildren node d found'
Literal _ found' _ -> found' return (c, Active found rng lbl (ppos+1) node)
rng' <- concatRange rng (found' !! r)
recs' <- updateChildren recs d found'
return (Active ruleid found rng' lbl (ppos+1) recs')
++ ++
do guard (isTD strategy) do guard (isTD strategy)
ruleid <- topdownRules pinfo ? c ruleid <- topdownRules pinfo ? c
let FRule abs lins = allRules pinfo ! ruleid return (c, Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))
return (Active ruleid [] EmptyRange 0 0 (emptyChildren abs))
in process strategy pinfo toks items chart in process strategy pinfo toks items chart
FSymTok tok -> let items = do (i,j) <- inputToken toks ? tok FSymTok tok -> let items = do (i,j) <- inputToken toks ? tok
rng' <- concatRange rng (makeRange i j) rng' <- concatRange rng (makeRange i j)
return (Active ruleid found rng' lbl (ppos+1) recs) return (cat, Active found rng' lbl (ppos+1) node)
in process strategy pinfo toks items chart in process strategy pinfo toks items chart
| otherwise = | otherwise =
if inRange (bounds lins) (lbl+1) if inRange (bounds lins) (lbl+1)
then univRule (Active ruleid (rng:found) EmptyRange (lbl+1) 0 recs) chart then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart
else univRule (Final ruleid (reverse (rng:found)) recs) chart else univRule cat (Final (reverse (rng:found)) node) chart
where where
(FRule (Abs cat _ fn) lins) = allRules pinfo ! ruleid (FRule (Abs cat _ fn) lins) = allRules pinfo ! ruleid
lin = lins ! lbl lin = lins ! lbl
univRule item@(Final ruleid found' recs) chart = univRule cat item@(Final found' node) chart =
case insertXChart chart item cat of case insertXChart chart item cat of
Nothing -> chart Nothing -> chart
Just chart -> let items = do (Active ruleid found rng l ppos recs) <- lookupXChartAct chart cat Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
let FRule _ lins = allRules pinfo ! ruleid let FRule _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos FSymCat cat r d = lins ! l ! ppos
rng' <- concatRange rng (found' !! r) rng <- concatRange rng (found' !! r)
recs' <- updateChildren recs d found' node <- updateChildren node d found'
return (Active ruleid found rng' l (ppos+1) recs') return (cat, Active found rng l (ppos+1) node)
++ ++
do guard (isBU strategy) do guard (isBU strategy)
ruleid <- leftcornerCats pinfo ? cat ruleid <- leftcornerCats pinfo ? cat
let FRule abs lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0
return (Active ruleid [] (found' !! r) 0 1 (updateNth (const found') d (emptyChildren abs)))
in process strategy pinfo toks items chart
where
(FRule (Abs cat _ _) _) = allRules pinfo ! ruleid
univRule item@(Literal cat found' t) chart =
case insertXChart chart item cat of
Nothing -> chart
Just chart -> let items = do (Active ruleid found rng l ppos recs) <- lookupXChartAct chart cat
let FRule _ lins = allRules pinfo ! ruleid let FRule _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos
rng' <- concatRange rng (found' !! r)
recs' <- updateChildren recs d found'
return (Active ruleid found rng' l (ppos+1) recs')
++
do guard (isBU strategy)
ruleid <- leftcornerCats pinfo ? cat
let FRule abs lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0 FSymCat cat r d = lins ! 0 ! 0
return (Active ruleid [] (found' !! r) 0 1 (updateNth (const found') d (emptyChildren abs))) node <- updateChildren (emptyChildren ruleid pinfo) d found'
return (cat, Active [] (found' !! r) 0 1 node)
in process strategy pinfo toks items chart in process strategy pinfo toks items chart
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- * XChart -- * XChart
data Item c data Item
= Active {-# UNPACK #-} !RuleId = Active RangeRec
RangeRec
Range Range
{-# UNPACK #-} !FLabel {-# UNPACK #-} !FLabel
{-# UNPACK #-} !FPointPos {-# UNPACK #-} !FPointPos
[RangeRec] (SyntaxNode RuleId RangeRec)
| Final {-# UNPACK #-} !RuleId RangeRec [RangeRec] | Final RangeRec (SyntaxNode RuleId RangeRec)
| Literal c RangeRec (SyntaxTree RuleId)
deriving (Eq, Ord) deriving (Eq, Ord)
data XChart c = XChart !(ParseChart (Item c) c) !(ParseChart (Item c) c) data XChart c = XChart !(ParseChart Item c) !(ParseChart Item c)
emptyXChart :: Ord c => XChart c emptyXChart :: Ord c => XChart c
emptyXChart = XChart emptyChart emptyChart emptyXChart = XChart emptyChart emptyChart
insertXChart (XChart actives finals) item@(Active _ _ _ _ _ _) c = insertXChart (XChart actives finals) item@(Active _ _ _ _ _) c =
case chartInsert actives item c of case chartInsert actives item c of
Nothing -> Nothing Nothing -> Nothing
Just actives -> Just (XChart actives finals) Just actives -> Just (XChart actives finals)
insertXChart (XChart actives finals) item@(Final _ _ _) c = insertXChart (XChart actives finals) item@(Final _ _) c =
case chartInsert finals item c of
Nothing -> Nothing
Just finals -> Just (XChart actives finals)
insertXChart (XChart actives finals) item@(Literal _ _ _) c =
case chartInsert finals item c of case chartInsert finals item c of
Nothing -> Nothing Nothing -> Nothing
Just finals -> Just (XChart actives finals) Just finals -> Just (XChart actives finals)
@@ -161,27 +137,17 @@ insertXChart (XChart actives finals) item@(Literal _ _ _) c =
lookupXChartAct (XChart actives finals) c = chartLookup actives c lookupXChartAct (XChart actives finals) c = chartLookup actives c
lookupXChartFinal (XChart actives finals) c = chartLookup finals c lookupXChartFinal (XChart actives finals) c = chartLookup finals c
xchart2forests :: (Ord c, Ord n, Ord t) => XChart c -> FCFParser c n t xchart2syntaxchart :: (Ord c, Ord n, Ord t) => XChart c -> FCFPInfo c n t -> SyntaxChart n (c,RangeRec)
xchart2forests (XChart actives finals) pinfo starts toks = concatMap (edge2forests . makeFinalEdge) starts xchart2syntaxchart (XChart actives finals) pinfo =
where accumAssoc groupSyntaxNodes $
assocs = accumAssoc groupPairs $ [ case node of
[ case item of SNode ruleid rrecs -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid
Final ruleid found rrecs -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid in ((cat,found), SNode fun (zip rhs rrecs))
in ((cat,found), (FNode fun [], zip rhs rrecs)) SString s -> ((cat,found), SString s)
Literal cat found (TString s) -> ((cat,found), (FString s, [])) SInt n -> ((cat,found), SInt n)
Literal cat found (TInt n) -> ((cat,found), (FInt n, [])) SFloat f -> ((cat,found), SFloat f)
Literal cat found (TFloat f) -> ((cat,found), (FFloat f, [])) | (cat, Final found node) <- chartAssocs finals
| item <- chartList finals
] ]
edge2forests edge@(cat,_) = map (item2forest cat) $ assocs ? edge
item2forest cat (FNode name _, children) = FNode name $ children >>= mapM edge2forests
item2forest cat (t , children) = t
makeFinalEdge cat =
case inputBounds toks of
(0,0) -> (cat, [EmptyRange] )
(i,j) -> (cat, [makeRange i j])
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Earley -- -- Earley --
@@ -192,8 +158,7 @@ initial pinfo starts toks =
tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $ tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
do cat <- starts do cat <- starts
ruleid <- topdownRules pinfo ? cat ruleid <- topdownRules pinfo ? cat
let FRule abs lins = allRules pinfo ! ruleid return (cat,Active [] (Range 0 0) 0 0 (emptyChildren ruleid pinfo))
return $ Active ruleid [] (Range 0 0) 0 0 (emptyChildren abs)
---------------------------------------------------------------------- ----------------------------------------------------------------------
@@ -220,4 +185,3 @@ initialScan pinfo toks =
epsilonRules pinfo epsilonRules pinfo
let FRule abs lins = allRules pinfo ! ruleid let FRule abs lins = allRules pinfo ! ruleid
return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs) return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs)

9
src/GF/Parsing/FCFG/PInfo.hs
View File

@@ -29,7 +29,10 @@ import Data.Maybe
type FCFParser c n t = FCFPInfo c n t type FCFParser c n t = FCFPInfo c n t
-> [c] -> [c]
-> Input t -> Input t
-> [SyntaxForest n] -> SyntaxChart n (c,RangeRec)
makeFinalEdge cat 0 0 = (cat, [EmptyRange])
makeFinalEdge cat i j = (cat, [makeRange i j])
------------------------------------------------------------ ------------------------------------------------------------
-- parser information -- parser information
@@ -48,7 +51,7 @@ data FCFPInfo c n t
-- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury): -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
, grammarCats :: SList c , grammarCats :: SList c
, grammarToks :: SList t , grammarToks :: SList t
, grammarLexer :: t -> (c,SyntaxTree RuleId) , grammarLexer :: t -> (c,SyntaxNode RuleId RangeRec)
} }
@@ -68,7 +71,7 @@ getLeftCornerCat lins
where where
syms = lins ! 0 syms = lins ! 0
buildFCFPInfo :: (Ord c, Ord n, Ord t) => (t -> (c,SyntaxTree RuleId)) -> FCFGrammar c n t -> FCFPInfo c n t buildFCFPInfo :: (Ord c, Ord n, Ord t) => (t -> (c,SyntaxNode RuleId RangeRec)) -> FCFGrammar c n t -> FCFPInfo c n t
buildFCFPInfo lexer grammar = buildFCFPInfo lexer grammar =
traceCalcFirst grammar $ traceCalcFirst grammar $
tracePrt "MCFG.PInfo - parser info" (prt) $ tracePrt "MCFG.PInfo - parser info" (prt) $

16
src/GF/Parsing/GFC.hs
View File

@@ -60,10 +60,10 @@ buildPInfo mcfg fcfg cfg = PInfo { mcfPInfo = PM.buildMCFPInfo mcfg
where where
grammarLexer s = grammarLexer s =
case reads s of case reads s of
[(n::Integer,"")] -> (fcatInt, TInt n) [(n::Integer,"")] -> (fcatInt, SInt n)
_ -> case reads s of _ -> case reads s of
[(f::Double,"")] -> (fcatFloat, TFloat f) [(f::Double,"")] -> (fcatFloat, SFloat f)
_ -> (fcatString,TString s) _ -> (fcatString,SString s)
instance Print PInfo where instance Print PInfo where
@@ -119,10 +119,7 @@ selectParser "m" strategy pinfo startCat inTokens
isStart cat = mcat2scat cat == cfCat2Ident startCat isStart cat = mcat2scat cat == cfCat2Ident startCat
mcfpi = mcfPInfo pinfo mcfpi = mcfPInfo pinfo
mcfParser <- PM.parseMCF strategy mcfParser <- PM.parseMCF strategy
let mcfChart = tracePrt "Parsing.GFC - MCF chart" (prt . length) $ let chart = mcfParser mcfpi startCats inTokens
mcfParser mcfpi startCats inTokens
chart = tracePrt "Parsing.GFC - chart" (prt . length . concat . map snd . aAssocs) $
G.abstract2chart mcfChart
finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $ finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $
[ PM.makeFinalEdge cat lbl (inputBounds inTokens) | [ PM.makeFinalEdge cat lbl (inputBounds inTokens) |
cat@(MCat _ [lbl]) <- startCats ] cat@(MCat _ [lbl]) <- startCats ]
@@ -134,7 +131,10 @@ selectParser "f" strategy pinfo startCat inTokens
isStart cat = fcat2scat cat == cfCat2Ident startCat isStart cat = fcat2scat cat == cfCat2Ident startCat
fcfpi = fcfPInfo pinfo fcfpi = fcfPInfo pinfo
fcfParser <- PF.parseFCF strategy fcfParser <- PF.parseFCF strategy
return $ fcfParser fcfpi startCats inTokens let chart = fcfParser fcfpi startCats inTokens
(i,j) = inputBounds inTokens
finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats]
return $ chart2forests chart (const False) finalEdges
-- error parser: -- error parser:
selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy

10
src/GF/Parsing/MCFG/Active.hs
View File

@@ -34,17 +34,15 @@ import GF.Infra.Print
parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
parse strategy pinfo starts toks = parse strategy pinfo starts toks =
trace2 "MCFG.Active - strategy" (if isBU strategy then "BU" accumAssoc groupSyntaxNodes $
else if isTD strategy then "TD" else "None") $ [ ((cat, found), SNode fun (zip rhs rrecs)) |
[ Abs (cat, found) (zip rhs rrecs) fun |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = process strategy pinfo starts toks where chart = process strategy pinfo starts toks
-- parseR :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t -- parseR :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
parseR strategy pinfo starts = parseR strategy pinfo starts =
trace2 "MCFG.Active Range - strategy" (if isBU strategy then "BU" accumAssoc groupSyntaxNodes $
else if isTD strategy then "TD" else "None") $ [ ((cat, found), SNode fun (zip rhs rrecs)) |
[ Abs (cat, found) (zip rhs rrecs) fun |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = processR strategy pinfo starts where chart = processR strategy pinfo starts

5
src/GF/Parsing/MCFG/Active2.hs
View File

@@ -34,9 +34,8 @@ import GF.Infra.Print
--parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t --parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
parse strategy pinfo starts toks = parse strategy pinfo starts toks =
trace2 "MCFG.Active 2 - strategy" (if isBU strategy then "BU" accumAssoc groupSyntaxNodes $
else if isTD strategy then "TD" else "None") $ [ ((cat, found), SNode fun (zip rhs rrecs)) |
[ Abs (cat, found) (zip rhs rrecs) fun |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = process strategy pinfo starts toks where chart = process strategy pinfo starts toks

7
src/GF/Parsing/MCFG/Incremental.hs
View File

@@ -18,6 +18,7 @@ import Control.Monad (guard)
import GF.Data.Utilities (select) import GF.Data.Utilities (select)
import GF.Data.GeneralDeduction import GF.Data.GeneralDeduction
import GF.Data.Assoc
import GF.Formalism.GCFG import GF.Formalism.GCFG
import GF.Formalism.MCFG import GF.Formalism.MCFG
@@ -34,14 +35,16 @@ import GF.Infra.Print
parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parse pinfo starts toks = parse pinfo starts toks =
[ Abs (cat, found) (zip rhs rrecs) fun | accumAssoc groupSyntaxNodes $
[ ((cat, found), SNode fun (zip rhs rrecs)) |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = process pinfo toks ntoks where chart = process pinfo toks ntoks
ntoks = snd (inputBounds toks) ntoks = snd (inputBounds toks)
-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t -- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parseR pinfo starts ntoks = parseR pinfo starts ntoks =
[ Abs (cat, found) (zip rhs rrecs) fun | accumAssoc groupSyntaxNodes $
[ ((cat, found), SNode fun (zip rhs rrecs)) |
Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
where chart = processR pinfo ntoks where chart = processR pinfo ntoks

3
src/GF/Parsing/MCFG/Incremental2.hs
View File

@@ -36,7 +36,8 @@ import GF.Infra.Print
-- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t -- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
parse pinfo starts inp = parse pinfo starts inp =
[ Abs (cat, found) (zip rhs rrecs) fun | accumAssoc groupSyntaxNodes $
[ ((cat, found), SNode fun (zip rhs rrecs)) |
k <- uncurry enumFromTo (inputBounds inp), k <- uncurry enumFromTo (inputBounds inp),
Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ] Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
where chart = process pinfo inp where chart = process pinfo inp

6
src/GF/Parsing/MCFG/Naive.hs
View File

@@ -34,14 +34,16 @@ import GF.Infra.Print
-- | Builds a chart from the initial agenda, given by prediction, and the inference rules -- | Builds a chart from the initial agenda, given by prediction, and the inference rules
parse :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t parse :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
parse pinfo starts toks parse pinfo starts toks
= [ Abs (cat, makeRangeRec lins) (zip rhs rrecs) fun | = accumAssoc groupSyntaxNodes $
[ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ] Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
where chart = process pinfo toks where chart = process pinfo toks
-- | Builds a chart from the initial agenda, given by prediction, and the inference rules -- | Builds a chart from the initial agenda, given by prediction, and the inference rules
-- parseR :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t -- parseR :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
parseR pinfo starts parseR pinfo starts
= [ Abs (cat, makeRangeRec lins) (zip rhs rrecs) fun | = accumAssoc groupSyntaxNodes $
[ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ] Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
where chart = processR pinfo where chart = processR pinfo

4
src/GF/Parsing/MCFG/PInfo.hs
View File

@@ -30,9 +30,7 @@ import GF.Parsing.MCFG.Range
type MCFParser c n l t = MCFPInfo c n l t type MCFParser c n l t = MCFPInfo c n l t
-> [c] -> [c]
-> Input t -> Input t
-> MCFChart c n l -> SyntaxChart n (c, RangeRec l)
type MCFChart c n l = [Abstract (c, RangeRec l) n]
makeFinalEdge :: c -> l -> (Int, Int) -> (c, RangeRec l) makeFinalEdge :: c -> l -> (Int, Int) -> (c, RangeRec l)
makeFinalEdge cat lbl bnds = (cat, [(lbl, makeRange bnds)]) makeFinalEdge cat lbl bnds = (cat, [(lbl, makeRange bnds)])