1
0
forked from GitHub/gf-core

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

This commit is contained in:
kr.angelov
2013-09-23 09:18:27 +00:00
parent a7469a694b
commit e6dbd74dc9
4 changed files with 30 additions and 60 deletions

View File

@@ -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

View File

@@ -126,9 +126,9 @@ 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
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

View File

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

View File

@@ -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,11 +194,9 @@ 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
@@ -214,10 +213,6 @@ allOpers gr =
Ok t -> t
_ -> typ
reachable = case greatestResource gr of
Just r -> allExtendSpecs gr r
_ -> []
--- not for dependent types
allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,Location)]
allOpersTo gr ty = [op | op@(_,typ,_) <- allOpers gr, isProdTo ty typ] where