1
0
forked from GitHub/gf-core

Working with interfaces and incomplete modules.

This commit is contained in:
aarne
2003-10-23 15:09:07 +00:00
parent 31e0deb017
commit e620ffbd94
25 changed files with 764 additions and 327 deletions

View File

@@ -18,11 +18,13 @@ data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
data ModInfo i f a =
ModMainGrammar (MainGrammar i)
| ModMod (Module i f a)
| ModMod (Module i f a)
| ModWith (ModuleType i) ModuleStatus i [OpenSpec i]
deriving Show
data Module i f a = Module {
mtype :: ModuleType i ,
mstatus :: ModuleStatus ,
flags :: [f] ,
extends :: Maybe i ,
opens :: [OpenSpec i] ,
@@ -30,6 +32,20 @@ data Module i f a = Module {
}
deriving Show
-- encoding the type of the module
data ModuleType i =
MTAbstract
| MTTransfer (OpenSpec i) (OpenSpec i)
| MTResource
| MTConcrete i
-- up to this, also used in GFC. Below, source only.
| MTInterface
| MTInstance i
| MTReuse i
deriving (Eq,Show)
-- destructive update
--- dep order preserved since old cannot depend on new
@@ -41,8 +57,8 @@ updateMGrammar old new = MGrammar $
ns = modules new
updateModule :: Ord i => Module i f t -> i -> t -> Module i f t
updateModule (Module mt fs me ops js) i t =
Module mt fs me ops (updateTree (i,t) js)
updateModule (Module mt ms fs me ops js) i t =
Module mt ms fs me ops (updateTree (i,t) js)
data MainGrammar i = MainGrammar {
mainAbstract :: i ,
@@ -58,13 +74,29 @@ data MainConcreteSpec i = MainConcreteSpec {
}
deriving Show
data OpenSpec i = OSimple i | OQualif i i
data OpenSpec i =
OSimple OpenQualif i
| OQualif OpenQualif i i
deriving (Eq,Show)
data OpenQualif =
OQNormal
| OQInterface
| OQIncomplete
deriving (Eq,Show)
oSimple = OSimple OQNormal
oQualif = OQualif OQNormal
data ModuleStatus =
MSComplete
| MSIncomplete
deriving (Eq,Show)
openedModule :: OpenSpec i -> i
openedModule o = case o of
OSimple m -> m
OQualif _ m -> m
OSimple _ m -> m
OQualif _ _ m -> m
allOpens m = case mtype m of
MTTransfer a b -> a : b : opens m
@@ -75,9 +107,9 @@ depPathModule :: Ord i => Module i f a -> [OpenSpec i]
depPathModule m = fors m ++ exts m ++ opens m where
fors m = case mtype m of
MTTransfer i j -> [i,j]
MTConcrete i -> [OSimple i]
MTConcrete i -> [oSimple i]
_ -> []
exts m = map OSimple $ maybe [] return $ extends m
exts m = map oSimple $ maybe [] return $ extends m
-- all modules that a module extends, directly or indirectly
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
@@ -89,7 +121,7 @@ allExtends gr i = case lookupModule gr i of
-- initial search path: the nonqualified dependencies
searchPathModule :: Ord i => Module i f a -> [i]
searchPathModule m = [i | OSimple i <- depPathModule m]
searchPathModule m = [i | OSimple _ i <- depPathModule m]
-- a new module can safely be added to the end, since nothing old can depend on it
addModule :: Ord i =>
@@ -108,27 +140,14 @@ data IdentM i = IdentM {
}
deriving (Eq,Show)
-- encoding the type of the module
data ModuleType i =
MTAbstract
| MTTransfer (OpenSpec i) (OpenSpec i)
| MTResource
| MTResourceInt
| MTResourceImpl i
| MTConcrete i
| MTConcreteInt i i
| MTConcreteImpl i i i
| MTReuse i
deriving (Eq,Show)
typeOfModule mi = case mi of
ModMod m -> mtype m
isResourceModule mi = case typeOfModule mi of
MTResource -> True
MTReuse _ -> True
MTResourceInt -> True
MTResourceImpl _ -> True
--- MTInterface -> True
MTInstance _ -> True
_ -> False
abstractOfConcrete :: (Show i, Eq i) => MGrammar i f a -> i -> Err i
@@ -187,3 +206,11 @@ isModTrans m = case mtype m of
sameMType m n = case (m,n) of
(MTConcrete _, MTConcrete _) -> True
_ -> m == n
-- don't generate code for interfaces and for incomplete modules
isCompilableModule m = case m of
ModMod m -> case mtype m of
MTInterface -> False
_ -> mstatus m == MSComplete
_ -> False ---