msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

GFCC to FCFG conversion

Browse Source
This commit is contained in:
kr_angelov
2006-12-28 16:45:57 +00:00
parent 094cab7057
commit 82ca4a89df
11 changed files with 276 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Parsing/FCFG.hs
View File

@@ -23,12 +23,12 @@ import GF.Infra.Print
----------------------------------------------------------------------
-- parsing
parseFCF :: (Print c, Ord c, Print n, Ord n, Print t, Ord t) => String -> Err (FCFParser c n t)
parseFCF :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> Err (FCFParser c n t)
parseFCF prs | prs `elem` strategies = Ok $ parseFCF' prs
| otherwise = Bad $ "FCFG parsing strategy not defined: " ++ prs
strategies = words "bottomup topdown"
parseFCF' :: (Print c, Ord c, Print n, Ord n, Print t, Ord t) => String -> FCFParser c n t
parseFCF' :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> FCFParser c n t
parseFCF' "bottomup" pinfo starts toks = Active.parse "b" pinfo starts toks
parseFCF' "topdown" pinfo starts toks = Active.parse "t" pinfo starts toks

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

@@ -20,6 +20,7 @@ import GF.Formalism.MCFG(Lin(..))
import GF.Formalism.Utilities
import GF.Infra.Ident
import GF.Infra.Print
import GF.Parsing.FCFG.Range
import GF.Parsing.FCFG.PInfo
@@ -34,7 +35,7 @@ import Data.Array
----------------------------------------------------------------------
-- * parsing
parse :: (Ord c, Ord n, Ord t) => String -> FCFParser c n t
parse :: (Print c, Ord c, Ord n, Print t, Ord t) => String -> FCFParser c n t
parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
where chart = process strategy pinfo toks axioms emptyXChart
axioms | isBU strategy = literals pinfo toks ++ initialBU pinfo toks
@@ -47,7 +48,7 @@ isTD s = s=="t"
emptyChildren :: RuleId -> FCFPInfo c n t -> SyntaxNode RuleId RangeRec
emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
where
FRule (Abs _ rhs _) _ = allRules pinfo ! ruleid
FRule _ rhs _ _ = allRules pinfo ! ruleid
updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> [SyntaxNode RuleId RangeRec]
updateChildren (SNode ruleid recs) i rec = do
@@ -59,7 +60,7 @@ updateChildren (SNode ruleid recs) i rec = do
makeMaxRange (Range _ j) = Range j j
makeMaxRange EmptyRange = EmptyRange
process :: (Ord c, Ord n, Ord t) => String -> FCFPInfo c n t -> Input t -> [(c,Item)] -> XChart c -> XChart c
process :: (Print c, Ord c, Ord n, Print t, 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 ((c,item):items) chart = process strategy pinfo toks items $! univRule c item chart
where
@@ -86,22 +87,22 @@ process strategy pinfo toks ((c,item):items) chart = process strategy pinfo toks
then univRule cat (Active (rng:found) EmptyRange (lbl+1) 0 node) chart
else univRule cat (Final (reverse (rng:found)) node) chart
where
(FRule (Abs cat _ fn) lins) = allRules pinfo ! ruleid
lin = lins ! lbl
(FRule fn _ cat lins) = allRules pinfo ! ruleid
lin = lins ! lbl
univRule cat item@(Final found' node) chart =
case insertXChart chart item cat of
Nothing -> chart
Just chart -> let items = do (Active found rng l ppos node@(SNode ruleid _)) <- lookupXChartAct chart cat
let FRule _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos
let FRule _ _ _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! l ! ppos
rng <- concatRange rng (found' !! r)
node <- updateChildren node d found'
return (cat, Active found rng l (ppos+1) node)
++
do guard (isBU strategy)
ruleid <- leftcornerCats pinfo ? cat
let FRule _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0
let FRule _ _ _ lins = allRules pinfo ! ruleid
FSymCat cat r d = lins ! 0 ! 0
node <- updateChildren (emptyChildren ruleid pinfo) d found'
return (cat, Active [] (found' !! r) 0 1 node)
in process strategy pinfo toks items chart
@@ -140,7 +141,7 @@ xchart2syntaxchart :: (Ord c, Ord n, Ord t) => XChart c -> FCFPInfo c n t -> Syn
xchart2syntaxchart (XChart actives finals) pinfo =
accumAssoc groupSyntaxNodes $
[ case node of
SNode ruleid rrecs -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid
SNode ruleid rrecs -> let FRule fun rhs cat _ = allRules pinfo ! ruleid
in ((cat,found), SNode fun (zip rhs rrecs))
SString s -> ((cat,found), SString s)
SInt n -> ((cat,found), SInt n)
@@ -171,5 +172,5 @@ initialBU pinfo toks =
do tok <- aElems (inputToken toks)
ruleid <- leftcornerTokens pinfo ? tok ++
epsilonRules pinfo
let FRule (Abs cat _ _) _ = allRules pinfo ! ruleid
let FRule _ _ cat _ = allRules pinfo ! ruleid
return (cat,Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))

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

@@ -87,18 +87,18 @@ buildFCFPInfo lexer grammar =
}
where allrules = listArray (0,length grammar-1) grammar
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule (Abs cat _ _) _) <- assocs allrules]
-- emptyrules = [ruleid | (ruleid, FRule (Abs _ [] _) _) <- assocs allrules]
epsilonrules = [ ruleid | (ruleid, FRule _ lins) <- assocs allrules,
topdownrules = accumAssoc id [(cat, ruleid) | (ruleid, FRule _ _ cat _) <- assocs allrules]
-- emptyrules = [ruleid | (ruleid, FRule _ [] _ _) <- assocs allrules]
epsilonrules = [ ruleid | (ruleid, FRule _ _ _ lins) <- assocs allrules,
not (inRange (bounds (lins ! 0)) 0) ]
leftcorncats = accumAssoc id
[ (fromJust (getLeftCornerCat lins), ruleid) |
(ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
(ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerCat lins) ]
leftcorntoks = accumAssoc id
[ (fromJust (getLeftCornerTok lins), ruleid) |
(ruleid, FRule _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
(ruleid, FRule _ _ _ lins) <- assocs allrules, isJust (getLeftCornerTok lins) ]
grammarcats = aElems topdownrules
grammartoks = nubsort [t | (FRule _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
grammartoks = nubsort [t | (FRule _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
----------------------------------------------------------------------
-- pretty-printing of statistics

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

@@ -24,6 +24,7 @@ import GF.Data.Operations (Err(..))
import qualified GF.Grammar.Grammar as Grammar
import qualified GF.Grammar.Macros as Macros
import qualified GF.Canon.AbsGFC as AbsGFC
import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC
import qualified GF.Infra.Ident as Ident
import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok)
@@ -49,7 +50,7 @@ data PInfo = PInfo { mcfPInfo :: MCFPInfo
}
type MCFPInfo = PM.MCFPInfo MCat Name MLabel Token
type FCFPInfo = PF.FCFPInfo FCat Name Token
type FCFPInfo = PF.FCFPInfo FCat FName Token
type CFPInfo = PC.CFPInfo CCat Name Token
buildPInfo :: MGrammar -> FGrammar -> CGrammar -> PInfo
@@ -128,17 +129,33 @@ selectParser "m" strategy pinfo startCat inTokens
-- parsing via FCFG
selectParser "f" strategy pinfo startCat inTokens
= do let startCats = filter isStart $ PF.grammarCats fcfpi
isStart cat = fcat2scat cat == cfCat2Ident startCat
isStart cat = cat' == cfCat2Ident startCat
where AbsGFCC.CId x = fcat2cid cat
cat' = Ident.IC x
fcfpi = fcfPInfo pinfo
fcfParser <- PF.parseFCF strategy
let chart = fcfParser fcfpi startCats inTokens
(i,j) = inputBounds inTokens
finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats]
return $ chart2forests chart (const False) finalEdges
return $ map cnv_forests $ chart2forests chart (const False) finalEdges
-- error parser:
selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy
cnv_forests FMeta = FMeta
cnv_forests (FNode (Name (AbsGFCC.CId n) p) fss) = FNode (Name (Ident.IC n) (map cnv_profile p)) (map (map cnv_forests) fss)
cnv_forests (FString x) = FString x
cnv_forests (FInt x) = FInt x
cnv_forests (FFloat x) = FFloat x
cnv_profile (Unify x) = Unify x
cnv_profile (Constant x) = Constant (cnv_forests2 x)
cnv_forests2 FMeta = FMeta
cnv_forests2 (FNode (AbsGFCC.CId n) fss) = FNode (Ident.IC n) (map (map cnv_forests2) fss)
cnv_forests2 (FString x) = FString x
cnv_forests2 (FInt x) = FInt x
cnv_forests2 (FFloat x) = FFloat x
----------------------------------------------------------------------
-- parse trees to GF terms