data defs

2 files changed, 23 insertions, 15 deletions

diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index ad89d5540..ee54d7a16 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/30 21:08:15 $ 
+-- > CVS $Date: 2005/10/04 11:05:07 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.22 $
+-- > CVS $Revision: 1.23 $
 --
 -- From internal source syntax to BNFC-generated (used for printing).
 -----------------------------------------------------------------------------
@@ -77,11 +77,9 @@ mkTopDefs ds = ds
 
 trAnyDef :: (Ident,Info) -> [P.TopDef]
 trAnyDef (i,info) = let i' = tri i in case info of
-  AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]] ++ case pd of
-    Yes fs -> [P.DefData [P.DataDef i' [P.DataQId (tri m) (tri c) | QC m c <- fs]]]
-    _ -> []
+  AbsCat (Yes co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]]
+  AbsFun (Yes ty) (Yes EData) -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
   AbsFun (Yes ty) pt -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++ case pt of
-    Yes EData -> [] -- keep this information in data defs only
     Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
     _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 563b9cc97..421435bbc 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Date: 2005/10/04 11:05:07 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.27 $
+-- > CVS $Revision: 1.28 $
 --
 -- based on the skeleton Haskell module generated by the BNF converter
 -----------------------------------------------------------------------------
@@ -210,7 +210,12 @@ transAbsDef x = case x of
     returnl [(fun, G.AbsFun (yes typ) nope) | (funs,typ) <- fundefs', fun <- funs]
   DefFunData fundefs -> do
     fundefs' <- mapM transFunDef fundefs
-    returnl [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
+    returnl $
+      [(cat, G.AbsCat nope (yes [M.cn fun])) | (funs,typ) <- fundefs', 
+                                       fun <- funs, 
+                                       Ok (_,cat) <- [M.valCat typ]
+      ] ++
+      [(fun, G.AbsFun (yes typ) (yes G.EData)) | (funs,typ) <- fundefs', fun <- funs]
   DefDef defs  -> do
     defs' <- liftM concat $ mapM getDefsGen defs
     returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
@@ -246,25 +251,29 @@ transCatDef x = case x of
   SimpleCatDef id ddecls        -> liftM (:[]) $ cat id ddecls
   ListCatDef id ddecls          -> listCat id ddecls 0
   ListSizeCatDef id ddecls size -> listCat id ddecls size
- where cat id ddecls = do
+ where 
+   cat id ddecls = do
 		       i <- transIdent id
 		       cont <- liftM concat $ mapM transDDecl ddecls
 		       return (i, G.AbsCat (yes cont) nope)
-       listCat id ddecls size = do
+   listCat id ddecls size = do
 	 let 
            li = mkListId id
-	 catd@(_,G.AbsCat (Yes cont0) _) <- cat li ddecls
+           baseId = mkBaseId id
+           consId = mkConsId id
+	 catd0@(c,G.AbsCat (Yes cont0) _) <- cat li ddecls
 	 let
+  	   catd = (c,G.AbsCat (Yes cont0) (Yes [M.cn baseId,M.cn consId]))
            cont = [(mkId x i,ty) | (i,(x,ty)) <- zip [0..] cont0]
            xs = map (G.Vr . fst) cont 
            cd = M.mkDecl (M.mkApp (G.Vr id) xs)
 	   lc = M.mkApp (G.Vr li) xs
 	   niltyp = M.mkProdSimple (cont ++ genericReplicate size cd) lc
-	   nilfund = (mkBaseId id, G.AbsFun (yes niltyp) nope)
+	   nilfund = (baseId, G.AbsFun (yes niltyp) (yes G.EData))
 	   constyp = M.mkProdSimple (cont ++ [cd, M.mkDecl lc]) lc
-	   consfund = (mkConsId id, G.AbsFun (yes constyp) nope)
+	   consfund = (consId, G.AbsFun (yes constyp) (yes G.EData))
 	 return [catd,nilfund,consfund]
-       mkId x i = if isWildIdent x then (mkIdent "x" i) else x
+   mkId x i = if isWildIdent x then (mkIdent "x" i) else x
 
 transFunDef :: FunDef -> Err ([Ident], G.Type)
 transFunDef x = case x of
@@ -583,6 +592,7 @@ transOldGrammar opts name0 x = case x of
    srt d (a,r,c,ps) = case d of
      DefCat catdefs  -> (d:a,r,c,ps)
      DefFun fundefs  -> (d:a,r,c,ps)
+     DefFunData fundefs -> (d:a,r,c,ps)
      DefDef defs     -> (d:a,r,c,ps)
      DefData pardefs -> (d:a,r,c,ps)
      DefPar pardefs  -> (a,d:r,c,ps)