GF.Infra.Modules: minor tweaks

Still keeping the modules both in a list and in a finite map. The overhead is
smaller than I initially thought.

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
 

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    

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
 

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)