Added treatment of transfer modules. Aggregation is an example.

This commit is contained in:
aarne
2003-10-09 15:23:32 +00:00
parent ddd103ccd7
commit 2ee936c7e2
29 changed files with 311 additions and 50 deletions

View File

@@ -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]

View File

@@ -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

View File

@@ -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])

View File

@@ -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

View File

@@ -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