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

2 files changed, 26 insertions, 55 deletions

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)]