msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

refactor GF.Infra.Modules for better error messages

Browse Source
This commit is contained in:
krasimir
2010-01-31 15:54:25 +00:00
parent acd927f87b
commit be6465a2eb
10 changed files with 159 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -570,7 +570,7 @@ prTrace tr n = trace (render (text "-- OBSERVE" <+> A.ppTerm Unqualified 0 tr <
-- | this function finds out what modules are really needed in the canonical gr.
-- its argument is typically a concrete module name
requiredCanModules :: (Ord i, Show i) => Bool -> M.MGrammar i a -> i -> [i]
requiredCanModules :: Bool -> M.MGrammar a -> Ident -> [Ident]
requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
exts = M.allExtends gr c
ops = if isSingle

6
src/compiler/GF/Compile/Rename.hs
View File

@@ -57,7 +57,7 @@ renameModule ms (name,mo) = checkIn (text "renaming module" <+> ppIdent name) $
js2 <- checkMap (renameInfo mo status) js1
return (name, mo {opens = map forceQualif (opens mo), jments = js2})
type Status = (StatusTree, [(OpenSpec Ident, StatusTree)])
type Status = (StatusTree, [(OpenSpec, StatusTree)])
type StatusTree = BinTree Ident StatusInfo
@@ -112,7 +112,7 @@ info2status mq (c,i) = case i of
AnyInd False m -> maybe Cn (const (Q m)) mq
_ -> maybe Cn Q mq
tree2status :: OpenSpec Ident -> BinTree Ident Info -> BinTree Ident StatusInfo
tree2status :: OpenSpec -> BinTree Ident Info -> BinTree Ident StatusInfo
tree2status o = case o of
OSimple i -> mapTree (info2status (Just i))
OQualif i j -> mapTree (info2status (Just j))
@@ -127,7 +127,7 @@ buildStatus gr c mo = let mo' = self2status c mo in do
then (emptyBinTree, reverse sts) -- the module itself does not define any names
else (mo',reverse sts) -- so the empty ident is not needed
modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree)
modInfo2status :: (OpenSpec,SourceModInfo) -> (OpenSpec, StatusTree)
modInfo2status (o,mo) = (o,tree2status o (jments mo))
self2status :: Ident -> SourceModInfo -> StatusTree

10
src/compiler/GF/Grammar/Binary.hs
View File

@@ -26,16 +26,16 @@ instance Binary Ident where
then return identW
else return (identC bs)
instance (Ord i, Binary i, Binary a) => Binary (MGrammar i a) where
instance Binary a => Binary (MGrammar a) where
put (MGrammar ms) = put ms
get = fmap MGrammar get
instance (Ord i, Binary i, Binary a) => Binary (ModInfo i a) where
instance Binary a => Binary (ModInfo a) where
put mi = do put (mtype mi,mstatus mi,flags mi,extend mi,mwith mi,opens mi,mexdeps mi,jments mi,positions mi)
get = do (mtype,mstatus,flags,extend,mwith,opens,med,jments,positions) <- get
return (ModInfo mtype mstatus flags extend mwith opens med jments positions)
instance (Binary i) => Binary (ModuleType i) where
instance Binary ModuleType where
put MTAbstract = putWord8 0
put MTResource = putWord8 2
put (MTConcrete i) = putWord8 3 >> put i
@@ -50,7 +50,7 @@ instance (Binary i) => Binary (ModuleType i) where
5 -> get >>= return . MTInstance
_ -> decodingError
instance (Binary i) => Binary (MInclude i) where
instance Binary MInclude where
put MIAll = putWord8 0
put (MIOnly xs) = putWord8 1 >> put xs
put (MIExcept xs) = putWord8 2 >> put xs
@@ -61,7 +61,7 @@ instance (Binary i) => Binary (MInclude i) where
2 -> fmap MIExcept get
_ -> decodingError
instance Binary i => Binary (OpenSpec i) where
instance Binary OpenSpec where
put (OSimple i) = putWord8 0 >> put i
put (OQualif i j) = putWord8 1 >> put (i,j)
get = do tag <- getWord8

4
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -53,11 +53,11 @@ import GF.Data.Operations
import qualified Data.ByteString.Char8 as BS
-- | grammar as presented to the compiler
type SourceGrammar = MGrammar Ident Info
type SourceGrammar = MGrammar Info
emptySourceGrammar = MGrammar []
type SourceModInfo = ModInfo Ident Info
type SourceModInfo = ModInfo Info
type SourceModule = (Ident, SourceModInfo)

2
src/compiler/GF/Grammar/Lookup.hs
View File

@@ -55,7 +55,7 @@ lookupIdent c t =
Ok v -> return v
Bad _ -> Bad ("unknown identifier" +++ showIdent c)
lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a
lookupIdentInfo :: ModInfo a -> Ident -> Err a
lookupIdentInfo mo i = lookupIdent i (jments mo)
lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term

26
src/compiler/GF/Grammar/Parser.y
View File

@@ -135,7 +135,7 @@ ComplMod
: {- empty -} { MSComplete }
| 'incomplete' { MSIncomplete }
ModType :: { (ModuleType Ident,Ident) }
ModType :: { (ModuleType,Ident) }
ModType
: 'abstract' Ident { (MTAbstract, $2) }
| 'resource' Ident { (MTResource, $2) }
@@ -143,9 +143,9 @@ ModType
| 'concrete' Ident 'of' Ident { (MTConcrete $4, $2) }
| 'instance' Ident 'of' Ident { (MTInstance $4, $2) }
ModHeaderBody :: { ( [(Ident,MInclude Ident)]
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
, [OpenSpec Ident]
ModHeaderBody :: { ( [(Ident,MInclude)]
, Maybe (Ident,MInclude,[(Ident,Ident)])
, [OpenSpec]
) }
ModHeaderBody
: ListIncluded '**' Included 'with' ListInst '**' ModOpen { ($1, Just (fst $3,snd $3,$5), $7) }
@@ -156,14 +156,14 @@ ModHeaderBody
| Included 'with' ListInst { ([], Just (fst $1,snd $1,$3), []) }
| ModOpen { ([], Nothing, $1) }
ModOpen :: { [OpenSpec Ident] }
ModOpen :: { [OpenSpec] }
ModOpen
: { [] }
| 'open' ListOpen { $2 }
ModBody :: { ( [(Ident,MInclude Ident)]
, Maybe (Ident,MInclude Ident,[(Ident,Ident)])
, Maybe ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options)
ModBody :: { ( [(Ident,MInclude)]
, Maybe (Ident,MInclude,[(Ident,Ident)])
, Maybe ([OpenSpec],[(Ident,SrcSpan,Info)],Options)
) }
ModBody
: ListIncluded '**' Included 'with' ListInst '**' ModContent { ($1, Just (fst $3,snd $3,$5), Just $7) }
@@ -175,7 +175,7 @@ ModBody
| ModContent { ([], Nothing, Just $1) }
| ModBody ';' { $1 }
ModContent :: { ([OpenSpec Ident],[(Ident,SrcSpan,Info)],Options) }
ModContent :: { ([OpenSpec],[(Ident,SrcSpan,Info)],Options) }
ModContent
: '{' ListTopDef '}' { ([],[d | Left ds <- $2, d <- ds],concatOptions [o | Right o <- $2]) }
| 'open' ListOpen 'in' '{' ListTopDef '}' { ($2,[d | Left ds <- $5, d <- ds],concatOptions [o | Right o <- $5]) }
@@ -185,12 +185,12 @@ ListTopDef
: {- empty -} { [] }
| TopDef ListTopDef { $1 : $2 }
ListOpen :: { [OpenSpec Ident] }
ListOpen :: { [OpenSpec] }
ListOpen
: Open { [$1] }
| Open ',' ListOpen { $1 : $3 }
Open :: { OpenSpec Ident }
Open :: { OpenSpec }
Open
: Ident { OSimple $1 }
| '(' Ident '=' Ident ')' { OQualif $2 $4 }
@@ -204,12 +204,12 @@ Inst :: { (Ident,Ident) }
Inst
: '(' Ident '=' Ident ')' { ($2,$4) }
ListIncluded :: { [(Ident,MInclude Ident)] }
ListIncluded :: { [(Ident,MInclude)] }
ListIncluded
: Included { [$1] }
| Included ',' ListIncluded { $1 : $3 }
Included :: { (Ident,MInclude Ident) }
Included :: { (Ident,MInclude) }
Included
: Ident { ($1,MIAll ) }
| Ident '[' ListIdent ']' { ($1,MIOnly $3) }

3
src/compiler/GF/Grammar/Printer.hs
View File

@@ -9,7 +9,6 @@
module GF.Grammar.Printer
( TermPrintQual(..)
, ppIdent
, ppLabel
, ppModule
, ppJudgement
@@ -256,8 +255,6 @@ ppDDecl q (_,id,typ)
| id == identW = ppTerm q 6 typ
| otherwise = parens (ppIdent id <+> colon <+> ppTerm q 0 typ)
ppIdent = text . showIdent
ppQIdent q m id =
case q of
Qualified -> ppIdent m <> char '.' <> ppIdent id

2
src/compiler/GF/Infra/Dependencies.hs
View File

@@ -35,7 +35,7 @@ prDepGraph deps = unlines $ [
"ed" -> "style = \"dotted\""
data ModDeps = ModDeps {
modtype :: ModuleType Ident,
modtype :: ModuleType,
ofs :: [Ident],
extendeds :: [Ident],
openeds :: [Ident],

7
src/compiler/GF/Infra/Ident.hs
View File

@@ -13,7 +13,7 @@
-----------------------------------------------------------------------------
module GF.Infra.Ident (-- * Identifiers
Ident(..), ident2bs, showIdent,
Ident(..), ident2bs, showIdent, ppIdent,
identC, identV, identA, identAV, identW,
argIdent, varStr, varX, isWildIdent, varIndex,
-- * refreshing identifiers
@@ -23,7 +23,7 @@ module GF.Infra.Ident (-- * Identifiers
import GF.Data.Operations
import qualified Data.ByteString.Char8 as BS
-- import Monad
import Text.PrettyPrint
-- | the constructors labelled /INTERNAL/ are
@@ -51,6 +51,9 @@ ident2bs i = case i of
showIdent :: Ident -> String
showIdent i = BS.unpack $! ident2bs i
ppIdent :: Ident -> Doc
ppIdent = text . showIdent
identC :: BS.ByteString -> Ident
identV :: BS.ByteString -> Int -> Ident
identA :: BS.ByteString -> Int -> Ident

259
src/compiler/GF/Infra/Modules.hs
View File

@@ -19,32 +19,32 @@
-----------------------------------------------------------------------------
module GF.Infra.Modules (
MGrammar(..), ModInfo(..), ModuleType(..),
MInclude (..),
extends, isInherited,inheritAll,
updateMGrammar, updateModule, replaceJudgements, addFlag,
addOpenQualif, flagsModule, allFlags, mapModules,
OpenSpec(..),
ModuleStatus(..),
openedModule, depPathModule, allDepsModule, partOfGrammar,
allExtends, allExtendSpecs, allExtendsPlus, allExtensions,
searchPathModule, addModule,
emptyMGrammar, emptyModInfo,
IdentM(..),
abstractOfConcrete, abstractModOfConcrete,
lookupModule, lookupModuleType, lookupInfo,
lookupPosition, ppPosition,
isModAbs, isModRes, isModCnc,
sameMType, isCompilableModule, isCompleteModule,
allAbstracts, greatestAbstract, allResources,
greatestResource, allConcretes, allConcreteModules
) where
MGrammar(..), ModInfo(..), ModuleType(..),
MInclude (..),
extends, isInherited,inheritAll,
updateMGrammar, updateModule, replaceJudgements, addFlag,
addOpenQualif, flagsModule, allFlags, mapModules,
OpenSpec(..),
ModuleStatus(..),
openedModule, depPathModule, allDepsModule, partOfGrammar,
allExtends, allExtendSpecs, allExtendsPlus, allExtensions,
searchPathModule, addModule,
emptyMGrammar, emptyModInfo,
abstractOfConcrete, abstractModOfConcrete,
lookupModule, lookupModuleType, lookupInfo,
lookupPosition, ppPosition,
isModAbs, isModRes, isModCnc,
sameMType, isCompilableModule, isCompleteModule,
allAbstracts, greatestAbstract, allResources,
greatestResource, allConcretes, allConcreteModules
) where
import GF.Infra.Ident
import GF.Infra.Option
import GF.Data.Operations
import Data.List
import qualified Data.Map as Map
import Text.PrettyPrint
-- AR 29/4/2003
@@ -53,95 +53,95 @@ import Text.PrettyPrint
-- The parameters tell what kind of data is involved.
-- Invariant: modules are stored in dependency order
newtype MGrammar i a = MGrammar {modules :: [(i,ModInfo i a)]}
newtype MGrammar a = MGrammar {modules :: [(Ident,ModInfo a)]}
deriving Show
data ModInfo i a = ModInfo {
mtype :: ModuleType i ,
mstatus :: ModuleStatus ,
data ModInfo a = ModInfo {
mtype :: ModuleType,
mstatus :: ModuleStatus,
flags :: Options,
extend :: [(i,MInclude i)],
mwith :: Maybe (i,MInclude i,[(i,i)]),
opens :: [OpenSpec i] ,
mexdeps :: [i] ,
jments :: BinTree i a ,
positions :: BinTree i (String,(Int,Int)) -- file, first line, last line
extend :: [(Ident,MInclude)],
mwith :: Maybe (Ident,MInclude,[(Ident,Ident)]),
opens :: [OpenSpec],
mexdeps :: [Ident],
jments :: Map.Map Ident a,
positions :: Map.Map Ident (String,(Int,Int)) -- file, first line, last line
}
deriving Show
-- | encoding the type of the module
data ModuleType i =
data ModuleType =
MTAbstract
| MTResource
| MTConcrete i
-- ^ up to this, also used in GFC. Below, source only.
| MTConcrete Ident
-- ^ up to this, also used in GFO. Below, source only.
| MTInterface
| MTInstance i
deriving (Eq,Ord,Show)
| MTInstance Ident
deriving (Eq,Show)
data MInclude i = MIAll | MIOnly [i] | MIExcept [i]
deriving (Eq,Ord,Show)
data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
deriving (Eq,Show)
extends :: ModInfo i a -> [i]
extends :: ModInfo a -> [Ident]
extends = map fst . extend
isInherited :: Eq i => MInclude i -> i -> Bool
isInherited :: MInclude -> Ident -> Bool
isInherited c i = case c of
MIAll -> True
MIOnly is -> elem i is
MIExcept is -> notElem i is
inheritAll :: i -> (i,MInclude i)
inheritAll :: Ident -> (Ident,MInclude)
inheritAll i = (i,MIAll)
-- destructive update
-- | dep order preserved since old cannot depend on new
updateMGrammar :: Ord i => MGrammar i a -> MGrammar i a -> MGrammar i a
updateMGrammar old new = MGrammar $
updateMGrammar :: MGrammar a -> MGrammar a -> MGrammar a
updateMGrammar old new = MGrammar $
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
where
os = modules old
ns = modules new
updateModule :: Ord i => ModInfo i t -> i -> t -> ModInfo i t
updateModule :: ModInfo t -> Ident -> t -> ModInfo t
updateModule (ModInfo mt ms fs me mw ops med js ps) i t = ModInfo mt ms fs me mw ops med (updateTree (i,t) js) ps
replaceJudgements :: ModInfo i t -> BinTree i t -> ModInfo i t
replaceJudgements :: ModInfo t -> Map.Map Ident t -> ModInfo t
replaceJudgements (ModInfo mt ms fs me mw ops med _ ps) js = ModInfo mt ms fs me mw ops med js ps
addOpenQualif :: i -> i -> ModInfo i t -> ModInfo i t
addOpenQualif :: Ident -> Ident -> ModInfo t -> ModInfo t
addOpenQualif i j (ModInfo mt ms fs me mw ops med js ps) = ModInfo mt ms fs me mw (OQualif i j : ops) med js ps
addFlag :: Options -> ModInfo i t -> ModInfo i t
addFlag :: Options -> ModInfo t -> ModInfo t
addFlag f mo = mo {flags = flags mo `addOptions` f}
flagsModule :: (i,ModInfo i a) -> Options
flagsModule :: (Ident,ModInfo a) -> Options
flagsModule (_,mi) = flags mi
allFlags :: MGrammar i a -> Options
allFlags :: MGrammar a -> Options
allFlags gr = concatOptions [flags m | (_,m) <- modules gr]
mapModules :: (ModInfo i a -> ModInfo i a) -> MGrammar i a -> MGrammar i a
mapModules :: (ModInfo a -> ModInfo a) -> MGrammar a -> MGrammar a
mapModules f (MGrammar ms) = MGrammar (map (onSnd f) ms)
data OpenSpec i =
OSimple i
| OQualif i i
deriving (Eq,Ord,Show)
data OpenSpec =
OSimple Ident
| OQualif Ident Ident
deriving (Eq,Show)
data ModuleStatus =
MSComplete
| MSIncomplete
deriving (Eq,Ord,Show)
openedModule :: OpenSpec i -> i
openedModule :: OpenSpec -> Ident
openedModule o = case o of
OSimple m -> m
OQualif _ m -> m
-- | initial dependency list
depPathModule :: Ord i => ModInfo i a -> [OpenSpec i]
depPathModule :: ModInfo a -> [OpenSpec]
depPathModule m = fors m ++ exts m ++ opens m
where
fors m =
@@ -152,7 +152,7 @@ depPathModule m = fors m ++ exts m ++ opens m
exts m = map OSimple (extends m)
-- | all dependencies
allDepsModule :: Ord i => MGrammar i a -> ModInfo i a -> [OpenSpec i]
allDepsModule :: MGrammar a -> ModInfo a -> [OpenSpec]
allDepsModule gr m = iterFix add os0 where
os0 = depPathModule m
add os = [m | o <- os, Just n <- [lookup (openedModule o) mods],
@@ -160,14 +160,14 @@ allDepsModule gr m = iterFix add os0 where
mods = modules gr
-- | select just those modules that a given one depends on, including itself
partOfGrammar :: Ord i => MGrammar i a -> (i,ModInfo i a) -> MGrammar i a
partOfGrammar :: MGrammar a -> (Ident,ModInfo a) -> MGrammar a
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
where
mods = modules gr
modsFor = (i:) $ map openedModule $ allDepsModule gr m
-- | all modules that a module extends, directly or indirectly, without restricts
allExtends :: (Show i,Ord i) => MGrammar i a -> i -> [i]
allExtends :: MGrammar a -> Ident -> [Ident]
allExtends gr i =
case lookupModule gr i of
Ok m -> case extends m of
@@ -176,7 +176,7 @@ allExtends gr i =
_ -> []
-- | all modules that a module extends, directly or indirectly, with restricts
allExtendSpecs :: (Show i,Ord i) => MGrammar i a -> i -> [(i,MInclude i)]
allExtendSpecs :: MGrammar a -> Ident -> [(Ident,MInclude)]
allExtendSpecs gr i =
case lookupModule gr i of
Ok m -> case extend m of
@@ -185,7 +185,7 @@ allExtendSpecs gr i =
_ -> []
-- | this plus that an instance extends its interface
allExtendsPlus :: (Show i,Ord i) => MGrammar i a -> i -> [i]
allExtendsPlus :: MGrammar a -> Ident -> [Ident]
allExtendsPlus gr i =
case lookupModule gr i of
Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
@@ -194,7 +194,7 @@ allExtendsPlus gr i =
exts m = extends m ++ [j | MTInstance j <- [mtype m]]
-- | conversely: all modules that extend a given module, incl. instances of interface
allExtensions :: (Show i,Ord i) => MGrammar i a -> i -> [i]
allExtensions :: MGrammar a -> Ident -> [Ident]
allExtensions gr i =
case lookupModule gr i of
Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
@@ -205,36 +205,29 @@ allExtensions gr i =
mods = modules gr
-- | initial search path: the nonqualified dependencies
searchPathModule :: Ord i => ModInfo i a -> [i]
searchPathModule :: ModInfo a -> [Ident]
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 =>
MGrammar i a -> i -> ModInfo i a -> MGrammar i a
addModule :: MGrammar a -> Ident -> ModInfo a -> MGrammar a
addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
emptyMGrammar :: MGrammar i a
emptyMGrammar :: MGrammar a
emptyMGrammar = MGrammar []
emptyModInfo :: ModInfo i a
emptyModInfo :: ModInfo a
emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] emptyBinTree emptyBinTree
-- | we store the module type with the identifier
data IdentM i = IdentM {
identM :: i ,
typeM :: ModuleType i
}
deriving (Eq,Ord,Show)
abstractOfConcrete :: (Show i, Eq i) => MGrammar i a -> i -> Err i
abstractOfConcrete :: MGrammar a -> Ident -> Err Ident
abstractOfConcrete gr c = do
n <- lookupModule gr c
case mtype n of
MTConcrete a -> return a
_ -> Bad $ "expected concrete" +++ show c
_ -> Bad $ render (text "expected concrete" <+> ppIdent c)
abstractModOfConcrete :: (Show i, Eq i) =>
MGrammar i a -> i -> Err (ModInfo i a)
abstractModOfConcrete :: MGrammar a -> Ident -> Err (ModInfo a)
abstractModOfConcrete gr c = do
a <- abstractOfConcrete gr c
lookupModule gr a
@@ -244,106 +237,110 @@ abstractModOfConcrete gr c = do
--- canonFileName s = prt s ++ ".gfc"
lookupModule :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModInfo i a)
lookupModule :: MGrammar a -> Ident -> Err (ModInfo a)
lookupModule gr m = case lookup m (modules gr) of
Just i -> return i
_ -> Bad $ "unknown module" +++ show m
+++ "among" +++ unwords (map (show . fst) (modules gr)) ---- debug
Just i -> return i
Nothing -> Bad $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
lookupModuleType :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModuleType i)
lookupModuleType :: MGrammar a -> Ident -> Err ModuleType
lookupModuleType gr m = do
mi <- lookupModule gr m
return $ mtype mi
lookupInfo :: (Show i, Ord i) => ModInfo i a -> i -> Err a
lookupInfo mo i = lookupTree show i (jments mo)
lookupInfo :: ModInfo a -> Ident -> Err a
lookupInfo mo i = lookupTree showIdent i (jments mo)
lookupPosition :: (Show i, Ord i) => ModInfo i a -> i -> Err (String,(Int,Int))
lookupPosition mo i = lookupTree show i (positions mo)
lookupPosition :: ModInfo a -> Ident -> Err (String,(Int,Int))
lookupPosition mo i = lookupTree showIdent i (positions mo)
ppPosition :: (Show i, Ord i) => ModInfo i a -> i -> Doc
ppPosition :: ModInfo a -> Ident -> Doc
ppPosition mo i = case lookupPosition mo i of
Ok (f,(b,e)) | b == e -> text "in" <+> text f <> text ", line" <+> int b
| otherwise -> text "in" <+> text f <> text ", lines" <+> int b <> text "-" <> int e
_ -> empty
isModAbs :: ModInfo i a -> Bool
isModAbs m = case mtype m of
MTAbstract -> True
---- MTUnion t -> isModAbs t
_ -> False
isModAbs :: ModInfo a -> Bool
isModAbs m =
case mtype m of
MTAbstract -> True
_ -> False
isModRes :: ModInfo i a -> Bool
isModRes m = case mtype m of
MTResource -> True
MTInterface -> True ---
MTInstance _ -> True
_ -> False
isModRes :: ModInfo a -> Bool
isModRes m =
case mtype m of
MTResource -> True
MTInterface -> True ---
MTInstance _ -> True
_ -> False
isModCnc :: ModInfo i a -> Bool
isModCnc m = case mtype m of
MTConcrete _ -> True
_ -> False
isModCnc :: ModInfo a -> Bool
isModCnc m =
case mtype m of
MTConcrete _ -> True
_ -> False
sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool
sameMType m n = case (n,m) of
(MTConcrete _, MTConcrete _) -> True
sameMType :: ModuleType -> ModuleType -> Bool
sameMType m n =
case (n,m) of
(MTConcrete _, MTConcrete _) -> True
(MTInstance _, MTInstance _) -> True
(MTInstance _, MTResource) -> True
(MTInstance _, MTConcrete _) -> True
(MTInstance _, MTInstance _) -> True
(MTInstance _, MTResource) -> True
(MTInstance _, MTConcrete _) -> True
(MTInterface, MTInstance _) -> True
(MTInterface, MTResource) -> True -- for reuse
(MTInterface, MTAbstract) -> True -- for reuse
(MTInterface, MTConcrete _) -> True -- for reuse
(MTInterface, MTInstance _) -> True
(MTInterface, MTResource) -> True -- for reuse
(MTInterface, MTAbstract) -> True -- for reuse
(MTInterface, MTConcrete _) -> True -- for reuse
(MTResource, MTInstance _) -> True
(MTResource, MTConcrete _) -> True -- for reuse
(MTResource, MTInstance _) -> True
(MTResource, MTConcrete _) -> True -- for reuse
_ -> m == n
_ -> m == n
-- | don't generate code for interfaces and for incomplete modules
isCompilableModule :: ModInfo i a -> Bool
isCompilableModule :: ModInfo a -> Bool
isCompilableModule m =
case mtype m of
MTInterface -> False
_ -> mstatus m == MSComplete
-- | interface and "incomplete M" are not complete
isCompleteModule :: (Eq i) => ModInfo i a -> Bool
isCompleteModule :: ModInfo a -> Bool
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-- | all abstract modules sorted from least to most dependent
allAbstracts :: (Ord i, Show i) => MGrammar i a -> [i]
allAbstracts :: MGrammar a -> [Ident]
allAbstracts gr =
case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
Left is -> is
Right cycles -> error $ "Cyclic abstract modules: " ++ show cycles
Left is -> is
Right cycles -> error $ render (text "Cyclic abstract modules:" <+> vcat (map (hsep . map ppIdent) cycles))
-- | the last abstract in dependency order (head of list)
greatestAbstract :: (Ord i, Show i) => MGrammar i a -> Maybe i
greatestAbstract gr = case allAbstracts gr of
[] -> Nothing
as -> return $ last as
greatestAbstract :: MGrammar a -> Maybe Ident
greatestAbstract gr =
case allAbstracts gr of
[] -> Nothing
as -> return $ last as
-- | all resource modules
allResources :: MGrammar i a -> [i]
allResources :: MGrammar a -> [Ident]
allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
-- | the greatest resource in dependency order
greatestResource :: MGrammar i a -> Maybe i
greatestResource gr = case allResources gr of
[] -> Nothing
a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
greatestResource :: MGrammar a -> Maybe Ident
greatestResource gr =
case allResources gr of
[] -> Nothing
a -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
-- | all concretes for a given abstract
allConcretes :: Eq i => MGrammar i a -> i -> [i]
allConcretes gr a =
allConcretes :: MGrammar a -> Ident -> [Ident]
allConcretes gr a =
[i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-- | all concrete modules for any abstract
allConcreteModules :: Eq i => MGrammar i a -> [i]
allConcreteModules gr =
allConcreteModules :: MGrammar a -> [Ident]
allConcreteModules gr =
[i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]