diff --git a/src/GF/API/GrammarToTransfer.hs b/src/GF/API/GrammarToTransfer.hs index 0f4fa6a6f..960673d08 100644 --- a/src/GF/API/GrammarToTransfer.hs +++ b/src/GF/API/GrammarToTransfer.hs @@ -28,8 +28,10 @@ import Transfer.Core.Print -- | the main function grammar2transfer :: GFC.CanonGrammar -> String -grammar2transfer gr = printTree $ C.Module [cats2cat cats, funs2tree funs] +grammar2transfer gr = printTree $ C.Module [cats2cat cat tree cats, funs2tree cat tree funs] where + cat = C.CIdent "Cat" -- FIXME + tree = C.CIdent "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] @@ -38,23 +40,26 @@ grammar2transfer gr = printTree $ C.Module [cats2cat cats, funs2tree funs] name = ifNull "UnknownModule" (symid . last) [n | (n,ModMod m) <- modules gr, isModAbs m] -cat = C.CIdent "Cat" -- FIXME -tree = C.CIdent "Tree" -- FIXME + -- | Create a declaration of the type of categories given a list -- of category names and their contexts. -cats2cat :: [(A.Ident,A.Context)] -> Decl -cats2cat = C.DataDecl cat C.EType . map (uncurry catCons) +cats2cat :: CIdent -- ^ the name of the Cat type + -> CIdent -- ^ the name of the Tree type + -> [(A.Ident,A.Context)] -> Decl +cats2cat cat tree = C.DataDecl cat C.EType . map (uncurry catCons) where - catCons i c = C.ConsDecl (id2id i) (catConsType c) + catCons i c = C.ConsDecl (id2id i) (addTree tree $ catConsType c) catConsType = foldr pi (C.EVar cat) pi (i,x) t = C.EPi (id2pv i) (term2exp x) t -funs2tree :: [(A.Ident,A.Type)] -> Decl -funs2tree = +funs2tree :: CIdent -- ^ the name of the Cat type + -> CIdent -- ^ 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) where - funCons i t = C.ConsDecl (id2id i) (term2exp t) + funCons i t = C.ConsDecl (id2id i) (addTree tree $ term2exp t) term2exp :: A.Term -> C.Exp term2exp t = case t of @@ -70,3 +75,9 @@ id2id = CIdent . symid id2pv :: A.Ident -> PatternVariable id2pv = C.PVVar . id2id + +-- FIXME: I think this is not general enoguh. +addTree :: CIdent -> C.Exp -> C.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 \ No newline at end of file