forked from GitHub/gf-core
Get rid of the 'f' type parameter to the module types.
This was only ever instantiated with Option, and made it diificult to change the options type.
This commit is contained in:
@@ -540,7 +540,7 @@ prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n
|
|||||||
|
|
||||||
-- | this function finds out what modules are really needed in the canonical gr.
|
-- | this function finds out what modules are really needed in the canonical gr.
|
||||||
-- its argument is typically a concrete module name
|
-- its argument is typically a concrete module name
|
||||||
requiredCanModules :: (Ord i, Show i) => Bool -> M.MGrammar i f a -> i -> [i]
|
requiredCanModules :: (Ord i, Show i) => Bool -> M.MGrammar i a -> i -> [i]
|
||||||
requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
|
requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
|
||||||
exts = M.allExtends gr c
|
exts = M.allExtends gr c
|
||||||
ops = if isSingle
|
ops = if isSingle
|
||||||
|
|||||||
@@ -125,7 +125,7 @@ openInterfaces ds m = do
|
|||||||
|
|
||||||
-- | this function finds out what modules are really needed in the canonical gr.
|
-- | this function finds out what modules are really needed in the canonical gr.
|
||||||
-- its argument is typically a concrete module name
|
-- its argument is typically a concrete module name
|
||||||
requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i f a -> i -> [i]
|
requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i a -> i -> [i]
|
||||||
requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
|
requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
|
||||||
exts = allExtends gr c
|
exts = allExtends gr c
|
||||||
ops = if isSingle
|
ops = if isSingle
|
||||||
|
|||||||
@@ -62,15 +62,15 @@ import GF.Data.Operations
|
|||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
|
||||||
-- | grammar as presented to the compiler
|
-- | grammar as presented to the compiler
|
||||||
type SourceGrammar = MGrammar Ident Option Info
|
type SourceGrammar = MGrammar Ident Info
|
||||||
|
|
||||||
type SourceModInfo = ModInfo Ident Option Info
|
type SourceModInfo = ModInfo Ident Info
|
||||||
|
|
||||||
type SourceModule = (Ident, SourceModInfo)
|
type SourceModule = (Ident, SourceModInfo)
|
||||||
|
|
||||||
type SourceAbs = Module Ident Option Info
|
type SourceAbs = Module Ident Info
|
||||||
type SourceRes = Module Ident Option Info
|
type SourceRes = Module Ident Info
|
||||||
type SourceCnc = Module Ident Option Info
|
type SourceCnc = Module Ident Info
|
||||||
|
|
||||||
-- this is created in CheckGrammar, and so are Val and PVal
|
-- this is created in CheckGrammar, and so are Val and PVal
|
||||||
type PValues = [Term]
|
type PValues = [Term]
|
||||||
|
|||||||
@@ -245,5 +245,5 @@ lookupIdent c t = case lookupTree prt c t of
|
|||||||
Ok v -> return v
|
Ok v -> return v
|
||||||
_ -> prtBad "unknown identifier" c
|
_ -> prtBad "unknown identifier" c
|
||||||
|
|
||||||
lookupIdentInfo :: Module Ident f a -> Ident -> Err a
|
lookupIdentInfo :: Module Ident a -> Ident -> Err a
|
||||||
lookupIdentInfo mo i = lookupIdent i (jments mo)
|
lookupIdentInfo mo i = lookupIdent i (jments mo)
|
||||||
|
|||||||
+50
-50
@@ -53,25 +53,25 @@ import Data.List
|
|||||||
-- The parameters tell what kind of data is involved.
|
-- The parameters tell what kind of data is involved.
|
||||||
-- Invariant: modules are stored in dependency order
|
-- Invariant: modules are stored in dependency order
|
||||||
|
|
||||||
data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
|
data MGrammar i a = MGrammar {modules :: [(i,ModInfo i a)]}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
data ModInfo i f a =
|
data ModInfo i a =
|
||||||
ModMainGrammar (MainGrammar i)
|
ModMainGrammar (MainGrammar i)
|
||||||
| ModMod (Module i f a)
|
| ModMod (Module i a)
|
||||||
| ModWith (Module i f a) (i,MInclude i) [OpenSpec i]
|
| ModWith (Module i a) (i,MInclude i) [OpenSpec i]
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
data Module i f a = Module {
|
data Module i a = Module {
|
||||||
mtype :: ModuleType i ,
|
mtype :: ModuleType i ,
|
||||||
mstatus :: ModuleStatus ,
|
mstatus :: ModuleStatus ,
|
||||||
flags :: [f] ,
|
flags :: [Option] ,
|
||||||
extend :: [(i,MInclude i)],
|
extend :: [(i,MInclude i)],
|
||||||
opens :: [OpenSpec i] ,
|
opens :: [OpenSpec i] ,
|
||||||
jments :: BinTree i a
|
jments :: BinTree i a
|
||||||
}
|
}
|
||||||
--- deriving Show
|
--- deriving Show
|
||||||
instance Show (Module i f a) where
|
instance Show (Module i a) where
|
||||||
show _ = "cannot show Module with FiniteMap"
|
show _ = "cannot show Module with FiniteMap"
|
||||||
|
|
||||||
-- | encoding the type of the module
|
-- | encoding the type of the module
|
||||||
@@ -93,7 +93,7 @@ data MReuseType i = MRInterface i | MRInstance i i | MRResource i
|
|||||||
data MInclude i = MIAll | MIOnly [i] | MIExcept [i]
|
data MInclude i = MIAll | MIOnly [i] | MIExcept [i]
|
||||||
deriving (Show,Eq)
|
deriving (Show,Eq)
|
||||||
|
|
||||||
extends :: Module i f a -> [i]
|
extends :: Module i a -> [i]
|
||||||
extends = map fst . extend
|
extends = map fst . extend
|
||||||
|
|
||||||
isInherited :: Eq i => MInclude i -> i -> Bool
|
isInherited :: Eq i => MInclude i -> i -> Bool
|
||||||
@@ -108,37 +108,37 @@ inheritAll i = (i,MIAll)
|
|||||||
-- destructive update
|
-- destructive update
|
||||||
|
|
||||||
-- | dep order preserved since old cannot depend on new
|
-- | dep order preserved since old cannot depend on new
|
||||||
updateMGrammar :: Ord i => MGrammar i f a -> MGrammar i f a -> MGrammar i f a
|
updateMGrammar :: Ord i => MGrammar i a -> MGrammar i a -> MGrammar i a
|
||||||
updateMGrammar old new = MGrammar $
|
updateMGrammar old new = MGrammar $
|
||||||
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
|
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
|
||||||
where
|
where
|
||||||
os = modules old
|
os = modules old
|
||||||
ns = modules new
|
ns = modules new
|
||||||
|
|
||||||
updateModule :: Ord i => Module i f t -> i -> t -> Module i f t
|
updateModule :: Ord i => Module i t -> i -> t -> Module i t
|
||||||
updateModule (Module mt ms fs me ops js) i t =
|
updateModule (Module mt ms fs me ops js) i t =
|
||||||
Module mt ms fs me ops (updateTree (i,t) js)
|
Module mt ms fs me ops (updateTree (i,t) js)
|
||||||
|
|
||||||
replaceJudgements :: Module i f t -> BinTree i t -> Module i f t
|
replaceJudgements :: Module i t -> BinTree i t -> Module i t
|
||||||
replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
|
replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
|
||||||
|
|
||||||
addOpenQualif :: i -> i -> Module i f t -> Module i f t
|
addOpenQualif :: i -> i -> Module i t -> Module i t
|
||||||
addOpenQualif i j (Module mt ms fs me ops js) =
|
addOpenQualif i j (Module mt ms fs me ops js) =
|
||||||
Module mt ms fs me (oQualif i j : ops) js
|
Module mt ms fs me (oQualif i j : ops) js
|
||||||
|
|
||||||
addFlag :: f -> Module i f t -> Module i f t
|
addFlag :: Option -> Module i t -> Module i t
|
||||||
addFlag f mo = mo {flags = f : flags mo}
|
addFlag f mo = mo {flags = f : flags mo}
|
||||||
|
|
||||||
flagsModule :: (i,ModInfo i f a) -> [f]
|
flagsModule :: (i,ModInfo i a) -> [Option]
|
||||||
flagsModule (_,mi) = case mi of
|
flagsModule (_,mi) = case mi of
|
||||||
ModMod m -> flags m
|
ModMod m -> flags m
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
allFlags :: MGrammar i f a -> [f]
|
allFlags :: MGrammar i a -> [Option]
|
||||||
allFlags gr = concat $ map flags $ [m | (_, ModMod m) <- modules gr]
|
allFlags gr = concat $ map flags $ [m | (_, ModMod m) <- modules gr]
|
||||||
|
|
||||||
mapModules :: (Module i f a -> Module i f a)
|
mapModules :: (Module i a -> Module i a)
|
||||||
-> MGrammar i f a -> MGrammar i f a
|
-> MGrammar i a -> MGrammar i a
|
||||||
mapModules f = MGrammar . map (onSnd mapModules') . modules
|
mapModules f = MGrammar . map (onSnd mapModules') . modules
|
||||||
where mapModules' (ModMod m) = ModMod (f m)
|
where mapModules' (ModMod m) = ModMod (f m)
|
||||||
mapModules' m = m
|
mapModules' m = m
|
||||||
@@ -184,13 +184,13 @@ openedModule o = case o of
|
|||||||
OSimple _ m -> m
|
OSimple _ m -> m
|
||||||
OQualif _ _ m -> m
|
OQualif _ _ m -> m
|
||||||
|
|
||||||
allOpens :: Module i f a -> [OpenSpec i]
|
allOpens :: Module i a -> [OpenSpec i]
|
||||||
allOpens m = case mtype m of
|
allOpens m = case mtype m of
|
||||||
MTTransfer a b -> a : b : opens m
|
MTTransfer a b -> a : b : opens m
|
||||||
_ -> opens m
|
_ -> opens m
|
||||||
|
|
||||||
-- | initial dependency list
|
-- | initial dependency list
|
||||||
depPathModule :: Ord i => Module i f a -> [OpenSpec i]
|
depPathModule :: Ord i => Module i a -> [OpenSpec i]
|
||||||
depPathModule m = fors m ++ exts m ++ opens m where
|
depPathModule m = fors m ++ exts m ++ opens m where
|
||||||
fors m = case mtype m of
|
fors m = case mtype m of
|
||||||
MTTransfer i j -> [i,j]
|
MTTransfer i j -> [i,j]
|
||||||
@@ -200,7 +200,7 @@ depPathModule m = fors m ++ exts m ++ opens m where
|
|||||||
exts m = map oSimple $ extends m
|
exts m = map oSimple $ extends m
|
||||||
|
|
||||||
-- | all dependencies
|
-- | all dependencies
|
||||||
allDepsModule :: Ord i => MGrammar i f a -> Module i f a -> [OpenSpec i]
|
allDepsModule :: Ord i => MGrammar i a -> Module i a -> [OpenSpec i]
|
||||||
allDepsModule gr m = iterFix add os0 where
|
allDepsModule gr m = iterFix add os0 where
|
||||||
os0 = depPathModule m
|
os0 = depPathModule m
|
||||||
add os = [m | o <- os, Just (ModMod n) <- [lookup (openedModule o) mods],
|
add os = [m | o <- os, Just (ModMod n) <- [lookup (openedModule o) mods],
|
||||||
@@ -208,7 +208,7 @@ allDepsModule gr m = iterFix add os0 where
|
|||||||
mods = modules gr
|
mods = modules gr
|
||||||
|
|
||||||
-- | select just those modules that a given one depends on, including itself
|
-- | select just those modules that a given one depends on, including itself
|
||||||
partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a
|
partOfGrammar :: Ord i => MGrammar i a -> (i,ModInfo i a) -> MGrammar i a
|
||||||
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
||||||
where
|
where
|
||||||
mods = modules gr
|
mods = modules gr
|
||||||
@@ -218,7 +218,7 @@ partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
|||||||
_ -> [i]
|
_ -> [i]
|
||||||
|
|
||||||
-- | all modules that a module extends, directly or indirectly, without restricts
|
-- | all modules that a module extends, directly or indirectly, without restricts
|
||||||
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
allExtends :: (Show i,Ord i) => MGrammar i a -> i -> [i]
|
||||||
allExtends gr i = case lookupModule gr i of
|
allExtends gr i = case lookupModule gr i of
|
||||||
Ok (ModMod m) -> case extends m of
|
Ok (ModMod m) -> case extends m of
|
||||||
[] -> [i]
|
[] -> [i]
|
||||||
@@ -226,7 +226,7 @@ allExtends gr i = case lookupModule gr i of
|
|||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
-- | all modules that a module extends, directly or indirectly, with restricts
|
-- | all modules that a module extends, directly or indirectly, with restricts
|
||||||
allExtendSpecs :: (Show i,Ord i) => MGrammar i f a -> i -> [(i,MInclude i)]
|
allExtendSpecs :: (Show i,Ord i) => MGrammar i a -> i -> [(i,MInclude i)]
|
||||||
allExtendSpecs gr i = case lookupModule gr i of
|
allExtendSpecs gr i = case lookupModule gr i of
|
||||||
Ok (ModMod m) -> case extend m of
|
Ok (ModMod m) -> case extend m of
|
||||||
[] -> [(i,MIAll)]
|
[] -> [(i,MIAll)]
|
||||||
@@ -234,7 +234,7 @@ allExtendSpecs gr i = case lookupModule gr i of
|
|||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
-- | this plus that an instance extends its interface
|
-- | this plus that an instance extends its interface
|
||||||
allExtendsPlus :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
allExtendsPlus :: (Show i,Ord i) => MGrammar i a -> i -> [i]
|
||||||
allExtendsPlus gr i = case lookupModule gr i of
|
allExtendsPlus gr i = case lookupModule gr i of
|
||||||
Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
|
Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
|
||||||
_ -> []
|
_ -> []
|
||||||
@@ -242,7 +242,7 @@ allExtendsPlus gr i = case lookupModule gr i of
|
|||||||
exts m = extends m ++ [j | MTInstance j <- [mtype m]]
|
exts m = extends m ++ [j | MTInstance j <- [mtype m]]
|
||||||
|
|
||||||
-- | conversely: all modules that extend a given module, incl. instances of interface
|
-- | conversely: all modules that extend a given module, incl. instances of interface
|
||||||
allExtensions :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
allExtensions :: (Show i,Ord i) => MGrammar i a -> i -> [i]
|
||||||
allExtensions gr i = case lookupModule gr i of
|
allExtensions gr i = case lookupModule gr i of
|
||||||
Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
|
Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
|
||||||
_ -> []
|
_ -> []
|
||||||
@@ -252,21 +252,21 @@ allExtensions gr i = case lookupModule gr i of
|
|||||||
mods = [(j,m) | (j,ModMod m) <- modules gr]
|
mods = [(j,m) | (j,ModMod m) <- modules gr]
|
||||||
|
|
||||||
-- | initial search path: the nonqualified dependencies
|
-- | initial search path: the nonqualified dependencies
|
||||||
searchPathModule :: Ord i => Module i f a -> [i]
|
searchPathModule :: Ord i => Module i 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
|
-- | a new module can safely be added to the end, since nothing old can depend on it
|
||||||
addModule :: Ord i =>
|
addModule :: Ord i =>
|
||||||
MGrammar i f a -> i -> ModInfo i f a -> MGrammar i f a
|
MGrammar i a -> i -> ModInfo i a -> MGrammar i a
|
||||||
addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
|
addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
|
||||||
|
|
||||||
emptyMGrammar :: MGrammar i f a
|
emptyMGrammar :: MGrammar i a
|
||||||
emptyMGrammar = MGrammar []
|
emptyMGrammar = MGrammar []
|
||||||
|
|
||||||
emptyModInfo :: ModInfo i f a
|
emptyModInfo :: ModInfo i a
|
||||||
emptyModInfo = ModMod emptyModule
|
emptyModInfo = ModMod emptyModule
|
||||||
|
|
||||||
emptyModule :: Module i f a
|
emptyModule :: Module i a
|
||||||
emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
|
emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
|
||||||
|
|
||||||
-- | we store the module type with the identifier
|
-- | we store the module type with the identifier
|
||||||
@@ -276,11 +276,11 @@ data IdentM i = IdentM {
|
|||||||
}
|
}
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show)
|
||||||
|
|
||||||
typeOfModule :: ModInfo i f a -> ModuleType i
|
typeOfModule :: ModInfo i a -> ModuleType i
|
||||||
typeOfModule mi = case mi of
|
typeOfModule mi = case mi of
|
||||||
ModMod m -> mtype m
|
ModMod m -> mtype m
|
||||||
|
|
||||||
abstractOfConcrete :: (Show i, Eq i) => MGrammar i f a -> i -> Err i
|
abstractOfConcrete :: (Show i, Eq i) => MGrammar i a -> i -> Err i
|
||||||
abstractOfConcrete gr c = do
|
abstractOfConcrete gr c = do
|
||||||
m <- lookupModule gr c
|
m <- lookupModule gr c
|
||||||
case m of
|
case m of
|
||||||
@@ -290,7 +290,7 @@ abstractOfConcrete gr c = do
|
|||||||
_ -> Bad $ "expected concrete" +++ show c
|
_ -> Bad $ "expected concrete" +++ show c
|
||||||
|
|
||||||
abstractModOfConcrete :: (Show i, Eq i) =>
|
abstractModOfConcrete :: (Show i, Eq i) =>
|
||||||
MGrammar i f a -> i -> Err (Module i f a)
|
MGrammar i a -> i -> Err (Module i a)
|
||||||
abstractModOfConcrete gr c = do
|
abstractModOfConcrete gr c = do
|
||||||
a <- abstractOfConcrete gr c
|
a <- abstractOfConcrete gr c
|
||||||
m <- lookupModule gr a
|
m <- lookupModule gr a
|
||||||
@@ -303,37 +303,37 @@ abstractModOfConcrete gr c = do
|
|||||||
|
|
||||||
--- canonFileName s = prt s ++ ".gfc"
|
--- canonFileName s = prt s ++ ".gfc"
|
||||||
|
|
||||||
lookupModule :: (Show i,Eq i) => MGrammar i f a -> i -> Err (ModInfo i f a)
|
lookupModule :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModInfo i a)
|
||||||
lookupModule gr m = case lookup m (modules gr) of
|
lookupModule gr m = case lookup m (modules gr) of
|
||||||
Just i -> return i
|
Just i -> return i
|
||||||
_ -> Bad $ "unknown module" +++ show m
|
_ -> Bad $ "unknown module" +++ show m
|
||||||
+++ "among" +++ unwords (map (show . fst) (modules gr)) ---- debug
|
+++ "among" +++ unwords (map (show . fst) (modules gr)) ---- debug
|
||||||
|
|
||||||
lookupModuleType :: (Show i,Eq i) => MGrammar i f a -> i -> Err (ModuleType i)
|
lookupModuleType :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModuleType i)
|
||||||
lookupModuleType gr m = do
|
lookupModuleType gr m = do
|
||||||
mi <- lookupModule gr m
|
mi <- lookupModule gr m
|
||||||
return $ typeOfModule mi
|
return $ typeOfModule mi
|
||||||
|
|
||||||
lookupModMod :: (Show i,Eq i) => MGrammar i f a -> i -> Err (Module i f a)
|
lookupModMod :: (Show i,Eq i) => MGrammar i a -> i -> Err (Module i a)
|
||||||
lookupModMod gr i = do
|
lookupModMod gr i = do
|
||||||
mo <- lookupModule gr i
|
mo <- lookupModule gr i
|
||||||
case mo of
|
case mo of
|
||||||
ModMod m -> return m
|
ModMod m -> return m
|
||||||
_ -> Bad $ "expected proper module, not" +++ show i
|
_ -> Bad $ "expected proper module, not" +++ show i
|
||||||
|
|
||||||
lookupInfo :: (Show i, Ord i) => Module i f a -> i -> Err a
|
lookupInfo :: (Show i, Ord i) => Module i a -> i -> Err a
|
||||||
lookupInfo mo i = lookupTree show i (jments mo)
|
lookupInfo mo i = lookupTree show i (jments mo)
|
||||||
|
|
||||||
allModMod :: (Show i,Eq i) => MGrammar i f a -> [(i,Module i f a)]
|
allModMod :: (Show i,Eq i) => MGrammar i a -> [(i,Module i a)]
|
||||||
allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
|
allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
|
||||||
|
|
||||||
isModAbs :: Module i f a -> Bool
|
isModAbs :: Module i a -> Bool
|
||||||
isModAbs m = case mtype m of
|
isModAbs m = case mtype m of
|
||||||
MTAbstract -> True
|
MTAbstract -> True
|
||||||
---- MTUnion t -> isModAbs t
|
---- MTUnion t -> isModAbs t
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
isModRes :: Module i f a -> Bool
|
isModRes :: Module i a -> Bool
|
||||||
isModRes m = case mtype m of
|
isModRes m = case mtype m of
|
||||||
MTResource -> True
|
MTResource -> True
|
||||||
MTReuse _ -> True
|
MTReuse _ -> True
|
||||||
@@ -342,13 +342,13 @@ isModRes m = case mtype m of
|
|||||||
MTInstance _ -> True
|
MTInstance _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
isModCnc :: Module i f a -> Bool
|
isModCnc :: Module i a -> Bool
|
||||||
isModCnc m = case mtype m of
|
isModCnc m = case mtype m of
|
||||||
MTConcrete _ -> True
|
MTConcrete _ -> True
|
||||||
---- MTUnion t -> isModCnc t
|
---- MTUnion t -> isModCnc t
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
isModTrans :: Module i f a -> Bool
|
isModTrans :: Module i a -> Bool
|
||||||
isModTrans m = case mtype m of
|
isModTrans m = case mtype m of
|
||||||
MTTransfer _ _ -> True
|
MTTransfer _ _ -> True
|
||||||
---- MTUnion t -> isModTrans t
|
---- MTUnion t -> isModTrans t
|
||||||
@@ -372,7 +372,7 @@ sameMType m n = case (n,m) of
|
|||||||
_ -> m == n
|
_ -> m == n
|
||||||
|
|
||||||
-- | don't generate code for interfaces and for incomplete modules
|
-- | don't generate code for interfaces and for incomplete modules
|
||||||
isCompilableModule :: ModInfo i f a -> Bool
|
isCompilableModule :: ModInfo i a -> Bool
|
||||||
isCompilableModule m = case m of
|
isCompilableModule m = case m of
|
||||||
ModMod m -> case mtype m of
|
ModMod m -> case mtype m of
|
||||||
MTInterface -> False
|
MTInterface -> False
|
||||||
@@ -380,37 +380,37 @@ isCompilableModule m = case m of
|
|||||||
_ -> False ---
|
_ -> False ---
|
||||||
|
|
||||||
-- | interface and "incomplete M" are not complete
|
-- | interface and "incomplete M" are not complete
|
||||||
isCompleteModule :: (Eq i) => Module i f a -> Bool
|
isCompleteModule :: (Eq i) => Module i a -> Bool
|
||||||
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
|
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
|
||||||
|
|
||||||
|
|
||||||
-- | all abstract modules sorted from least to most dependent
|
-- | all abstract modules sorted from least to most dependent
|
||||||
allAbstracts :: Eq i => MGrammar i f a -> [i]
|
allAbstracts :: Eq i => MGrammar i a -> [i]
|
||||||
allAbstracts gr = topoSort
|
allAbstracts gr = topoSort
|
||||||
[(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
|
[(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
|
||||||
|
|
||||||
-- | the last abstract in dependency order (head of list)
|
-- | the last abstract in dependency order (head of list)
|
||||||
greatestAbstract :: Eq i => MGrammar i f a -> Maybe i
|
greatestAbstract :: Eq i => MGrammar i a -> Maybe i
|
||||||
greatestAbstract gr = case allAbstracts gr of
|
greatestAbstract gr = case allAbstracts gr of
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
as -> return $ last as
|
as -> return $ last as
|
||||||
|
|
||||||
-- | all resource modules
|
-- | all resource modules
|
||||||
allResources :: MGrammar i f a -> [i]
|
allResources :: MGrammar i a -> [i]
|
||||||
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
|
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
|
||||||
|
|
||||||
-- | the greatest resource in dependency order
|
-- | the greatest resource in dependency order
|
||||||
greatestResource :: MGrammar i f a -> Maybe i
|
greatestResource :: MGrammar i a -> Maybe i
|
||||||
greatestResource gr = case allResources gr of
|
greatestResource gr = case allResources gr of
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
a -> return $ head a
|
a -> return $ head a
|
||||||
|
|
||||||
-- | all concretes for a given abstract
|
-- | all concretes for a given abstract
|
||||||
allConcretes :: Eq i => MGrammar i f a -> i -> [i]
|
allConcretes :: Eq i => MGrammar i a -> i -> [i]
|
||||||
allConcretes gr a =
|
allConcretes gr a =
|
||||||
[i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
|
[i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
|
||||||
|
|
||||||
-- | all concrete modules for any abstract
|
-- | all concrete modules for any abstract
|
||||||
allConcreteModules :: Eq i => MGrammar i f a -> [i]
|
allConcreteModules :: Eq i => MGrammar i a -> [i]
|
||||||
allConcreteModules gr =
|
allConcreteModules gr =
|
||||||
[i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
|
[i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
|
||||||
|
|||||||
Reference in New Issue
Block a user