simplify the Profile type and remove the NameProfile type

3 files changed, 26 insertions, 42 deletions

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)