GF.Grammar.Grammar.allExtends now returns a list of source modules instead of just the module names. This saves extra lookups later

4 files changed, 31 insertions, 61 deletions

diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index b1a2c5d33..41f6f8ff0 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -65,8 +65,7 @@ mkCanon2pgf opts gr am = do
               [(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True),_) <- adefs, snd (GM.valCat ty) == cat]
 
     mkConcr cm = do
-      let cflags  = concatOptions [mflags mo | (i,mo) <- modules gr, isModCnc mo, 
-                                                  Just r <- [lookup i (allExtendSpecs gr cm)]]
+      let cflags  = concatOptions [mflags mo | (i,mo) <- modules gr, isModCnc mo]
 
       (seqs,cdefs) <- addMissingPMCFGs
                            Map.empty 
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 6031ab938..e81582bc9 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -125,10 +125,10 @@ tree2status o = case o of
 
 buildStatus :: SourceGrammar -> SourceModule -> Check Status
 buildStatus gr mo@(m,mi) = checkIn (ppLocation (msrc mi) NoLoc <> colon) $ do
-  let gr1 = prependModule gr mo
-      ops = [OSimple e | e <- allExtends gr1 m] ++ mopens mi
-  mods <- checkErr $ mapM (lookupModule gr1 . openedModule) ops
-  let sts = map modInfo2status $ zip ops mods    
+  let gr1  = prependModule gr mo
+      exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]
+  ops <- checkErr $ mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
+  let sts = map modInfo2status (exts++ops)
   return (if isModCnc mi
             then (emptyBinTree,    reverse sts)  -- the module itself does not define any names
             else (self2status m mi,reverse sts)) -- so the empty ident is not needed
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 2efec220b..8b2e174ee 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -21,7 +21,7 @@ module GF.Grammar.Grammar (
         MInclude (..), OpenSpec(..),
         extends, isInherited, inheritAll,
         openedModule, depPathModule, allDepsModule, partOfGrammar,
-        allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
+        allExtends, allExtendsPlus,
         searchPathModule,
         
         lookupModule,
@@ -82,7 +82,7 @@ import Control.Monad.Identity
 
 data SourceGrammar = MGrammar { 
     moduleMap :: Map.Map Ident SourceModInfo,
-    modules :: [(Ident,SourceModInfo)]
+    modules :: [SourceModule]
   }
 
 data SourceModInfo = ModInfo {
@@ -165,25 +165,14 @@ partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
     mods = modules gr
     modsFor = (i:) $ map openedModule $ allDepsModule gr m
 
--- | all modules that a module extends, directly or indirectly, without restricts
-allExtends :: SourceGrammar -> Ident -> [Ident]
-allExtends gr i =
-  case lookupModule gr i of
-    Ok m -> case extends m of 
-              [] -> [i]
-              is -> i : concatMap (allExtends gr) is
-    _    -> []
-
 -- | all modules that a module extends, directly or indirectly, with restricts
-allExtendSpecs :: SourceGrammar -> Ident -> [(Ident,MInclude)]
-allExtendSpecs gr i =
-  case lookupModule gr i of
-    Ok m -> case mextend m of 
-              [] -> [(i,MIAll)]
-              is ->  (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
-    _    -> []
+allExtends :: SourceGrammar -> Ident -> [SourceModule]
+allExtends gr m =
+  case lookupModule gr m of
+    Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi)
+    _     -> []
 
--- | this plus that an instance extends its interface
+-- | the same as 'allExtends' plus that an instance extends its interface
 allExtendsPlus :: SourceGrammar -> Ident -> [Ident]
 allExtendsPlus gr i =
   case lookupModule gr i of
@@ -192,19 +181,6 @@ allExtendsPlus gr i =
   where
     exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
 
--- | conversely: all modules that extend a given module, incl. instances of interface
-allExtensions :: SourceGrammar -> Ident -> [Ident]
-allExtensions gr i =
-  case lookupModule gr i of
-    Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
-    _    -> []
- where
-   exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m]
-   mods = modules gr
-   isInstanceOf i m = case mtype m of
-     MTInstance (j,_) -> j == i
-     _ -> False
-
 -- | initial search path: the nonqualified dependencies
 searchPathModule :: SourceModInfo -> [Ident]
 searchPathModule m = [i | OSimple i <- depPathModule m]
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index 6b9b4d869..b4f1de2b0 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -40,6 +40,7 @@ import GF.Grammar.Predef
 import GF.Grammar.Lockfield
 
 import Data.List (sortBy)
+import Data.Maybe (maybe)
 import Control.Monad
 import Text.PrettyPrint
 import qualified Data.Map as Map
@@ -193,30 +194,24 @@ lookupCatContext gr m c = do
 
 allOpers :: SourceGrammar -> [((Ident,Ident),Type,Location)]
 allOpers gr = 
-  [((mo,op),typ,loc) | 
-      (mo,minc)  <- reachable,
-      Ok minfo   <- [lookupModule gr mo],
-      (op,info)  <- Map.toList $ jments minfo,
-      isInherited minc op, 
+  [((m,op),typ,loc) |
+      (m,mi)  <- maybe [] (allExtends gr) (greatestResource gr),
+      (op,info)  <- Map.toList (jments mi),
       L loc typ  <- typesIn info
-  ] 
- where
-  typesIn info = case info of
-    AbsFun  (Just ltyp) _ _ _ -> [ltyp]
-    ResOper (Just ltyp) _     -> [ltyp]
-    ResValue ltyp             -> [ltyp]
-    ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
-    CncFun  (Just (i,ctx,typ)) _ _ _ ->
-                                 [L NoLoc (mkProdSimple ctx (lock' i typ))]
-    _                         -> []
-
-  lock' i typ = case lock i typ of
-                  Ok t -> t
-                  _ -> typ
-
-  reachable = case greatestResource gr of
-    Just r -> allExtendSpecs gr r
-    _ -> []
+  ]
+  where
+    typesIn info = case info of
+      AbsFun  (Just ltyp) _ _ _ -> [ltyp]
+      ResOper (Just ltyp) _     -> [ltyp]
+      ResValue ltyp             -> [ltyp]
+      ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
+      CncFun  (Just (i,ctx,typ)) _ _ _ ->
+                                   [L NoLoc (mkProdSimple ctx (lock' i typ))]
+      _                         -> []
+
+    lock' i typ = case lock i typ of
+                    Ok t -> t
+                    _ -> typ
 
 --- not for dependent types
 allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,Location)]