summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs2
-rw-r--r--src-3.0/GF/Compile/ModDeps.hs2
-rw-r--r--src-3.0/GF/Grammar/Grammar.hs10
-rw-r--r--src-3.0/GF/Grammar/PrGrammar.hs2
-rw-r--r--src-3.0/GF/Infra/Modules.hs100
5 files changed, 58 insertions, 58 deletions
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index 4fd843770..f061f3b34 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/src-3.0/GF/Compile/GrammarToGFCC.hs
@@ -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.
-- 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
exts = M.allExtends gr c
ops = if isSingle
diff --git a/src-3.0/GF/Compile/ModDeps.hs b/src-3.0/GF/Compile/ModDeps.hs
index 8331057d1..b5b1b798c 100644
--- a/src-3.0/GF/Compile/ModDeps.hs
+++ b/src-3.0/GF/Compile/ModDeps.hs
@@ -125,7 +125,7 @@ openInterfaces ds m = do
-- | 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 -> 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
exts = allExtends gr c
ops = if isSingle
diff --git a/src-3.0/GF/Grammar/Grammar.hs b/src-3.0/GF/Grammar/Grammar.hs
index 6431b33e9..f451d0b27 100644
--- a/src-3.0/GF/Grammar/Grammar.hs
+++ b/src-3.0/GF/Grammar/Grammar.hs
@@ -62,15 +62,15 @@ import GF.Data.Operations
import qualified Data.ByteString.Char8 as BS
-- | 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 SourceAbs = Module Ident Option Info
-type SourceRes = Module Ident Option Info
-type SourceCnc = Module Ident Option Info
+type SourceAbs = Module Ident Info
+type SourceRes = Module Ident Info
+type SourceCnc = Module Ident Info
-- this is created in CheckGrammar, and so are Val and PVal
type PValues = [Term]
diff --git a/src-3.0/GF/Grammar/PrGrammar.hs b/src-3.0/GF/Grammar/PrGrammar.hs
index 186792eda..734aa13ca 100644
--- a/src-3.0/GF/Grammar/PrGrammar.hs
+++ b/src-3.0/GF/Grammar/PrGrammar.hs
@@ -245,5 +245,5 @@ lookupIdent c t = case lookupTree prt c t of
Ok v -> return v
_ -> 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)
diff --git a/src-3.0/GF/Infra/Modules.hs b/src-3.0/GF/Infra/Modules.hs
index 4d50608c6..fe44a5fe4 100644
--- a/src-3.0/GF/Infra/Modules.hs
+++ b/src-3.0/GF/Infra/Modules.hs
@@ -53,25 +53,25 @@ import Data.List
-- The parameters tell what kind of data is involved.
-- 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
-data ModInfo i f a =
+data ModInfo i a =
ModMainGrammar (MainGrammar i)
- | ModMod (Module i f a)
- | ModWith (Module i f a) (i,MInclude i) [OpenSpec i]
+ | ModMod (Module i a)
+ | ModWith (Module i a) (i,MInclude i) [OpenSpec i]
deriving Show
-data Module i f a = Module {
+data Module i a = Module {
mtype :: ModuleType i ,
mstatus :: ModuleStatus ,
- flags :: [f] ,
+ flags :: [Option] ,
extend :: [(i,MInclude i)],
opens :: [OpenSpec i] ,
jments :: BinTree i a
}
--- deriving Show
-instance Show (Module i f a) where
+instance Show (Module i a) where
show _ = "cannot show Module with FiniteMap"
-- | 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]
deriving (Show,Eq)
-extends :: Module i f a -> [i]
+extends :: Module i a -> [i]
extends = map fst . extend
isInherited :: Eq i => MInclude i -> i -> Bool
@@ -108,37 +108,37 @@ inheritAll i = (i,MIAll)
-- destructive update
-- | 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 $
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
where
os = modules old
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 =
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
-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) =
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}
-flagsModule :: (i,ModInfo i f a) -> [f]
+flagsModule :: (i,ModInfo i a) -> [Option]
flagsModule (_,mi) = case mi of
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]
-mapModules :: (Module i f a -> Module i f a)
- -> MGrammar i f a -> MGrammar i f a
+mapModules :: (Module i a -> Module i a)
+ -> MGrammar i a -> MGrammar i a
mapModules f = MGrammar . map (onSnd mapModules') . modules
where mapModules' (ModMod m) = ModMod (f m)
mapModules' m = m
@@ -184,13 +184,13 @@ openedModule o = case o of
OSimple _ m -> m
OQualif _ _ m -> m
-allOpens :: Module i f a -> [OpenSpec i]
+allOpens :: Module i a -> [OpenSpec i]
allOpens m = case mtype m of
MTTransfer a b -> a : b : opens m
_ -> opens m
-- | 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
fors m = case mtype m of
MTTransfer i j -> [i,j]
@@ -200,7 +200,7 @@ depPathModule m = fors m ++ exts m ++ opens m where
exts m = map oSimple $ extends m
-- | 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
os0 = depPathModule m
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
-- | 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]
where
mods = modules gr
@@ -218,7 +218,7 @@ partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
_ -> [i]
-- | 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
Ok (ModMod m) -> case extends m of
[] -> [i]
@@ -226,7 +226,7 @@ allExtends gr i = case lookupModule gr i of
_ -> []
-- | 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
Ok (ModMod m) -> case extend m of
[] -> [(i,MIAll)]
@@ -234,7 +234,7 @@ allExtendSpecs gr i = case lookupModule gr i of
_ -> []
-- | 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
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]]
-- | 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
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]
-- | 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]
-- | a new module can safely be added to the end, since nothing old can depend on it
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)])
-emptyMGrammar :: MGrammar i f a
+emptyMGrammar :: MGrammar i a
emptyMGrammar = MGrammar []
-emptyModInfo :: ModInfo i f a
+emptyModInfo :: ModInfo i a
emptyModInfo = ModMod emptyModule
-emptyModule :: Module i f a
+emptyModule :: Module i a
emptyModule = Module MTResource MSComplete [] [] [] emptyBinTree
-- | we store the module type with the identifier
@@ -276,11 +276,11 @@ data IdentM i = IdentM {
}
deriving (Eq,Show)
-typeOfModule :: ModInfo i f a -> ModuleType i
+typeOfModule :: ModInfo i a -> ModuleType i
typeOfModule mi = case mi of
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
m <- lookupModule gr c
case m of
@@ -290,7 +290,7 @@ abstractOfConcrete gr c = do
_ -> Bad $ "expected concrete" +++ show c
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
a <- abstractOfConcrete gr c
m <- lookupModule gr a
@@ -303,37 +303,37 @@ abstractModOfConcrete gr c = do
--- 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
Just i -> return i
_ -> Bad $ "unknown module" +++ show m
+++ "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
mi <- lookupModule gr m
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
mo <- lookupModule gr i
case mo of
ModMod m -> return m
_ -> 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)
-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]
-isModAbs :: Module i f a -> Bool
+isModAbs :: Module i a -> Bool
isModAbs m = case mtype m of
MTAbstract -> True
---- MTUnion t -> isModAbs t
_ -> False
-isModRes :: Module i f a -> Bool
+isModRes :: Module i a -> Bool
isModRes m = case mtype m of
MTResource -> True
MTReuse _ -> True
@@ -342,13 +342,13 @@ isModRes m = case mtype m of
MTInstance _ -> True
_ -> False
-isModCnc :: Module i f a -> Bool
+isModCnc :: Module i a -> Bool
isModCnc m = case mtype m of
MTConcrete _ -> True
---- MTUnion t -> isModCnc t
_ -> False
-isModTrans :: Module i f a -> Bool
+isModTrans :: Module i a -> Bool
isModTrans m = case mtype m of
MTTransfer _ _ -> True
---- MTUnion t -> isModTrans t
@@ -372,7 +372,7 @@ sameMType m n = case (n,m) of
_ -> m == n
-- | 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
ModMod m -> case mtype m of
MTInterface -> False
@@ -380,37 +380,37 @@ isCompilableModule m = case m of
_ -> False ---
-- | 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
-- | 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
[(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
-- | 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
[] -> Nothing
as -> return $ last as
-- | all resource modules
-allResources :: MGrammar i f a -> [i]
+allResources :: MGrammar i a -> [i]
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
-- | 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
[] -> Nothing
a -> return $ head a
-- | 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 =
[i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-- | all concrete modules for any abstract
-allConcreteModules :: Eq i => MGrammar i f a -> [i]
+allConcreteModules :: Eq i => MGrammar i a -> [i]
allConcreteModules gr =
[i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
generated by cgit v1.2.3 (git 2.39.1) at 2026-06-05 21:48:56 +0000