GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Changed GFCC parser format to only include the FCFG rules and the GF cat -> FCFG cat mapping. The other information is very easy to build on the fly.

Browse Source
This commit is contained in:
bjorn
2008-01-30 16:39:44 +00:00
parent c4d89577f5
commit ec1322afae
1 changed files with 5 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
src/GF/GFCC/Raw/ConvertGFCC.hs
View File

@@ -6,7 +6,7 @@ import GF.GFCC.Raw.AbsGFCCRaw
import GF.Data.Assoc import GF.Data.Assoc
import GF.Formalism.FCFG import GF.Formalism.FCFG
import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..)) import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
import GF.Parsing.FCFG.PInfo (FCFPInfo(..)) import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
import qualified Data.Array as Array import qualified Data.Array as Array
import Data.Map import Data.Map
@@ -65,27 +65,11 @@ toConcr = foldl add (Concr {
add cnc (App (CId "parser") ts) = cnc { parser = Just (toPInfo ts) } add cnc (App (CId "parser") ts) = cnc { parser = Just (toPInfo ts) }
toPInfo :: [RExp] -> FCFPInfo toPInfo :: [RExp] -> FCFPInfo
toPInfo = foldl add (FCFPInfo { toPInfo [App (CId "rules") rs, App (CId "gfcats") cs] = buildFCFPInfo (rules, cats)
allRules = error "FCFPInfo.allRules",
topdownRules = error "FCFPInfo.topdownRules",
epsilonRules = error "FCFPInfo.epsilonRules",
leftcornerCats = error "FCFPInfo.leftcornerCats",
leftcornerTokens = error "FCFPInfo.leftcornerTokens",
grammarCats = error "FCFPInfo.grammarCats",
grammarToks = error "FCFPInfo.grammarToks",
startupCats = error "FCFPInfo.startupCats"})
where where
add :: FCFPInfo -> RExp -> FCFPInfo rules = lmap toFRule rs
add p (App (CId f) ts) = cats = fromList [(c, lmap expToInt fs) | App c fs <- cs]
case f of
"rules" -> p { allRules = mkArray (lmap toFRule ts) }
"catrules" -> p { topdownRules = toAssoc expToInt (lmap expToInt) ts }
"epsilonrules" -> p { epsilonRules = lmap expToInt ts }
"firstcatrules" -> p { leftcornerCats = toAssoc expToInt (lmap expToInt) ts }
"firsttokrules" -> p { leftcornerTokens = toAssoc expToStr (lmap expToInt) ts }
"cats" -> p { grammarCats = lmap expToInt ts }
"toks" -> p { grammarToks = lmap expToStr ts }
"gfcats" -> p { startupCats = fromList [(c, lmap expToInt cs) | App c cs <- ts] }
toFRule :: RExp -> FRule toFRule :: RExp -> FRule
toFRule (App (CId "rule") toFRule (App (CId "rule")
[n, [n,
@@ -118,9 +102,6 @@ toSymbol :: RExp -> FSymbol
toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n) toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
toSymbol (AStr t) = FSymTok t toSymbol (AStr t) = FSymTok t
toAssoc :: Ord a => (RExp -> a) -> ([RExp] -> b) -> [RExp] -> Assoc a b
toAssoc f g xs = listAssoc [(f k, g v) | App (CId "map") (k:v) <- xs]
toType :: RExp -> Type toType :: RExp -> Type
toType e = case e of toType e = case e of
App cat [App (CId "H") hypos, App (CId "X") exps] -> App cat [App (CId "H") hypos, App (CId "X") exps] ->
@@ -235,18 +216,9 @@ fromTerm e = case e of
fromPInfo :: FCFPInfo -> RExp fromPInfo :: FCFPInfo -> RExp
fromPInfo p = app "parser" [ fromPInfo p = app "parser" [
app "rules" [fromFRule rule | rule <- Array.elems (allRules p)], app "rules" [fromFRule rule | rule <- Array.elems (allRules p)],
app "catrules" (fromAssoc intToExp (lmap intToExp) (topdownRules p)),
app "epsilonrules" (lmap intToExp (epsilonRules p)),
app "firstcatrules" (fromAssoc intToExp (lmap intToExp) (leftcornerCats p)),
app "firsttokrules" (fromAssoc AStr (lmap intToExp) (leftcornerTokens p)),
app "cats" (lmap intToExp (grammarCats p)),
app "toks" (lmap AStr (grammarToks p)),
app "gfcats" [App f (lmap intToExp cs) | (f,cs) <- toList (startupCats p)] app "gfcats" [App f (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
] ]
fromAssoc :: Ord a => (a -> RExp) -> (b -> [RExp]) -> Assoc a b -> [RExp]
fromAssoc f g xs = [app "map" (f x:g y) | (x,y) <- aAssocs xs]
fromFRule :: FRule -> RExp fromFRule :: FRule -> RExp
fromFRule (FRule n args res lins) = fromFRule (FRule n args res lins) =
app "rule" [fromFName n, app "rule" [fromFName n,