msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source
This commit is contained in:
kr.angelov
2013-09-23 09:18:27 +00:00
parent 9cbd28e9ce
commit 14061ef4df
4 changed files with 30 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/compiler/GF/Grammar/Lookup.hs
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,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))]
_ -> []
]
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
_ -> []
lock' i typ = case lock i typ of
Ok t -> t
_ -> typ
--- not for dependent types
allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,Location)]