no need to keep the list of constructors per category in .gfo

7 files changed, 18 insertions, 21 deletions

diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs
index 7e56492cb..8ac7f4dea 100644
--- a/src/compiler/GF/Grammar/Binary.hs
+++ b/src/compiler/GF/Grammar/Binary.hs
@@ -87,7 +87,7 @@ instance Binary Options where
              Bad msg -> fail msg

 

 instance Binary Info where

-  put (AbsCat x y)     = putWord8 0 >> put (x,y)

+  put (AbsCat x)       = putWord8 0 >> put x

   put (AbsFun x y z)   = putWord8 1 >> put (x,y,z)

   put (ResParam x y)   = putWord8 2 >> put (x,y)

   put (ResValue x)     = putWord8 3 >> put x

@@ -98,7 +98,7 @@ instance Binary Info where
   put (AnyInd x y)     = putWord8 8 >> put (x,y)

   get = do tag <- getWord8

            case tag of

-             0 -> get >>= \(x,y)   -> return (AbsCat x y)

+             0 -> get >>= \x       -> return (AbsCat x)

              1 -> get >>= \(x,y,z) -> return (AbsFun x y z)

              2 -> get >>= \(x,y)   -> return (ResParam x y)

              3 -> get >>= \x       -> return (ResValue x)

diff --git a/src/compiler/GF/Grammar/CF.hs b/src/compiler/GF/Grammar/CF.hs
index a1d716994..e883d0552 100644
--- a/src/compiler/GF/Grammar/CF.hs
+++ b/src/compiler/GF/Grammar/CF.hs
@@ -99,9 +99,9 @@ cf2grammar rules = (buildTree abs, buildTree conc, cat) where
   cat   = case rules of
             (_,(c,_)):_ -> c  -- the value category of the first rule
             _ -> error "empty CF" 
-  cats  = [(cat, AbsCat (Just []) (Just [])) | 
+  cats  = [(cat, AbsCat (Just [])) | 
              cat <- nub (concat (map cf2cat rules))] ----notPredef cat
-  lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _ _) <- cats]
+  lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _) <- cats]
   (funs,lins) = unzip (map cf2rule rules)
 
 cf2cat :: CFRule -> [Ident]
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index e0ca01341..b39e0f160 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -75,7 +75,7 @@ mapSourceModule f (i,mi) = (i, f mi)
 -- and indirection to module (/INDIR/)
 data Info =
 -- judgements in abstract syntax
-   AbsCat   (Maybe Context) (Maybe [Term])               -- ^ (/ABS/) the second parameter is list of constructors - must be 'Id' or 'QId'
+   AbsCat   (Maybe Context)
  | AbsFun   (Maybe Type) (Maybe Int) (Maybe [Equation])  -- ^ (/ABS/) type, arrity and definition of function
 
 -- judgements in resource
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index d56c1ee30..14f1ab498 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -183,6 +183,6 @@ lookupCatContext gr m c = do
   mo <- lookupModule gr m
   info <- lookupIdentInfo mo c
   case info of
-    AbsCat (Just co) _ -> return co
-    AnyInd _ n         -> lookupCatContext gr n c
-    _                  -> Bad (render (text "unknown category" <+> ppIdent c))
+    AbsCat (Just co) -> return co
+    AnyInd _ n       -> lookupCatContext gr n c
+    _                -> Bad (render (text "unknown category" <+> ppIdent c))
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index 799cd9ec5..ef68b740d 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -615,7 +615,7 @@ allDependencies ism b =
       CncCat pty _ _ -> [pty]
       CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
       AbsFun pty _ ptr -> [pty] --- ptr is def, which can be mutual
-      AbsCat (Just co) _ -> [Just ty | (_,_,ty) <- co]
+      AbsCat (Just co) -> [Just ty | (_,_,ty) <- co]
       _              -> []
 
 topoSortJments :: SourceModule -> Err [(Ident,Info)]
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index ef4a5d84b..2a08caa1b 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -232,7 +232,7 @@ TopDef
 
 CatDef :: { [(Ident,SrcSpan,Info)] }
 CatDef
-  : Posn Ident ListDDecl                         Posn { [($2, ($1,$4), AbsCat (Just $3) Nothing)]        }
+  : Posn Ident ListDDecl                         Posn { [($2, ($1,$4), AbsCat (Just $3))]        }
   | Posn '[' Ident ListDDecl ']'                 Posn { listCatDef $3 ($1,$6) $4 0                 }
   | Posn '[' Ident ListDDecl ']' '{' Integer '}' Posn { listCatDef $3 ($1,$9) $4 (fromIntegral $7) }
 
@@ -247,9 +247,9 @@ DefDef
 
 DataDef :: { [(Ident,SrcSpan,Info)] }
 DataDef
-  : Posn Ident '=' ListDataConstr Posn { ($2,   ($1,$5), AbsCat Nothing   (Just (map Cn $4))) :
+  : Posn Ident '=' ListDataConstr Posn { ($2,   ($1,$5), AbsCat Nothing) :
                                          [(fun, ($1,$5), AbsFun Nothing   Nothing Nothing) | fun <- $4] }
-  | Posn ListIdent ':' Exp Posn        { -- (snd (valCat $4), ($1,$5), AbsCat Nothing   (Just (map Cn $2))) :
+  | Posn ListIdent ':' Exp Posn        { -- (snd (valCat $4), ($1,$5), AbsCat Nothing) :
                                          [(fun, ($1,$5), AbsFun (Just $4) Nothing Nothing) | fun <- $2] }                                         
 
 ParamDef :: { [(Ident,SrcSpan,Info)] }
@@ -621,7 +621,7 @@ listCatDef id pos cont size = [catd,nilfund,consfund]
     baseId = mkBaseId id
     consId = mkConsId id
 
-    catd     = (listId, pos, AbsCat (Just cont')   (Just [Cn baseId,Cn consId]))
+    catd     = (listId, pos, AbsCat (Just cont'))
     nilfund  = (baseId, pos, AbsFun (Just niltyp)  Nothing Nothing)
     consfund = (consId, pos, AbsFun (Just constyp) Nothing Nothing)
 
@@ -679,7 +679,7 @@ type SrcSpan = (Posn,Posn)
 
 checkInfoType MTAbstract       (id,pos,info) =
   case info of
-    AbsCat _ _   -> return ()
+    AbsCat _     -> return ()
     AbsFun _ _ _ -> return ()
     _            -> failLoc (fst pos) "illegal definition in abstract module" 
 checkInfoType MTResource       (id,pos,info) =
diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs
index befc61932..4ead4e0bb 100644
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -25,7 +25,7 @@ import GF.Grammar.Values
 import GF.Grammar.Grammar

 

 import Text.PrettyPrint

-import Data.Maybe (maybe)

+import Data.Maybe (maybe, isNothing)

 import Data.List  (intersperse)

 import qualified Data.Map as Map

 

@@ -71,17 +71,14 @@ ppOptions opts =
   text "flags" $$

   nest 2 (vcat [text option <+> equals <+> str value <+> semi | (option,value) <- optionsGFO opts])

 

-ppJudgement q (id, AbsCat pcont pconstrs) =

+ppJudgement q (id, AbsCat pcont ) =

   text "cat" <+> ppIdent id <+>

   (case pcont of

      Just cont -> hsep (map (ppDecl q) cont)

-     Nothing   -> empty) <+> semi $$

-  case pconstrs of

-    Just costrs -> text "data" <+> ppIdent id <+> equals <+> fsep (intersperse (char '|') (map (ppTerm q 0) costrs)) <+> semi

-    Nothing     -> empty

+     Nothing   -> empty) <+> semi

 ppJudgement q (id, AbsFun ptype _ pexp) =

   (case ptype of

-     Just typ   -> text "fun" <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi

+     Just typ   -> text (if isNothing pexp then "data" else "fun") <+> ppIdent id <+> colon <+> ppTerm q 0 typ <+> semi

      Nothing    -> empty) $$

   (case pexp of

      Just []  -> empty