summaryrefslogtreecommitdiff
path: root/src/GF/API/GrammarToTransfer.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/API/GrammarToTransfer.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/API/GrammarToTransfer.hs')
-rw-r--r--src/GF/API/GrammarToTransfer.hs94
1 files changed, 0 insertions, 94 deletions
diff --git a/src/GF/API/GrammarToTransfer.hs b/src/GF/API/GrammarToTransfer.hs
deleted file mode 100644
index 658c15184..000000000
--- a/src/GF/API/GrammarToTransfer.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : GrammarToTransfer
--- Maintainer : Björn Bringert
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 12:39:07 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.8 $
---
--- Creates a data type definition in the transfer language
--- for an abstract module.
------------------------------------------------------------------------------
-
-module GF.API.GrammarToTransfer (grammar2transfer) where
-
-import qualified GF.Canon.GFC as GFC
-import qualified GF.Grammar.Abstract as A
-import GF.Grammar.Macros
-
-import GF.Infra.Modules
-import GF.Data.Operations
-
-import Transfer.Syntax.Abs as S
-import Transfer.Syntax.Print
-
-
--- | the main function
-grammar2transfer :: GFC.CanonGrammar -> String
-grammar2transfer gr = printTree $ S.Module imports decls
- where
- 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 :: S.Ident -- ^ the name of the Cat type
- -> S.Ident -- ^ the name of the Tree type
- -> [(A.Ident,A.Context)] -> Decl
-cats2cat cat tree = S.DataDecl cat S.EType . map (uncurry catCons)
- where
- 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 :: S.Ident -- ^ the name of the Cat type
- -> S.Ident -- ^ the name of the Tree type
- -> [(A.Ident,A.Type)] -> Decl
-funs2tree cat tree =
- S.DataDecl tree (S.EPiNoVar (S.EVar cat) S.EType) . map (uncurry funCons)
- where
- funCons i t = S.ConsDecl (id2id i) (addTree tree $ term2exp t)
-
-term2exp :: A.Term -> S.Exp
-term2exp t = case t of
- 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
-
-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
-
-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 :: S.Ident -> S.Exp -> S.Exp
-addTree tree x = case x of
- 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]