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

@@ -42,6 +42,10 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
js' <- mapMTree (checkAbsInfo gr name) js
return $ (name, ModMod (Module mt fs me ops js')) : ms
MTTransfer a b -> do
js' <- mapMTree (checkAbsInfo gr name) js
return $ (name, ModMod (Module mt fs me ops js')) : ms
MTResource -> do
js' <- mapMTree (checkResInfo gr) js
return $ (name, ModMod (Module mt fs me ops js')) : ms

View File

@@ -43,6 +43,7 @@ redModInfo (c,info) = do
return (a', MTConcrete a')
MTAbstract -> return (c',MTAbstract) --- c' not needed
MTResource -> return (c',MTResource) --- c' not needed
MTTransfer x y -> return (c',MTTransfer (om x) (om y)) --- c' not needed
defss <- mapM (redInfo a) $ tree2list $ jments m
defs <- return $ sorted2tree $ concat defss -- sorted, but reduced
return $ ModMod $ Module mt flags e os defs
@@ -54,6 +55,7 @@ redModInfo (c,info) = do
_ -> return Nothing
os' <- mapM (\ (OQualif _ i) -> liftM OSimple (redIdent i)) $ opens m
return (e',os')
om = OSimple . openedModule --- normalizing away qualif
redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]
redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
@@ -69,6 +71,8 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
Yes t -> t
_ -> EData --- data vs. primitive
returns c' $ C.AbsFun typ df
AbsTrans t ->
returns c' $ C.AbsTrans t
ResParam (Yes ps) -> do
ps' <- mapM redParam ps

View File

@@ -117,7 +117,7 @@ tree2status o = case o of
buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
buildStatus gr c mo = let mo' = self2status c mo in case mo of
ModMod m -> do
let ops = opens m
let ops = allOpens m
mods <- mapM (lookupModule gr . openedModule) ops
let sts = map modInfo2status $ zip ops mods
return $ if isModCnc m
@@ -130,10 +130,14 @@ modInfo2status (o,i) = (o,case i of
)
self2status :: Ident -> SourceModInfo -> StatusTree
self2status c i = case i of
ModMod m -> mapTree (info2status (Just c)) (jments m) -- qualify internal
--- ModMod m -> mapTree (resInfo2status Nothing) (jments m)
-- change Lookup.qualifAnnot if you change this
self2status c i = mapTree (info2status (Just c)) js where -- qualify internal
js = case i of
ModMod m
| isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m
| otherwise -> jments m
noTrans (_,d) = case d of -- to enable other than transfer js in transfer module
AbsTrans _ -> False
_ -> True
forceQualif o = case o of
OSimple i -> OQualif i i
@@ -145,6 +149,7 @@ renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $
AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
(renPerh (mapM rent) pfs)
AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
AbsTrans f -> liftM AbsTrans (rent f)
ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
ResParam pp -> liftM ResParam (renPerh (mapM (renameParam status)) pp)