code polishing for the literal category support

3 files changed, 30 insertions, 8 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,