mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-21 18:59:32 -06:00
Added treatment of transfer modules. Aggregation is an example.
This commit is contained in:
@@ -5,6 +5,7 @@ import Ident --H
|
||||
-- Haskell module generated by the BNF converter, except --H
|
||||
|
||||
-- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
|
||||
|
||||
newtype LString = LString String deriving (Eq,Ord,Show)
|
||||
data Grammar =
|
||||
Gr [ModDef]
|
||||
@@ -65,7 +66,7 @@ data TopDef =
|
||||
| DefFun [FunDef]
|
||||
| DefDef [Def]
|
||||
| DefData [DataDef]
|
||||
| DefTrans [FlagDef]
|
||||
| DefTrans [Def]
|
||||
| DefPar [ParDef]
|
||||
| DefOper [Def]
|
||||
| DefLincat [PrintDef]
|
||||
|
||||
@@ -20,10 +20,11 @@ trModule (i,mo) = case mo of
|
||||
(map trFlag (flags m))))
|
||||
where
|
||||
i' = tri i
|
||||
mkModule = case typeOfModule mo of
|
||||
MTResource -> P.MResource
|
||||
MTAbstract -> P.MAbstract
|
||||
MTConcrete a -> P.MConcrete (tri a)
|
||||
mkModule m = case typeOfModule mo of
|
||||
MTResource -> P.MResource m
|
||||
MTAbstract -> P.MAbstract m
|
||||
MTConcrete a -> P.MConcrete m (tri a)
|
||||
MTTransfer a b -> P.MTransfer m (trOpen a) (trOpen b)
|
||||
|
||||
trExtend :: Maybe Ident -> P.Extend
|
||||
trExtend i = maybe P.NoExt (P.Ext . tri) i
|
||||
@@ -50,6 +51,7 @@ trAnyDef (i,info) = let i' = tri i in case info of
|
||||
_ -> []
|
||||
AbsFun (May b) _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
|
||||
---- don't destroy definitions!
|
||||
AbsTrans f -> [P.DefTrans [P.DDef [i'] (trt f)]]
|
||||
|
||||
ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
|
||||
ResParam pp -> [P.DefPar [case pp of
|
||||
|
||||
@@ -166,7 +166,7 @@ instance Print TopDef where
|
||||
DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
|
||||
DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
|
||||
DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs])
|
||||
DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
|
||||
DefTrans defs -> prPrec i 0 (concat [["transfer"] , prt 0 defs])
|
||||
DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
|
||||
DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
|
||||
DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs])
|
||||
|
||||
@@ -88,7 +88,7 @@ transTopDef x = case x of
|
||||
DefFun fundefs -> failure x
|
||||
DefDef defs -> failure x
|
||||
DefData datadefs -> failure x
|
||||
DefTrans flagdefs -> failure x
|
||||
DefTrans defs -> failure x
|
||||
DefPar pardefs -> failure x
|
||||
DefOper defs -> failure x
|
||||
DefLincat printdefs -> failure x
|
||||
|
||||
@@ -150,9 +150,8 @@ transAbsDef x = case x of
|
||||
[(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
|
||||
[(f, G.AbsFun nope (yes G.EData)) | (_,fs) <- ds', tf <- fs, f <- funs tf]
|
||||
DefTrans defs -> do
|
||||
let (ids,vals) = unzip [(i,v) | FlagDef i v <- defs]
|
||||
defs' <- liftM2 zip (mapM transIdent ids) (mapM transIdent vals)
|
||||
returnl [(c, G.AbsTrans f) | (c,f) <- defs']
|
||||
defs' <- liftM concat $ mapM getDefsGen defs
|
||||
returnl [(c, G.AbsTrans f) | (c,(_,Yes f)) <- defs']
|
||||
DefFlag defs -> liftM Right $ mapM transFlagDef defs
|
||||
_ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user