code polishing for the literal category support

12 files changed, 120 insertions, 130 deletions

diff --git a/src/GF/Formalism/CFG.hs b/src/GF/Formalism/CFG.hs
index 2eb090131..c38adb4e2 100644
--- a/src/GF/Formalism/CFG.hs
+++ b/src/GF/Formalism/CFG.hs
@@ -33,8 +33,8 @@ type CFChart    c n t = CFGrammar (Edge c) n t
 -- building syntax charts from grammars
 
 grammar2chart :: (Ord n, Ord e) => CFGrammar e n t -> SyntaxChart n e
-grammar2chart cfchart = accumAssoc groupPairs $
-			[ (lhs, (name, filterCats rhs)) |
+grammar2chart cfchart = accumAssoc groupSyntaxNodes $
+			[ (lhs, SNode name (filterCats rhs)) |
 				     CFRule lhs rhs name <- cfchart ]
 
 
diff --git a/src/GF/Formalism/GCFG.hs b/src/GF/Formalism/GCFG.hs
index 9cf47637a..bfe90bac9 100644
--- a/src/GF/Formalism/GCFG.hs
+++ b/src/GF/Formalism/GCFG.hs
@@ -29,10 +29,6 @@ data Abstract cat name = Abs cat [cat] name
 data Concrete lin term = Cnc lin [lin] term 
 			 deriving (Eq, Ord, Show)
 
-abstract2chart :: (Ord n, Ord e) => [Abstract e n] -> SyntaxChart n e
-abstract2chart rules = accumAssoc groupPairs $
-		       [ (e, (n, es)) | Abs e es n <- rules ]
-
 ----------------------------------------------------------------------
 
 instance (Print c, Print n, Print l, Print t) => Print (Rule n c l t) where
diff --git a/src/GF/Formalism/Utilities.hs b/src/GF/Formalism/Utilities.hs
index f89bbe4a9..0d303b175 100644
--- a/src/GF/Formalism/Utilities.hs
+++ b/src/GF/Formalism/Utilities.hs
@@ -112,7 +112,28 @@ inputMany toks     = MkInput inEdges inBounds inFrom inTo inToken
 -- | The values of the chart, a list of key-daughters pairs,
 -- has unique keys. In essence, it is a map from 'n' to daughters.
 -- The daughters should be a set (not necessarily sorted) of rhs's.
-type SyntaxChart n e = Assoc e [(n, [[e]])]
+type SyntaxChart n e = Assoc e [SyntaxNode n [e]]
+
+data SyntaxNode n e = SMeta
+                    | SNode n [e]
+                    | SString String
+                    | SInt    Integer
+                    | SFloat  Double
+                    deriving (Eq,Ord)
+
+groupSyntaxNodes :: Ord n => [SyntaxNode n e] -> [SyntaxNode n [e]]
+groupSyntaxNodes []                =  []
+groupSyntaxNodes (SNode n0 es0:xs) = (SNode n0 (es0:ess)) : groupSyntaxNodes xs'
+  where 
+    (ess,xs') = span xs
+
+    span []       = ([],[])
+    span xs@(SNode n es:xs')
+      | n0 == n   = let (ess,xs) = span xs' in (es:ess,xs)
+      | otherwise = ([],xs)
+groupSyntaxNodes (SString s:xs) = (SString s) : groupSyntaxNodes xs
+groupSyntaxNodes (SInt    n:xs) = (SInt    n) : groupSyntaxNodes xs
+groupSyntaxNodes (SFloat  f:xs) = (SFloat  f) : groupSyntaxNodes xs
 
 -- better(?) representation of forests:
 -- data Forest n = F (SMap n (SList [Forest n])) Bool
@@ -240,7 +261,12 @@ chart2forests :: (Ord n, Ord e) =>
 chart2forests chart isMeta  = concatMap edge2forests
     where edge2forests edge = if isMeta edge then [FMeta]
 			      else map item2forest $ chart ? edge
-	  item2forest (name, children) = FNode name $ children >>= mapM edge2forests
+	  item2forest (SMeta)               = FMeta
+	  item2forest (SNode name children) = FNode name $ children >>= mapM edge2forests
+	  item2forest (SString s)           = FString s
+	  item2forest (SInt    n)           = FInt    n
+	  item2forest (SFloat  f)           = FFloat  f
+	  
 
 {-
 -- more intelligent(?) implementation,
diff --git a/src/GF/Parsing/FCFG/Active.hs b/src/GF/Parsing/FCFG/Active.hs
index d780951ad..b8901d3e8 100644
--- a/src/GF/Parsing/FCFG/Active.hs
+++ b/src/GF/Parsing/FCFG/Active.hs
@@ -35,7 +35,7 @@ import Data.Array
 -- * parsing
 
 parse :: (Ord c, Ord n, Ord t) => String -> FCFParser c n t
-parse strategy pinfo starts toks = xchart2forests chart pinfo starts toks
+parse strategy pinfo starts toks = xchart2syntaxchart chart pinfo
     where chart = process strategy pinfo toks axioms emptyXChart
     
           axioms | isBU  strategy = terminal pinfo toks ++ initialScan pinfo toks
@@ -45,115 +45,91 @@ isBU  s = s=="b"
 isTD  s = s=="t"
 
 -- used in prediction
-emptyChildren :: Abstract c n -> [RangeRec]
-emptyChildren (Abs _ rhs _) = replicate (length rhs) []
+emptyChildren :: RuleId -> FCFPInfo c n t -> SyntaxNode RuleId RangeRec
+emptyChildren ruleid pinfo = SNode ruleid (replicate (length rhs) [])
+  where
+    FRule (Abs _ rhs _) _ = allRules pinfo ! ruleid
 
-updateChildren :: [RangeRec] -> Int -> RangeRec -> [[RangeRec]]
-updateChildren recs i rec = updateNthM update i recs
-    where update rec' = do guard (null rec' || rec' == rec)
-                           return rec
+updateChildren :: SyntaxNode RuleId RangeRec -> Int -> RangeRec -> [SyntaxNode RuleId RangeRec]
+updateChildren (SNode ruleid recs) i rec = do
+  recs <- updateNthM update i recs
+  return (SNode ruleid recs)
+  where
+    update rec' = guard (null rec' || rec' == rec) >> return rec
 
 makeMaxRange (Range _ j) = Range j j
 makeMaxRange EmptyRange  = EmptyRange
 
-process :: (Ord c, Ord n, Ord t) => String -> FCFPInfo c n t -> Input t -> [Item c] -> XChart c -> XChart c
-process strategy pinfo toks []           chart = chart
-process strategy pinfo toks (item:items) chart = process strategy pinfo toks items $! univRule item chart
+process :: (Ord c, Ord n, 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
-    univRule item@(Active ruleid found rng lbl ppos recs) chart
+    univRule cat item@(Active found rng lbl ppos node@(SNode ruleid _)) chart
       | inRange (bounds lin) ppos =
            case lin ! ppos of
              FSymCat c r d -> case insertXChart chart item c of
 	                        Nothing    -> chart
-	                        Just chart -> let items = do item <- lookupXChartFinal chart c
-	                                                     let found' = case item of
-	                                                                    Final   _ found' _ -> found'
-	                                                                    Literal _ found' _ -> found'
-	         			                     rng'  <- concatRange rng (found' !! r)
-	         			                     recs' <- updateChildren recs d found'
-	     			                             return (Active ruleid found rng' lbl (ppos+1) recs')
+	                        Just chart -> let items = do item@(Final found' _) <- lookupXChartFinal chart c
+	         			                     rng  <- concatRange rng (found' !! r)
+	         			                     node <- updateChildren node d found'
+	     			                             return (c, Active found rng lbl (ppos+1) node)
 	     			                          ++
 	     			                          do guard (isTD strategy)
 	     			                             ruleid <- topdownRules pinfo ? c
-	     			                             let FRule abs lins = allRules pinfo ! ruleid
-	     			                             return (Active ruleid [] EmptyRange 0 0 (emptyChildren abs))
+	     			                             return (c, Active [] EmptyRange 0 0 (emptyChildren ruleid pinfo))
 	     			              in process strategy pinfo toks items chart
 	     FSymTok tok   -> let items = do (i,j) <- inputToken toks ? tok
 	                                     rng' <- concatRange rng (makeRange i j)
-	                                     return (Active ruleid found rng' lbl (ppos+1) recs)
+	                                     return (cat, Active found rng' lbl (ppos+1) node)
                               in process strategy pinfo toks items chart
       | otherwise =
            if inRange (bounds lins) (lbl+1)
-             then univRule (Active ruleid (rng:found)           EmptyRange (lbl+1) 0 recs) chart
-             else univRule (Final  ruleid (reverse (rng:found))                      recs) chart
+             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
-    univRule item@(Final ruleid found' recs) chart =
-      case insertXChart chart item cat of
-        Nothing    -> chart
-        Just chart -> let items = do (Active ruleid found rng l ppos recs) <- lookupXChartAct chart cat
-                                     let FRule _ lins    = allRules pinfo ! ruleid
-                                         FSymCat cat r d = lins ! l ! ppos
-                                     rng'  <- concatRange rng (found' !! r)
-                                     recs' <- updateChildren recs d found'
-                                     return (Active ruleid found rng' l (ppos+1) recs')
-                                  ++
-    			          do guard (isBU strategy)
-			             ruleid <- leftcornerCats pinfo ? cat
-			             let FRule abs lins = allRules pinfo ! ruleid
-			                 FSymCat cat r d = lins ! 0 ! 0
-                                     return (Active ruleid [] (found' !! r) 0 1 (updateNth (const found') d (emptyChildren abs)))
-                      in process strategy pinfo toks items chart
-      where
-        (FRule (Abs cat _ _) _) = allRules pinfo ! ruleid
-    univRule item@(Literal cat found' t) chart =
+    univRule cat item@(Final found' node) chart =
       case insertXChart chart item cat of
         Nothing    -> chart
-        Just chart -> let items = do (Active ruleid found rng l ppos recs) <- lookupXChartAct chart cat
+        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
-                                     rng'  <- concatRange rng (found' !! r)
-                                     recs' <- updateChildren recs d found'
-                                     return (Active ruleid found rng' l (ppos+1) recs')
+                                     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 abs lins = allRules pinfo ! ruleid
+			             let FRule _ lins = allRules pinfo ! ruleid
 			                 FSymCat cat r d = lins ! 0 ! 0
-                                     return (Active ruleid [] (found' !! r) 0 1 (updateNth (const found') d (emptyChildren abs)))
+			             node <- updateChildren (emptyChildren ruleid pinfo) d found'
+                                     return (cat, Active [] (found' !! r) 0 1 node)
                       in process strategy pinfo toks items chart
 
 ----------------------------------------------------------------------
 -- * XChart
 
-data Item c
-  = Active {-# UNPACK #-} !RuleId
-           RangeRec
+data Item
+  = Active RangeRec
            Range
            {-# UNPACK #-} !FLabel
            {-# UNPACK #-} !FPointPos
-           [RangeRec]
-  | Final {-# UNPACK #-} !RuleId RangeRec [RangeRec]
-  | Literal c RangeRec (SyntaxTree RuleId)
+           (SyntaxNode RuleId RangeRec)
+  | Final RangeRec (SyntaxNode RuleId RangeRec)
   deriving (Eq, Ord)
 
-data XChart c = XChart !(ParseChart (Item c) c) !(ParseChart (Item c) c)
+data XChart c = XChart !(ParseChart Item c) !(ParseChart Item c)
 
 emptyXChart :: Ord c => XChart c
 emptyXChart = XChart emptyChart emptyChart
 
-insertXChart (XChart actives finals) item@(Active _ _ _ _ _ _) c = 
+insertXChart (XChart actives finals) item@(Active _ _ _ _ _) c = 
   case chartInsert actives item c of
     Nothing      -> Nothing
     Just actives -> Just (XChart actives finals)
 
-insertXChart (XChart actives finals) item@(Final _ _ _) c =
-  case chartInsert finals item c of
-    Nothing     -> Nothing
-    Just finals -> Just (XChart actives finals)
-
-insertXChart (XChart actives finals) item@(Literal _ _ _) c =
+insertXChart (XChart actives finals) item@(Final _ _) c =
   case chartInsert finals item c of
     Nothing     -> Nothing
     Just finals -> Just (XChart actives finals)
@@ -161,27 +137,17 @@ insertXChart (XChart actives finals) item@(Literal _ _ _) c =
 lookupXChartAct   (XChart actives finals) c = chartLookup actives c
 lookupXChartFinal (XChart actives finals) c = chartLookup finals  c
 
-xchart2forests :: (Ord c, Ord n, Ord t) => XChart c -> FCFParser c n t
-xchart2forests (XChart actives finals) pinfo starts toks = concatMap (edge2forests . makeFinalEdge) starts
-  where
-    assocs = accumAssoc groupPairs $
-                [ case item of
-                    Final ruleid found rrecs      -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid
-		                                     in ((cat,found), (FNode fun [], zip rhs rrecs))
-                    Literal cat found (TString s) ->    ((cat,found), (FString s,               []))
-                    Literal cat found (TInt    n) ->    ((cat,found), (FInt    n,               []))
-                    Literal cat found (TFloat  f) ->    ((cat,found), (FFloat  f,               []))
-		| item <- chartList finals
-		]
-    edge2forests edge@(cat,_) = map (item2forest cat) $ assocs ? edge
-    item2forest cat (FNode name _, children) = FNode name $ children >>= mapM edge2forests
-    item2forest cat (t           , children) = t
-
-    makeFinalEdge cat =
-      case inputBounds toks of
-        (0,0) -> (cat, [EmptyRange]   )
-        (i,j) -> (cat, [makeRange i j])
-
+xchart2syntaxchart :: (Ord c, Ord n, Ord t) => XChart c -> FCFPInfo c n t -> SyntaxChart n (c,RangeRec)
+xchart2syntaxchart (XChart actives finals) pinfo =
+  accumAssoc groupSyntaxNodes $
+    [ case node of
+        SNode ruleid rrecs -> let FRule (Abs cat rhs fun) _ = allRules pinfo ! ruleid
+		              in ((cat,found), SNode fun (zip rhs rrecs))
+        SString s          ->    ((cat,found), SString s)
+        SInt    n          ->    ((cat,found), SInt    n)
+        SFloat  f          ->    ((cat,found), SFloat  f)
+    | (cat, Final found node) <- chartAssocs finals
+    ]
 
 ----------------------------------------------------------------------
 -- Earley --
@@ -192,8 +158,7 @@ initial pinfo starts toks =
     tracePrt "MCFG.Active (Earley) - initial rules" (prt . length) $
     do cat <- starts
        ruleid <- topdownRules pinfo ? cat
-       let FRule abs lins = allRules pinfo ! ruleid
-       return $ Active ruleid [] (Range 0 0) 0 0 (emptyChildren abs)
+       return (cat,Active [] (Range 0 0) 0 0 (emptyChildren ruleid pinfo))
 
 
 ----------------------------------------------------------------------
@@ -220,4 +185,3 @@ initialScan pinfo toks =
                  epsilonRules pinfo
        let FRule abs lins = allRules pinfo ! ruleid
        return $ Active ruleid [] EmptyRange 0 0 (emptyChildren abs)
-
diff --git a/src/GF/Parsing/FCFG/PInfo.hs b/src/GF/Parsing/FCFG/PInfo.hs
index 43e729e31..9cc0975b2 100644
--- a/src/GF/Parsing/FCFG/PInfo.hs
+++ b/src/GF/Parsing/FCFG/PInfo.hs
@@ -29,7 +29,10 @@ import Data.Maybe
 type FCFParser c n t = FCFPInfo c n t 
 		     -> [c]
 		     -> Input t
-		     -> [SyntaxForest n]
+		     -> SyntaxChart n (c,RangeRec)
+
+makeFinalEdge cat 0 0 = (cat, [EmptyRange])
+makeFinalEdge cat i j = (cat, [makeRange i j])
 
 ------------------------------------------------------------
 -- parser information
@@ -48,7 +51,7 @@ data FCFPInfo c n t
 		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
 	       , grammarCats        :: SList c
 	       , grammarToks        :: SList t
-	       , grammarLexer       :: t -> (c,SyntaxTree RuleId)
+	       , grammarLexer       :: t -> (c,SyntaxNode RuleId RangeRec)
 	       }
 
 
@@ -68,7 +71,7 @@ getLeftCornerCat lins
   where
     syms = lins ! 0
 
-buildFCFPInfo :: (Ord c, Ord n, Ord t) => (t -> (c,SyntaxTree RuleId)) -> FCFGrammar c n t -> FCFPInfo c n t
+buildFCFPInfo :: (Ord c, Ord n, Ord t) => (t -> (c,SyntaxNode RuleId RangeRec)) -> FCFGrammar c n t -> FCFPInfo c n t
 buildFCFPInfo lexer grammar = 
     traceCalcFirst grammar $
     tracePrt "MCFG.PInfo - parser info" (prt) $
diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs
index 0a0b3892c..6283bfe78 100644
--- a/src/GF/Parsing/GFC.hs
+++ b/src/GF/Parsing/GFC.hs
@@ -60,10 +60,10 @@ buildPInfo mcfg fcfg cfg = PInfo { mcfPInfo = PM.buildMCFPInfo mcfg
   where
     grammarLexer s =
       case reads s of
-        [(n::Integer,"")] -> (fcatInt, TInt n)
+        [(n::Integer,"")] -> (fcatInt, SInt n)
         _                 -> case reads s of
-                               [(f::Double,"")] -> (fcatFloat, TFloat  f)
-                               _                -> (fcatString,TString s)
+                               [(f::Double,"")] -> (fcatFloat, SFloat  f)
+                               _                -> (fcatString,SString s)
 
 
 instance Print PInfo where
@@ -119,10 +119,7 @@ selectParser "m" strategy pinfo startCat inTokens
 	     isStart cat = mcat2scat cat == cfCat2Ident startCat
 	     mcfpi = mcfPInfo pinfo
 	 mcfParser <- PM.parseMCF strategy
-	 let mcfChart = tracePrt "Parsing.GFC - MCF chart" (prt . length) $
-			mcfParser mcfpi startCats inTokens
-	     chart = tracePrt "Parsing.GFC - chart" (prt . length . concat . map snd . aAssocs) $
-		     G.abstract2chart mcfChart
+	 let chart = mcfParser mcfpi startCats inTokens
 	     finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $
 			  [ PM.makeFinalEdge cat lbl (inputBounds inTokens) | 
 			    cat@(MCat _ [lbl]) <- startCats ]
@@ -134,7 +131,10 @@ selectParser "f" strategy pinfo startCat inTokens
 	     isStart cat = fcat2scat cat == cfCat2Ident startCat
 	     fcfpi = fcfPInfo pinfo
 	 fcfParser <- PF.parseFCF strategy
-	 return $ fcfParser fcfpi startCats inTokens
+	 let chart = fcfParser fcfpi startCats inTokens
+	     (i,j) = inputBounds inTokens
+	     finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats]
+	 return $ chart2forests chart (const False) finalEdges
 
 -- error parser: 
 selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy 
diff --git a/src/GF/Parsing/MCFG/Active.hs b/src/GF/Parsing/MCFG/Active.hs
index 5ccd43398..c6e9c6b06 100644
--- a/src/GF/Parsing/MCFG/Active.hs
+++ b/src/GF/Parsing/MCFG/Active.hs
@@ -34,18 +34,16 @@ import GF.Infra.Print
 
 parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
 parse strategy pinfo starts toks =
-    trace2 "MCFG.Active - strategy" (if isBU strategy then "BU"
-				     else if isTD strategy then "TD" else "None") $
-    [ Abs (cat, found) (zip rhs rrecs) fun |
-      Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
     where chart = process strategy pinfo starts toks
 
 -- parseR :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
 parseR strategy pinfo starts =
-    trace2 "MCFG.Active Range - strategy" (if isBU strategy then "BU"
-					   else if isTD strategy then "TD" else "None") $
-    [ Abs (cat, found) (zip rhs rrecs) fun |
-      Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs))  |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
     where chart = processR strategy pinfo starts 
 
 process :: (Ord n, Ord c, Ord l, Ord t) => 
diff --git a/src/GF/Parsing/MCFG/Active2.hs b/src/GF/Parsing/MCFG/Active2.hs
index f702c83b3..7ad8627bc 100644
--- a/src/GF/Parsing/MCFG/Active2.hs
+++ b/src/GF/Parsing/MCFG/Active2.hs
@@ -34,10 +34,9 @@ import GF.Infra.Print
 
 --parse :: (Ord n, Ord c, Ord l, Ord t) => String -> MCFParser c n l t
 parse strategy pinfo starts toks =
-    trace2 "MCFG.Active 2 - strategy" (if isBU strategy then "BU"
-				     else if isTD strategy then "TD" else "None") $
-    [ Abs (cat, found) (zip rhs rrecs) fun |
-      Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
     where chart = process strategy pinfo starts toks
 
 process :: (Ord n, Ord c, Ord l, Ord t) => 
diff --git a/src/GF/Parsing/MCFG/Incremental.hs b/src/GF/Parsing/MCFG/Incremental.hs
index 64a6c759e..bd5b4114d 100644
--- a/src/GF/Parsing/MCFG/Incremental.hs
+++ b/src/GF/Parsing/MCFG/Incremental.hs
@@ -18,6 +18,7 @@ import Control.Monad (guard)
 
 import GF.Data.Utilities (select)
 import GF.Data.GeneralDeduction
+import GF.Data.Assoc
 
 import GF.Formalism.GCFG
 import GF.Formalism.MCFG
@@ -34,14 +35,16 @@ import GF.Infra.Print
 
 parse :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
 parse pinfo starts toks =
-    [ Abs (cat, found) (zip rhs rrecs) fun |
-      Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
     where chart = process pinfo toks ntoks
 	  ntoks = snd (inputBounds toks)
 
 -- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
 parseR pinfo starts ntoks =
-    [ Abs (cat, found) (zip rhs rrecs) fun |
+    accumAssoc groupSyntaxNodes $
+    [ ((cat, found), SNode fun (zip rhs rrecs)) |
       Final (Abs cat rhs fun) found rrecs <- chartLookup chart Fin ]
     where chart = processR pinfo ntoks 
 
diff --git a/src/GF/Parsing/MCFG/Incremental2.hs b/src/GF/Parsing/MCFG/Incremental2.hs
index 880909758..db6c3084e 100644
--- a/src/GF/Parsing/MCFG/Incremental2.hs
+++ b/src/GF/Parsing/MCFG/Incremental2.hs
@@ -36,9 +36,10 @@ import GF.Infra.Print
 
 -- parseR :: (Ord n, Ord c, Ord l, Ord t) => MCFParser c n l t
 parse pinfo starts inp =
-    [ Abs (cat, found) (zip rhs rrecs) fun |
-      k <- uncurry enumFromTo (inputBounds inp),
-      Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
+    accumAssoc groupSyntaxNodes $
+      [ ((cat, found), SNode fun (zip rhs rrecs)) |
+        k <- uncurry enumFromTo (inputBounds inp),
+        Final (Abs cat rhs fun) found rrecs <- chartLookup chart k Fin ]
     where chart = process pinfo inp 
 
 --process :: (Ord n, Ord c, Ord l) => MCFPInfo c n l Range -> (Int, Int) -> IChart c n l
diff --git a/src/GF/Parsing/MCFG/Naive.hs b/src/GF/Parsing/MCFG/Naive.hs
index 8697f9c4c..7d1fa0a8a 100644
--- a/src/GF/Parsing/MCFG/Naive.hs
+++ b/src/GF/Parsing/MCFG/Naive.hs
@@ -34,15 +34,17 @@ import GF.Infra.Print
 -- | Builds a chart from the initial agenda, given by prediction, and the inference rules 
 parse :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
 parse pinfo starts toks
-    = [ Abs (cat, makeRangeRec lins) (zip rhs rrecs) fun |
-	Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
+    = accumAssoc groupSyntaxNodes $
+        [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
+          Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
     where chart = process pinfo toks
 
 -- | Builds a chart from the initial agenda, given by prediction, and the inference rules 
 -- parseR :: (Ord t, Ord n, Ord c, Ord l) => MCFParser c n l t
 parseR pinfo starts
-    = [ Abs (cat, makeRangeRec lins) (zip rhs rrecs) fun |
-	Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
+    = accumAssoc groupSyntaxNodes $
+        [ ((cat, makeRangeRec lins), SNode fun (zip rhs rrecs)) |
+	  Active (Abs cat _Nil fun, rhs) lins rrecs <- chartLookup chart Final ]
     where chart = processR pinfo
 
 process :: (Ord t, Ord n, Ord c, Ord l) => MCFPInfo c n l t -> Input t -> NChart c n l
diff --git a/src/GF/Parsing/MCFG/PInfo.hs b/src/GF/Parsing/MCFG/PInfo.hs
index 5a61a4edf..56119dcec 100644
--- a/src/GF/Parsing/MCFG/PInfo.hs
+++ b/src/GF/Parsing/MCFG/PInfo.hs
@@ -30,9 +30,7 @@ import GF.Parsing.MCFG.Range
 type MCFParser c n l t = MCFPInfo c n l t 
 		       -> [c]
 		       -> Input t
-		       -> MCFChart c n l
-
-type MCFChart  c n l   = [Abstract (c, RangeRec l) n]
+		       -> SyntaxChart n (c, RangeRec l)
 
 makeFinalEdge :: c -> l -> (Int, Int) -> (c, RangeRec l)
 makeFinalEdge cat lbl bnds = (cat, [(lbl, makeRange bnds)])