forked from GitHub/gf-core
Fixed local flags.
This commit is contained in:
@@ -162,10 +162,11 @@ optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String
|
||||
optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr
|
||||
|
||||
optLinearizeTree :: Options -> GFGrammar -> Tree -> Err String
|
||||
optLinearizeTree opts gr t = case getOptVal opts transferFun of
|
||||
optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
|
||||
Just m -> useByTransfer flin g (I.identC m) t
|
||||
_ -> flin t
|
||||
where
|
||||
opts = addOptions (stateOptions gr) opts0
|
||||
flin = case getOptVal opts markLin of
|
||||
Just mk
|
||||
| mk == markOptXML -> lin markXML
|
||||
|
||||
@@ -7,8 +7,10 @@ import CMacros
|
||||
----import Values
|
||||
import MMacros
|
||||
import qualified Modules as M
|
||||
import qualified CanonToGrammar as CG
|
||||
|
||||
import Operations
|
||||
import Option
|
||||
|
||||
import Monad
|
||||
import List
|
||||
@@ -63,6 +65,12 @@ lookupGlobal gr f = do
|
||||
AnyInd _ n -> lookupGlobal gr $ redirectIdent n f
|
||||
_ -> prtBad "cannot find global" f
|
||||
|
||||
lookupOptionsCan :: CanonGrammar -> Err Options
|
||||
lookupOptionsCan gr = do
|
||||
let fs = M.allFlags gr
|
||||
os <- mapM CG.redFlag fs
|
||||
return $ options os
|
||||
|
||||
lookupParamValues :: CanonGrammar -> CIdent -> Err [Term]
|
||||
lookupParamValues gr pt@(CIQ m _) = do
|
||||
info <- lookupResInfo gr pt
|
||||
|
||||
@@ -87,7 +87,7 @@ emptyStateGrammar = StGr {
|
||||
stateGrammarST = grammar
|
||||
stateCF = cf
|
||||
stateMorpho = morpho
|
||||
stateOptions = loptions ----
|
||||
stateOptions = loptions
|
||||
|
||||
cncModuleIdST = stateGrammarST
|
||||
|
||||
@@ -134,7 +134,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
|
||||
srcModules = src,
|
||||
cfs = zip concrs cfs,
|
||||
morphos = zip concrs (map (mkMorpho cgr) concrs),
|
||||
gloptions = options (M.allFlags src), ---- canModules
|
||||
gloptions = opts,
|
||||
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
|
||||
absCats = csi,
|
||||
statistics = [StDepTypes deps,StBoundVars binds]
|
||||
@@ -193,13 +193,17 @@ allConcretes gr a = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m== M.MTConcret
|
||||
|
||||
stateGrammarOfLang :: ShellState -> Language -> StateGrammar
|
||||
stateGrammarOfLang st l = StGr {
|
||||
absId = maybe (identC "Abs") id (abstract st), ---
|
||||
cncId = l,
|
||||
grammar = canModules st, ---- only those needed for l
|
||||
cf = maybe emptyCF id (lookup l (cfs st)),
|
||||
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
||||
loptions = gloptions st ---- only the own ones!
|
||||
absId = maybe (identC "Abs") id (abstract st), ---
|
||||
cncId = l,
|
||||
grammar = can,
|
||||
cf = maybe emptyCF id (lookup l (cfs st)),
|
||||
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
||||
loptions = errVal noOptions $ lookupOptionsCan can
|
||||
}
|
||||
where
|
||||
allCan = canModules st
|
||||
can = M.partOfGrammar allCan
|
||||
(l, maybe M.emptyModInfo id (lookup l (M.modules allCan)))
|
||||
|
||||
grammarOfLang st = stateGrammarST . stateGrammarOfLang st
|
||||
cfOfLang st = stateCF . stateGrammarOfLang st
|
||||
|
||||
@@ -126,6 +126,16 @@ allDepsModule gr m = iterFix add os0 where
|
||||
m <- depPathModule n]
|
||||
mods = modules gr
|
||||
|
||||
-- select just those modules that a given one depends on, including itself
|
||||
partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a
|
||||
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
||||
where
|
||||
mods = modules gr
|
||||
modsFor = case m of
|
||||
ModMod n -> (i:) $ map openedModule $ allDepsModule gr n
|
||||
_ -> [i] ---- ModWith?
|
||||
|
||||
|
||||
-- all modules that a module extends, directly or indirectly
|
||||
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
||||
allExtends gr i = case lookupModule gr i of
|
||||
@@ -164,6 +174,11 @@ addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
|
||||
emptyMGrammar :: MGrammar i f a
|
||||
emptyMGrammar = MGrammar []
|
||||
|
||||
emptyModInfo :: ModInfo i f a
|
||||
emptyModInfo = ModMod emptyModule
|
||||
|
||||
emptyModule :: Module i f a
|
||||
emptyModule = Module MTResource MSComplete [] Nothing [] NT
|
||||
|
||||
-- we store the module type with the identifier
|
||||
|
||||
|
||||
@@ -1 +1 @@
|
||||
module Today where today = "Mon Nov 10 09:55:30 CET 2003"
|
||||
module Today where today = "Mon Nov 10 11:51:43 CET 2003"
|
||||
|
||||
Reference in New Issue
Block a user