simplify the Profile type and remove the NameProfile type

8 files changed, 74 insertions, 195 deletions

diff --git a/src-3.0/GF/Compile/GenerateFCFG.hs b/src-3.0/GF/Compile/GenerateFCFG.hs
index f68352b6c..89e4d3ef0 100644
--- a/src-3.0/GF/Compile/GenerateFCFG.hs
+++ b/src-3.0/GF/Compile/GenerateFCFG.hs
@@ -97,9 +97,9 @@ expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
 -- replaces __NCat with _B and _Var_Cat with _.
 -- the temporary names are just there to avoid name collisions.
 fixHoasFuns :: FGrammar -> FGrammar
-fixHoasFuns (rs, cs) = ([FRule (fixName n) args cat lins | FRule n args cat lins <- rs], cs)
-  where fixName (Name (CId n) p) | BS.pack "__"    `BS.isPrefixOf` n = Name (mkCId "_B") p
-                                 | BS.pack "_Var_" `BS.isPrefixOf` n = Name wildCId p
+fixHoasFuns (rs, cs) = ([FRule (fixName n) ps args cat lins | FRule n ps args cat lins <- rs], cs)
+  where fixName (CId n) | BS.pack "__"    `BS.isPrefixOf` n = (mkCId "_B")
+                        | BS.pack "_Var_" `BS.isPrefixOf` n = wildCId
         fixName n = n
 
 convert :: [(CId,(Type,Exp))] -> TermMap -> TermMap -> FGrammar
@@ -148,11 +148,11 @@ convertRule cnc_defs selector (XRule fun args cat ctypes ctype term) frulesEnv =
 
           (_,newProfile) = List.mapAccumL accumProf 0 newArgs'
             where
-              accumProf nr (PFCat _ [] _,_     ) = (nr,       Unify []          )
-              accumProf nr (_           ,xpaths) = (nr+cnt+1, Unify [nr..nr+cnt])
+              accumProf nr (PFCat _ [] _,_     ) = (nr,       []          )
+              accumProf nr (_           ,xpaths) = (nr+cnt+1, [nr..nr+cnt])
                 where cnt = length xpaths
 
-          rule = FRule (Name fun newProfile) newArgs newCat newLinRec
+          rule = FRule fun newProfile newArgs newCat newLinRec
       in addFRule env2 rule
 
 translateLin idxArgs lbl' []                    = array (0,-1) []
@@ -336,7 +336,7 @@ genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs t
           (either_fcat,last_id1,tmap1,rules1)
                   = foldBM (\tcs st (either_fcat,last_id,tmap,rules) ->
                                    let (last_id1,tmap1,fcat_arg) = addArg tcs last_id tmap
-                                       rule = FRule (Name wildCId [Unify [0]]) [fcat_arg] fcat
+                                       rule = FRule wildCId [[0]] [fcat_arg] fcat
                                                     (listArray (0,length rcs-1) [listArray (0,0) [FSymCat fcat_arg lbl 0] | lbl <- [0..length rcs-1]])
                                    in if st
                                         then (Right fcat, last_id1,tmap1,rule:rules)
diff --git a/src-3.0/GF/Formalism/FCFG.hs b/src-3.0/GF/Formalism/FCFG.hs
index 2f3994b6c..96e88c8cf 100644
--- a/src-3.0/GF/Formalism/FCFG.hs
+++ b/src-3.0/GF/Formalism/FCFG.hs
@@ -22,11 +22,8 @@ module GF.Formalism.FCFG
          , FIndex
          , FSymbol(..)
 
-         -- * Name
-         , FName
-         , isCoercionF
-
          -- * Grammar
+         , Profile
          , FPointPos
          , FGrammar
          , FRule(..)
@@ -38,7 +35,7 @@ import Data.Array
 import qualified Data.Map as Map
 
 import GF.Formalism.Utilities
-import qualified GF.GFCC.CId as AbsGFCC
+import GF.GFCC.CId
 import GF.Infra.PrintClass
 
 ------------------------------------------------------------
@@ -67,26 +64,18 @@ data FSymbol
 
 
 ------------------------------------------------------------
--- Name
-type FName     = NameProfile AbsGFCC.CId
-
-isCoercionF :: FName -> Bool
-isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.wildCId
-isCoercionF _ = False
-
-
-------------------------------------------------------------
 -- Grammar
 
+type Profile   = [Int]
 type FPointPos = Int
-type FGrammar  = ([FRule], Map.Map AbsGFCC.CId [FCat])
-data FRule     = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
+type FGrammar  = ([FRule], Map.Map CId [FCat])
+data FRule     = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
 
 ------------------------------------------------------------
 -- pretty-printing
 
-instance Print AbsGFCC.CId where
-    prt = AbsGFCC.prCId
+instance Print CId where
+    prt = prCId
 
 instance Print FSymbol where
     prt (FSymCat c l n) = "($" ++ prt n ++ "!" ++ prt l ++ ")"
@@ -100,6 +89,11 @@ instance Print FSymbol where
     prtList = prtSep " "
 
 instance Print FRule where
-    prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
-                                     " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+    prt (FRule fun profile args res lins) =
+      prt fun ++ prtProf profile ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
+      " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+      where
+        prtProf []   = "?"
+	prtProf args = prtSep "=" args
+
     prtList = prtSep "\n"
diff --git a/src-3.0/GF/Formalism/Utilities.hs b/src-3.0/GF/Formalism/Utilities.hs
index d1826d095..ea1f1eeca 100644
--- a/src-3.0/GF/Formalism/Utilities.hs
+++ b/src-3.0/GF/Formalism/Utilities.hs
@@ -309,66 +309,6 @@ forest2trees (FMeta)     = [TMeta]
 ----------------------------------------------------------------------
 -- * profiles
 
--- | Pairing a rule name with a profile
-data NameProfile a = Name a [Profile (SyntaxForest a)]
-		     deriving (Eq, Ord, Show)
-
-name2fun :: NameProfile a -> a
-name2fun (Name fun _) = fun
-
--- | A profile is a simple representation of a function on a number of arguments.
--- We only use lists of profiles
-data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
-			     -- 'Unify []' will become a metavariable,
-			     -- 'Unify [a,b]' means that the arguments are equal,
-	       | Constant a
-		 deriving (Eq, Ord, Show)
-
-instance Functor Profile where
-    fmap f (Constant a) = Constant (f a)
-    fmap f (Unify xs)   = Unify xs
-
--- | a function name where the profile does not contain arguments 
--- (i.e. denoting a constant, not a function)
-constantNameToForest :: NameProfile a -> SyntaxForest a
-constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile] 
-    where unConstant (Constant a) = a
-	  unConstant (Unify [])   = FMeta
-	  unConstant _ = error $ "constantNameToForest: the profile should not contain arguments"
-
--- | profile application; we need some way of unifying a list of arguments
-applyProfile :: ([b] -> a) -> [Profile a] -> [b] -> [a]
-applyProfile unify profile args = map apply profile
-    where apply (Unify xs)  = unify $ map (args !!) xs
-	  apply (Constant a) = a
-
--- | monadic profile application
-applyProfileM :: Monad m => ([b] -> m a) -> [Profile a] -> [b] -> m [a]
-applyProfileM unify profile args = mapM apply profile
-    where apply (Unify xs)  = unify $ map (args !!) xs
-	  apply (Constant a) = return a
-
--- | profile composition: 
--- 
--- >   applyProfile u z (ps `composeProfiles` qs) args
--- >      ==
--- >   applyProfile u z ps (applyProfile u z qs args)
---
--- compare with function composition
---
--- >   (p . q) arg
--- >      ==
--- >   p (q arg)
---
--- Note that composing an 'Constant' with two or more arguments returns an error
--- (since 'Unify' can only take arguments) -- this might change in the future, if there is a need.
-composeProfiles :: [Profile a] -> [Profile a] -> [Profile a]
-composeProfiles ps qs = map compose ps
-    where compose (Unify [x]) = qs !! x
-	  compose (Unify xs)  = Unify [ y | x <- xs, let Unify ys = qs !! x, y <- ys ]
-	  compose constant    = constant
-
-
 
 ------------------------------------------------------------
 -- pretty-printing
@@ -411,13 +351,3 @@ instance (Print s) => Print (SyntaxForest s) where
     prt (FFloat  f) = show f
     prt (FMeta)     = "?"
     prtList = prtAfter "\n"
-
-instance Print a => Print (Profile a) where
-    prt (Unify [])   = "?"
-    prt (Unify args) = prtSep "=" args
-    prt (Constant a) = prt a
-
-instance Print a => Print (NameProfile a) where
-    prt (Name fun profile) = prt fun ++ prt profile
-
-
diff --git a/src-3.0/GF/GFCC/GFCCtoJS.hs b/src-3.0/GF/GFCC/GFCCtoJS.hs
index 91dd89b09..abf7e45a9 100644
--- a/src-3.0/GF/GFCC/GFCCtoJS.hs
+++ b/src-3.0/GF/GFCC/GFCCtoJS.hs
@@ -8,7 +8,6 @@ import qualified GF.JavaScript.PrintJS as JS
 
 import GF.Formalism.FCFG
 import GF.Parsing.FCFG.PInfo
-import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
 
 import GF.Text.UTF8
 import GF.Data.ErrM
@@ -97,29 +96,19 @@ parser2js start p  = [new "Parser" [JS.EStr start,
     cats (c,is) = JS.Prop (JS.IdentPropName (JS.Ident (prCId c))) (JS.EArray (map JS.EInt is))
 
 frule2js :: FRule -> JS.Expr
-frule2js (FRule n args res lins) = new "Rule" [JS.EInt res, name2js n, JS.EArray (map JS.EInt args), lins2js lins]
+frule2js (FRule f ps args res lins) = new "Rule" [JS.EInt res, name2js (f,ps), JS.EArray (map JS.EInt args), lins2js lins]
 
-name2js :: FName -> JS.Expr
-name2js n = case n of
-              Name f [p] | f == wildCId -> fromProfile p
-              Name f ps -> new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
+name2js :: (CId,[Profile]) -> JS.Expr
+name2js (f,ps) | f == wildCId = fromProfile (head ps)
+               | otherwise    = new "FunApp" $ [JS.EStr $ prCId f, JS.EArray (map fromProfile ps)]
   where
-    fromProfile :: Profile (SyntaxForest CId) -> JS.Expr
-    fromProfile (Unify []) = new "MetaVar" []
-    fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = new "Unify" [JS.EArray (map daughter args)]
-    fromProfile (Constant forest) = fromSyntaxForest forest
+    fromProfile :: Profile -> JS.Expr
+    fromProfile []   = new "MetaVar" []
+    fromProfile [x]  = daughter x
+    fromProfile args = new "Unify" [JS.EArray (map daughter args)]
 
     daughter i = new "Arg" [JS.EInt i]
 
-    fromSyntaxForest :: SyntaxForest CId -> JS.Expr
-    fromSyntaxForest FMeta = new "MetaVar" []
-    -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = new "FunApp" $ [JS.EStr $ prCId n, JS.EArray (map fromSyntaxForest args)]
-    fromSyntaxForest (FString s) = new "Lit" $ [JS.EStr s]
-    fromSyntaxForest (FInt i) = new "Lit" $ [JS.EInt $ fromIntegral i]
-    fromSyntaxForest (FFloat f) = new "Lit" $ [JS.EDbl f]
-
 lins2js :: Array FIndex (Array FPointPos FSymbol) -> JS.Expr
 lins2js ls = JS.EArray [ JS.EArray [ sym2js s | s <- Array.elems l] | l <- Array.elems ls]
 
diff --git a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
index 7f5e0ba00..324f8be04 100644
--- a/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
+++ b/src-3.0/GF/GFCC/Raw/ConvertGFCC.hs
@@ -7,7 +7,7 @@ import GF.GFCC.Raw.AbsGFCCRaw
 import GF.Infra.PrintClass
 import GF.Data.Assoc
 import GF.Formalism.FCFG
-import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
+import GF.Formalism.Utilities
 import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
 
 import qualified Data.Array as Array
@@ -78,29 +78,21 @@ toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
     toFRule (App "rule"
               [n,                      
                App "cats" (rt:at),
-               App "R" ls]) = FRule name args res lins
+               App "R" ls]) = FRule fun prof args res lins
       where 
-        name = toFName n
+        (fun,prof) = toFName n
         args = lmap expToInt at
         res  = expToInt rt
         lins = mkArray [mkArray [toSymbol s | s <- l] | App "S" l <- ls]
 
-toFName :: RExp -> FName
-toFName (App "_A" [x]) = Name wildCId [Unify [expToInt x]]
-toFName (App f ts) = Name (mkCId f) (lmap toProfile ts)
+toFName :: RExp -> (CId,[Profile])
+toFName (App "_A" [x]) = (wildCId, [[expToInt x]])
+toFName (App f ts)     = (mkCId f, lmap toProfile ts)
     where
-      toProfile :: RExp -> Profile (SyntaxForest CId)
-      toProfile AMet = Unify []
-      toProfile (App "_A" [t]) = Unify [expToInt t]
-      toProfile (App "_U" ts) = Unify [expToInt t | App "_A" [t] <- ts]
-      toProfile t = Constant (toSyntaxForest t)
-
-      toSyntaxForest :: RExp -> SyntaxForest CId
-      toSyntaxForest AMet = FMeta
-      toSyntaxForest (App n ts) = FNode (mkCId n) [lmap toSyntaxForest ts]
-      toSyntaxForest (AStr s) = FString s
-      toSyntaxForest (AInt i) = FInt i
-      toSyntaxForest (AFlt f) = FFloat f
+      toProfile :: RExp -> Profile
+      toProfile AMet           = []
+      toProfile (App "_A" [t]) = [expToInt t]
+      toProfile (App "_U" ts)  = [expToInt t | App "_A" [t] <- ts]
 
 toSymbol :: RExp -> FSymbol
 toSymbol (App "P" [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
@@ -221,33 +213,23 @@ fromPInfo p = App "parser" [
         ]
 
 fromFRule :: FRule -> RExp
-fromFRule (FRule n args res lins) = 
-    App "rule" [fromFName n,
+fromFRule (FRule fun prof args res lins) = 
+    App "rule" [fromFName (fun,prof),
                 App "cats" (intToExp res:lmap intToExp args),
                 App "R" [App "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
                ]
 
-fromFName :: FName -> RExp
-fromFName n = case n of
-                Name f ps | f == wildCId -> fromProfile (head ps)
-                          | otherwise    -> App (prCId f) (lmap fromProfile ps)
+fromFName :: (CId,[Profile]) -> RExp
+fromFName (f,ps) | f == wildCId = fromProfile (head ps)
+                 | otherwise    = App (prCId f) (lmap fromProfile ps)
   where
-    fromProfile :: Profile (SyntaxForest CId) -> RExp
-    fromProfile (Unify []) = AMet
-    fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = App "_U" (lmap daughter args)
-    fromProfile (Constant forest) = fromSyntaxForest forest
+    fromProfile :: Profile -> RExp
+    fromProfile []   = AMet
+    fromProfile [x]  = daughter x
+    fromProfile args = App "_U" (lmap daughter args)
 
     daughter n = App "_A" [intToExp n]
 
-    fromSyntaxForest :: SyntaxForest CId -> RExp
-    fromSyntaxForest FMeta = AMet
-    -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = App (prCId n) (lmap fromSyntaxForest args)
-    fromSyntaxForest (FString s) = AStr s
-    fromSyntaxForest (FInt i) = AInt i
-    fromSyntaxForest (FFloat f) = AFlt f
-
 fromSymbol :: FSymbol -> RExp
 fromSymbol (FSymCat c l n) = App "P" [intToExp c, intToExp n, intToExp l]
 fromSymbol (FSymTok t) = AStr t
diff --git a/src-3.0/GF/Parsing/FCFG.hs b/src-3.0/GF/Parsing/FCFG.hs
index 30a7801c8..b279caf48 100644
--- a/src-3.0/GF/Parsing/FCFG.hs
+++ b/src-3.0/GF/Parsing/FCFG.hs
@@ -46,7 +46,7 @@ parseFCF strategy pinfo startCat inString =
        let chart = fcfParser pinfo startCats inTokens
 	   (i,j) = inputBounds inTokens
 	   finalEdges = [makeFinalEdge cat i j | cat <- startCats]
-	   forests = map cnv_forests $ chart2forests chart (const False) finalEdges
+	   forests = chart2forests chart (const False) finalEdges
            filteredForests = forests >>= applyProfileToForest
 	   trees = nubsort $ filteredForests >>= forest2trees
        return $ map tree2term trees
@@ -56,22 +56,6 @@ parseFCF strategy pinfo startCat inString =
       parseFCF "topdown"  = Ok  $ Active.parse "t"
       parseFCF strat      = Bad $ "FCFG parsing strategy not defined: " ++ strat
 
-
-cnv_forests FMeta         = FMeta
-cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (CId 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 (CId n) fss) = FNode (CId 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 GFCC terms
 
@@ -87,13 +71,13 @@ tree2term (TMeta)      = exp0
 -- conversion and unification of forests
 
 -- simplest implementation
-applyProfileToForest :: SyntaxForest FName -> [SyntaxForest CId]
-applyProfileToForest (FNode name@(Name fun profile) children) 
-    | isCoercionF name = concat chForests
-    | otherwise       = [ FNode fun chForests | not (null chForests) ]
-    where chForests   = concat [ applyProfileM unifyManyForests profile forests |
-				 forests0 <- children,
-				 forests <- mapM applyProfileToForest forests0 ]
+applyProfileToForest :: SyntaxForest (CId,[Profile]) -> [SyntaxForest CId]
+applyProfileToForest (FNode (fun,profiles) children) 
+    | fun == wildCId = concat chForests
+    | otherwise      = [ FNode fun chForests | not (null chForests) ]
+    where chForests  = concat [ mapM (unifyManyForests . map (forests !!)) profiles |
+			        forests0 <- children,
+			        forests <- mapM applyProfileToForest forests0 ]
 applyProfileToForest (FString s) = [FString s]
 applyProfileToForest (FInt    n) = [FInt    n]
 applyProfileToForest (FFloat  f) = [FFloat  f]
diff --git a/src-3.0/GF/Parsing/FCFG/Active.hs b/src-3.0/GF/Parsing/FCFG/Active.hs
index df55793f8..498054eee 100644
--- a/src-3.0/GF/Parsing/FCFG/Active.hs
+++ b/src-3.0/GF/Parsing/FCFG/Active.hs
@@ -14,6 +14,7 @@ import GF.Data.Assoc
 import GF.Data.SortedList
 import GF.Data.Utilities
 
+import GF.GFCC.CId
 import GF.Formalism.FCFG
 import GF.Formalism.Utilities
 
@@ -45,7 +46,7 @@ isTD  s = s=="t"
 emptyChildren :: RuleId -> FCFPInfo -> SyntaxNode RuleId RangeRec
 emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
   where
-    FRule _ rhs _ _ = allRules pinfo ! ruleid
+    FRule _ _ rhs _ _ = allRules pinfo ! ruleid
 
 process :: String -> FCFPInfo -> Input FToken -> [(FCat,Item)] -> XChart FCat -> XChart FCat
 process strategy pinfo toks []               chart = chart
@@ -77,20 +78,20 @@ 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 fn _ cat lins) = allRules pinfo ! ruleid
+        (FRule _ _ _ 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
+                                     let FRule _ _ _ _ lins = allRules pinfo ! ruleid
                                          FSymCat cat r d  = lins ! l ! ppos
                                      rng  <- concatRange rng (found' !! r)
                                      return (cat, Active found rng l (ppos+1) (updateChildren node d found'))
                                   ++
     			          do guard (isBU strategy)
 			             ruleid <- leftcornerCats pinfo ? cat
-			             let FRule _ _ _ lins = allRules pinfo ! ruleid
+			             let FRule _ _ _ _ lins = allRules pinfo ! ruleid
 			                 FSymCat cat r d  = lins ! 0 ! 0
                                      return (cat, Active [] (found' !! r) 0 1 (updateChildren (emptyChildren ruleid pinfo) d found'))
 
@@ -128,12 +129,12 @@ insertXChart (XChart actives finals) item@(Final _ _) c =
 lookupXChartAct   (XChart actives finals) c = chartLookup actives c
 lookupXChartFinal (XChart actives finals) c = chartLookup finals  c
 
-xchart2syntaxchart :: XChart FCat -> FCFPInfo -> SyntaxChart FName (FCat,RangeRec)
+xchart2syntaxchart :: XChart FCat -> FCFPInfo -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
 xchart2syntaxchart (XChart actives finals) pinfo =
   accumAssoc groupSyntaxNodes $
     [ case node of
-        SNode ruleid rrecs -> let FRule fun rhs cat _ = allRules pinfo ! ruleid
-		              in ((cat,found), SNode fun (zip rhs rrecs))
+        SNode ruleid rrecs -> let FRule fun prof rhs cat _ = allRules pinfo ! ruleid
+		              in ((cat,found), SNode (fun,prof) (zip rhs rrecs))
         SString s          ->    ((cat,found), SString s)
         SInt    n          ->    ((cat,found), SInt    n)
         SFloat  f          ->    ((cat,found), SFloat  f)
@@ -170,10 +171,10 @@ initialBU :: FCFPInfo -> Input FToken -> [(FCat,Item)]
 initialBU pinfo toks =
     do (tok,rngs) <- aAssocs (inputToken toks)
        ruleid <- leftcornerTokens pinfo ? tok
-       let FRule _ _ cat _ = allRules pinfo ! ruleid
+       let FRule _ _ _ cat _ = allRules pinfo ! ruleid
        (i,j) <- rngs
        return (cat,Active [] (makeRange i j) 0 1 (emptyChildren ruleid pinfo))
     ++
     do ruleid <- epsilonRules pinfo
-       let FRule _ _ cat _ = allRules pinfo ! ruleid
+       let FRule _ _ _ cat _ = allRules pinfo ! ruleid
        return (cat,Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))
diff --git a/src-3.0/GF/Parsing/FCFG/PInfo.hs b/src-3.0/GF/Parsing/FCFG/PInfo.hs
index 8b288f2f1..dc934c1e5 100644
--- a/src-3.0/GF/Parsing/FCFG/PInfo.hs
+++ b/src-3.0/GF/Parsing/FCFG/PInfo.hs
@@ -15,7 +15,7 @@ import GF.Formalism.FCFG
 import GF.Data.SortedList
 import GF.Data.Assoc
 import GF.Parsing.FCFG.Range
-import qualified GF.GFCC.CId as AbsGFCC
+import GF.GFCC.CId
 
 import Data.Array
 import Data.Maybe
@@ -30,7 +30,7 @@ import Debug.Trace
 type FCFParser =  FCFPInfo
                -> [FCat]
                -> Input FToken
-               -> SyntaxChart FName (FCat,RangeRec)
+               -> SyntaxChart (CId,[Profile]) (FCat,RangeRec)
 
 makeFinalEdge cat 0 0 = (cat, [EmptyRange])
 makeFinalEdge cat i j = (cat, [makeRange i j])
@@ -52,7 +52,7 @@ data FCFPInfo
 		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
 	       , grammarCats        :: SList FCat
 	       , grammarToks        :: SList FToken
-	       , startupCats        :: Map.Map AbsGFCC.CId [FCat]
+	       , startupCats        :: Map.Map CId [FCat]
 	       }
 
 
@@ -86,18 +86,17 @@ buildFCFPInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x
 	     }
 
     where allrules = listArray (0,length grammar-1) grammar
-	  topdownrules  = accumAssoc id [(cat,  ruleid) | (ruleid, FRule _ _ cat _) <- assocs allrules]
-	  -- emptyrules    = [ruleid | (ruleid, FRule _ [] _ _) <- assocs allrules]
-	  epsilonrules  = [ ruleid | (ruleid, FRule _ _ _ lins) <- assocs allrules,
+	  topdownrules  = accumAssoc id [(cat,  ruleid) | (ruleid, FRule _ _ _ cat _) <- 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]
 
 fcfPInfoToFGrammar :: FCFPInfo -> FGrammar
 fcfPInfoToFGrammar pinfo = (elems (allRules pinfo), startupCats pinfo)