From d180dadf08ddd961cf2a5db68f90223a7d76c232 Mon Sep 17 00:00:00 2001 From: hallgren Date: Wed, 31 Aug 2011 11:18:16 +0000 Subject: [PATCH] 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 | 2 +- src/compiler/GF/Compile/Rename.hs | 2 +- src/compiler/GF/Grammar/Grammar.hs | 2 +- src/compiler/GF/Infra/Modules.hs | 37 ++++++++++++++---------------- 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)