summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GF/Compile.hs2
-rw-r--r--src/compiler/GF/Compile/Rename.hs2
-rw-r--r--src/compiler/GF/Grammar/Grammar.hs2
-rw-r--r--src/compiler/GF/Infra/Modules.hs37
4 files changed, 20 insertions, 23 deletions
diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index b0c228e53..4ab4a986a 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -227,7 +227,7 @@ extendCompileEnvInt (_,gr,menv) k mfile sm = do
t <- ioeIO $ getModificationTime file
return $ Map.insert mod (t,imps) menv
_ -> return menv
- return (k,mGrammar (sm:modules gr),menv2) --- reverse later
+ return (k,prependModule gr sm,menv2) --- reverse later
extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k (Just file) sm
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index f1c7e2022..2a7f020a9 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -128,7 +128,7 @@ tree2status o = case o of
buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Check Status
buildStatus gr c mo = let mo' = self2status c mo in do
- let gr1 = mGrammar ((c,mo) : modules gr)
+ let gr1 = prependModule gr (c,mo)
ops = [OSimple e | e <- allExtends gr1 c] ++ opens mo
mods <- checkErr $ mapM (lookupModule gr1 . openedModule) ops
let sts = map modInfo2status $ zip ops mods
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index e29bc331a..0234bdcb8 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -56,7 +56,7 @@ import qualified Data.ByteString.Char8 as BS
-- | grammar as presented to the compiler
type SourceGrammar = MGrammar Info
-emptySourceGrammar = mGrammar []
+emptySourceGrammar = emptyMGrammar
type SourceModInfo = ModInfo Info
diff --git a/src/compiler/GF/Infra/Modules.hs b/src/compiler/GF/Infra/Modules.hs
index 05d18a33e..a80c0060a 100644
--- a/src/compiler/GF/Infra/Modules.hs
+++ b/src/compiler/GF/Infra/Modules.hs
@@ -20,16 +20,16 @@
module GF.Infra.Modules (
MGrammar, ModInfo(..), ModuleType(..),
MInclude (..),
- mGrammar,modules,
+ mGrammar,modules,prependModule,
extends, isInherited,inheritAll,
- updateMGrammar, updateModule, replaceJudgements, addFlag,
+ updateModule, replaceJudgements, addFlag,
addOpenQualif, flagsModule, allFlags,
OpenSpec(..),
ModuleStatus(..),
openedModule, depPathModule, allDepsModule, partOfGrammar,
allExtends, allExtendSpecs, allExtendsPlus, allExtensions,
searchPathModule,
- -- addModule, mapModules,
+ -- addModule, mapModules, updateMGrammar,
emptyMGrammar, emptyModInfo,
abstractOfConcrete, abstractModOfConcrete,
lookupModule, lookupModuleType, lookupInfo,
@@ -56,8 +56,8 @@ import Text.PrettyPrint
--mGrammar = MGrammar
--newtype MGrammar a = MGrammar {modules :: [(Ident,ModInfo a)]}
-data MGrammar a = MGrammar {moduleMap :: Map.Map Ident (ModInfo a),
- modules :: [(Ident,ModInfo a)] }
+data MGrammar a = MGrammar { moduleMap :: Map.Map Ident (ModInfo a),
+ modules :: [(Ident,ModInfo a)] }
deriving Show
mGrammar ms = MGrammar (Map.fromList ms) ms
@@ -99,15 +99,15 @@ inheritAll :: Ident -> (Ident,MInclude)
inheritAll i = (i,MIAll)
-- destructive update
-
--- | dep order preserved since old cannot depend on new (not anymore TH 2011-08-30)
+{-
+-- | dep order preserved since old cannot depend on new
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
-
+updateMGrammar (MGrammar omap os) (MGrammar nmap ns) =
+ MGrammar (Map.union nmap omap) -- Map.union is left-biased
+ ([im | im@(i,m) <- os, i `notElem` nis] ++ ns)
+ where
+ nis = map fst ns
+-}
updateModule :: ModInfo t -> Ident -> t -> ModInfo t
updateModule (ModInfo mt ms fs me mw ops med js) i t = ModInfo mt ms fs me mw ops med (updateTree (i,t) js)
@@ -221,6 +221,8 @@ addModule :: MGrammar a -> Ident -> ModInfo a -> MGrammar a
addModule gr name mi = MGrammar $ Map.insert name mi (moduleMap gr)
-}
+prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)
+
emptyMGrammar :: MGrammar a
emptyMGrammar = mGrammar []
@@ -237,10 +239,7 @@ abstractOfConcrete gr c = do
_ -> Bad $ render (text "expected concrete" <+> ppIdent c)
abstractModOfConcrete :: MGrammar a -> Ident -> Err (ModInfo a)
-abstractModOfConcrete gr c = do
- a <- abstractOfConcrete gr c
- lookupModule gr a
-
+abstractModOfConcrete gr c = lookupModule gr =<< abstractOfConcrete gr c
-- the canonical file name
@@ -253,9 +252,7 @@ lookupModule gr m = case Map.lookup m (moduleMap gr) of
Nothing -> Bad $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
lookupModuleType :: MGrammar a -> Ident -> Err ModuleType
-lookupModuleType gr m = do
- mi <- lookupModule gr m
- return $ mtype mi
+lookupModuleType gr m = mtype `fmap` lookupModule gr m
lookupInfo :: ModInfo a -> Ident -> Err a
lookupInfo mo i = lookupTree showIdent i (jments mo)