GFCC to FCFG conversion

4 files changed, 40 insertions, 22 deletions

diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs
index f4aa806d5..404bb9950 100644
--- a/src/GF/Parsing/FCFG.hs
+++ b/src/GF/Parsing/FCFG.hs
@@ -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 
diff --git a/src/GF/Parsing/FCFG/Active.hs b/src/GF/Parsing/FCFG/Active.hs
index 1b6673cd7..48c637e18 100644
--- a/src/GF/Parsing/FCFG/Active.hs
+++ b/src/GF/Parsing/FCFG/Active.hs
@@ -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))
diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs
index 9cc0975b2..c87f0b15c 100644
--- a/src/GF/Parsing/FCFG/PInfo.hs
+++ b/src/GF/Parsing/FCFG/PInfo.hs
@@ -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
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index d4eaffb56..e1d0d298b 100644
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -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