mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-23 18:02:54 -06:00
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
|
optLinearizeTreeVal opts gr = err id id . optLinearizeTree opts gr
|
||||||
|
|
||||||
optLinearizeTree :: Options -> GFGrammar -> Tree -> Err String
|
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
|
Just m -> useByTransfer flin g (I.identC m) t
|
||||||
_ -> flin t
|
_ -> flin t
|
||||||
where
|
where
|
||||||
|
opts = addOptions (stateOptions gr) opts0
|
||||||
flin = case getOptVal opts markLin of
|
flin = case getOptVal opts markLin of
|
||||||
Just mk
|
Just mk
|
||||||
| mk == markOptXML -> lin markXML
|
| mk == markOptXML -> lin markXML
|
||||||
|
|||||||
@@ -7,8 +7,10 @@ import CMacros
|
|||||||
----import Values
|
----import Values
|
||||||
import MMacros
|
import MMacros
|
||||||
import qualified Modules as M
|
import qualified Modules as M
|
||||||
|
import qualified CanonToGrammar as CG
|
||||||
|
|
||||||
import Operations
|
import Operations
|
||||||
|
import Option
|
||||||
|
|
||||||
import Monad
|
import Monad
|
||||||
import List
|
import List
|
||||||
@@ -63,6 +65,12 @@ lookupGlobal gr f = do
|
|||||||
AnyInd _ n -> lookupGlobal gr $ redirectIdent n f
|
AnyInd _ n -> lookupGlobal gr $ redirectIdent n f
|
||||||
_ -> prtBad "cannot find global" 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 :: CanonGrammar -> CIdent -> Err [Term]
|
||||||
lookupParamValues gr pt@(CIQ m _) = do
|
lookupParamValues gr pt@(CIQ m _) = do
|
||||||
info <- lookupResInfo gr pt
|
info <- lookupResInfo gr pt
|
||||||
|
|||||||
@@ -87,7 +87,7 @@ emptyStateGrammar = StGr {
|
|||||||
stateGrammarST = grammar
|
stateGrammarST = grammar
|
||||||
stateCF = cf
|
stateCF = cf
|
||||||
stateMorpho = morpho
|
stateMorpho = morpho
|
||||||
stateOptions = loptions ----
|
stateOptions = loptions
|
||||||
|
|
||||||
cncModuleIdST = stateGrammarST
|
cncModuleIdST = stateGrammarST
|
||||||
|
|
||||||
@@ -134,7 +134,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
|
|||||||
srcModules = src,
|
srcModules = src,
|
||||||
cfs = zip concrs cfs,
|
cfs = zip concrs cfs,
|
||||||
morphos = zip concrs (map (mkMorpho cgr) concrs),
|
morphos = zip concrs (map (mkMorpho cgr) concrs),
|
||||||
gloptions = options (M.allFlags src), ---- canModules
|
gloptions = opts,
|
||||||
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
|
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
|
||||||
absCats = csi,
|
absCats = csi,
|
||||||
statistics = [StDepTypes deps,StBoundVars binds]
|
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 :: ShellState -> Language -> StateGrammar
|
||||||
stateGrammarOfLang st l = StGr {
|
stateGrammarOfLang st l = StGr {
|
||||||
absId = maybe (identC "Abs") id (abstract st), ---
|
absId = maybe (identC "Abs") id (abstract st), ---
|
||||||
cncId = l,
|
cncId = l,
|
||||||
grammar = canModules st, ---- only those needed for l
|
grammar = can,
|
||||||
cf = maybe emptyCF id (lookup l (cfs st)),
|
cf = maybe emptyCF id (lookup l (cfs st)),
|
||||||
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
||||||
loptions = gloptions st ---- only the own ones!
|
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
|
grammarOfLang st = stateGrammarST . stateGrammarOfLang st
|
||||||
cfOfLang st = stateCF . stateGrammarOfLang st
|
cfOfLang st = stateCF . stateGrammarOfLang st
|
||||||
|
|||||||
@@ -126,6 +126,16 @@ allDepsModule gr m = iterFix add os0 where
|
|||||||
m <- depPathModule n]
|
m <- depPathModule n]
|
||||||
mods = modules gr
|
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
|
-- all modules that a module extends, directly or indirectly
|
||||||
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
||||||
allExtends gr i = case lookupModule gr i of
|
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 i f a
|
||||||
emptyMGrammar = MGrammar []
|
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
|
-- 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