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.

1 files changed, 5 insertions, 33 deletions

diff --git a/src/GF/GFCC/Raw/ConvertGFCC.hs b/src/GF/GFCC/Raw/ConvertGFCC.hs
index 2b0db7a0f..437478bb6 100644
--- a/src/GF/GFCC/Raw/ConvertGFCC.hs
+++ b/src/GF/GFCC/Raw/ConvertGFCC.hs
@@ -6,7 +6,7 @@ import GF.GFCC.Raw.AbsGFCCRaw
 import GF.Data.Assoc
 import GF.Formalism.FCFG
 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 Data.Map
@@ -65,27 +65,11 @@ toConcr = foldl add (Concr {
     add cnc (App (CId "parser") ts)    = cnc { parser = Just (toPInfo ts) }
 
 toPInfo :: [RExp] -> FCFPInfo
-toPInfo = foldl add (FCFPInfo { 
-                       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"})
+toPInfo [App (CId "rules") rs, App (CId "gfcats") cs] = buildFCFPInfo (rules, cats)
   where 
-    add :: FCFPInfo -> RExp -> FCFPInfo
-    add p (App (CId f) ts) =
-        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] }
+    rules = lmap toFRule rs
+    cats = fromList [(c, lmap expToInt fs) | App c fs <- cs]
+
     toFRule :: RExp -> FRule
     toFRule (App (CId "rule") 
               [n,                      
@@ -118,9 +102,6 @@ toSymbol :: RExp -> FSymbol
 toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
 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 e = case e of
   App cat [App (CId "H") hypos, App (CId "X") exps] -> 
@@ -235,18 +216,9 @@ fromTerm e = case e of
 fromPInfo :: FCFPInfo -> RExp
 fromPInfo p = app "parser" [
           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)]
         ]
 
-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 n args res lins) = 
     app "rule" [fromFName n,