Transfer: Changed BNFC's layout syntax resolver to add a semicolon at EOF if using top-level layout sytax. Changed transfer syntax to use this to force semicolon after imports when pretty printing transfer. transfer grammar printer now produces Transfer syntax, not core. It also imports prelude and includes Eq and Compos instances.

src/GF/API/GrammarToTransfer.hs

@@ -22,62 +22,73 @@ import GF.Grammar.Macros
 import GF.Infra.Modules
 import GF.Data.Operations
 
-import Transfer.Core.Abs as C
-import Transfer.Core.Print
+import Transfer.Syntax.Abs as S
+import Transfer.Syntax.Print
 
 
 -- | the main function
 grammar2transfer :: GFC.CanonGrammar -> String
-grammar2transfer gr = printTree $ C.Module [cats2cat cat tree cats, funs2tree cat tree funs]
+grammar2transfer gr = printTree $ S.Module imports decls
   where
-  cat = C.CIdent "Cat" -- FIXME
-  tree = C.CIdent "Tree" -- FIXME
+  cat = S.Ident "Cat" -- FIXME
+  tree = S.Ident "Tree" -- FIXME
   defs = concat [tree2list (jments m) | im@(_,ModMod m) <- modules gr, isModAbs m]
   -- get category name and context
   cats = [(cat, c) | (cat,GFC.AbsCat c _) <- defs]
   -- get function name and type
   funs = [(fun, typ) | (fun,GFC.AbsFun typ _) <- defs]
   name = ifNull "UnknownModule" (symid . last) [n | (n,ModMod m) <- modules gr, isModAbs m]
-
-
+  imports = [Import (S.Ident "prelude")]
+  decls = [cats2cat cat tree cats, funs2tree cat tree funs] ++ instances tree
 
 
 -- | Create a declaration of the type of categories given a list
 --   of category names and their contexts.
-cats2cat :: CIdent -- ^ the name of the Cat type
-         -> CIdent -- ^ the name of the Tree type
+cats2cat :: S.Ident -- ^ the name of the Cat type
+         -> S.Ident -- ^ the name of the Tree type
          -> [(A.Ident,A.Context)] -> Decl
-cats2cat cat tree = C.DataDecl cat C.EType . map (uncurry catCons)
+cats2cat cat tree = S.DataDecl cat S.EType . map (uncurry catCons)
   where
-  catCons i c = C.ConsDecl (id2id i) (catConsType c)
-  catConsType = foldr pi (C.EVar cat)
-  pi (i,x) t = C.EPi (id2pv i) (addTree tree $ term2exp x) t
+  catCons i c = S.ConsDecl (id2id i) (catConsType c)
+  catConsType = foldr pi (S.EVar cat)
+  pi (i,x) t = mkPi (id2pv i) (addTree tree $ term2exp x) t
 
-funs2tree :: CIdent -- ^ the name of the Cat type
-          -> CIdent -- ^ the name of the Tree type
+funs2tree :: S.Ident -- ^ the name of the Cat type
+          -> S.Ident -- ^ the name of the Tree type
           -> [(A.Ident,A.Type)] -> Decl
 funs2tree cat tree = 
-    C.DataDecl tree (C.EPi C.PVWild (EVar cat) C.EType) . map (uncurry funCons)
+    S.DataDecl tree (S.EPiNoVar (S.EVar cat) S.EType) . map (uncurry funCons)
   where 
-  funCons i t = C.ConsDecl (id2id i) (addTree tree $ term2exp t)
+  funCons i t = S.ConsDecl (id2id i) (addTree tree $ term2exp t)
 
-term2exp :: A.Term -> C.Exp
+term2exp :: A.Term -> S.Exp
 term2exp t = case t of
-  A.Vr i         -> C.EVar (id2id i)
-  A.App t1 t2    -> C.EApp (term2exp t1) (term2exp t2)
-  A.Abs i t1     -> C.EAbs (id2pv i) (term2exp t1)
-  A.Prod i t1 t2 -> C.EPi (id2pv i) (term2exp t1) (term2exp t2)
-  A.Q m i        -> C.EVar (id2id i)
+  A.Vr i         -> S.EVar (id2id i)
+  A.App t1 t2    -> S.EApp (term2exp t1) (term2exp t2)
+  A.Abs i t1     -> S.EAbs (id2pv i) (term2exp t1)
+  A.Prod i t1 t2 -> mkPi (id2pv i) (term2exp t1) (term2exp t2)
+  A.Q m i        -> S.EVar (id2id i)
   _ -> error $ "term2exp: can't handle " ++ show t
 
-id2id :: A.Ident -> C.CIdent
-id2id = CIdent . symid
+mkPi :: S.VarOrWild -> S.Exp -> S.Exp -> S.Exp 
+mkPi VWild t e = S.EPiNoVar t e
+mkPi v     t e = S.EPi v t e
 
-id2pv :: A.Ident -> PatternVariable
-id2pv = C.PVVar . id2id
+id2id :: A.Ident -> S.Ident
+id2id = S.Ident . symid
+
+id2pv :: A.Ident -> S.VarOrWild
+id2pv i = case symid i of
+                       "h_" -> S.VWild -- FIXME: hacky?
+                       x    -> S.VVar (S.Ident x)
 
 -- FIXME: I think this is not general enoguh.
-addTree :: CIdent -> C.Exp -> C.Exp
+addTree :: S.Ident -> S.Exp -> S.Exp
 addTree tree x = case x of
-  C.EPi i t e -> C.EPi i (addTree tree t) (addTree tree e)
-  e -> C.EApp (C.EVar tree) e
+  S.EPi i t e -> S.EPi i (addTree tree t) (addTree tree e)
+  S.EPiNoVar t e -> S.EPiNoVar (addTree tree t) (addTree tree e)
+  e -> S.EApp (S.EVar tree) e
+
+instances :: S.Ident -> [S.Decl]
+instances tree = [DeriveDecl (S.Ident "Eq") tree, 
+                  DeriveDecl (S.Ident "Compos") tree]