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

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, 
+      let cflags  = concatOptions [mflags mo | (i,mo) <- modules gr, isModCnc mo]
-                                                  Just r <- [lookup i (allExtendSpecs gr cm)]]
 
       (seqs,cdefs) <- addMissingPMCFGs
                            Map.empty 

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
+  let gr1  = prependModule gr mo
-      ops = [OSimple e | e <- allExtends gr1 m] ++ mopens mi
+      exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]
-  mods <- checkErr $ mapM (lookupModule gr1 . openedModule) ops
+  ops <- checkErr $ mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
-  let sts = map modInfo2status $ zip ops mods    
+  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

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)]
+allExtends :: SourceGrammar -> Ident -> [SourceModule]
-allExtendSpecs gr i =
+allExtends gr m =
-  case lookupModule gr i of
+  case lookupModule gr m of
-    Ok m -> case mextend m of 
+    Ok mi -> (m,mi) : concatMap (allExtends gr . fst) (mextend mi)
-              [] -> [(i,MIAll)]
+    _     -> []
-              is ->  (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
-    _    -> []
 
--- | 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]

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) | 
+  [((m,op),typ,loc) |
-      (mo,minc)  <- reachable,
+      (m,mi)  <- maybe [] (allExtends gr) (greatestResource gr),
-      Ok minfo   <- [lookupModule gr mo],
+      (op,info)  <- Map.toList (jments mi),
-      (op,info)  <- Map.toList $ jments minfo,
-      isInherited minc op, 
       L loc typ  <- typesIn info
-  ] 
+  ]
- where
+  where
-  typesIn info = case info of
+    typesIn info = case info of
-    AbsFun  (Just ltyp) _ _ _ -> [ltyp]
+      AbsFun  (Just ltyp) _ _ _ -> [ltyp]
-    ResOper (Just ltyp) _     -> [ltyp]
+      ResOper (Just ltyp) _     -> [ltyp]
-    ResValue ltyp             -> [ltyp]
+      ResValue ltyp             -> [ltyp]
-    ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
+      ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
-    CncFun  (Just (i,ctx,typ)) _ _ _ ->
+      CncFun  (Just (i,ctx,typ)) _ _ _ ->
-                                 [L NoLoc (mkProdSimple ctx (lock' i typ))]
+                                   [L NoLoc (mkProdSimple ctx (lock' i typ))]
-    _                         -> []
+      _                         -> []
 
-  lock' i typ = case lock i typ of
+    lock' i typ = case lock i typ of
-                  Ok t -> t
+                    Ok t -> t
-                  _ -> typ
+                    _ -> typ
-
-  reachable = case greatestResource gr of
-    Just r -> allExtendSpecs gr r
-    _ -> []
 
 --- not for dependent types
 allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,Location)]