summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/API.hs3
-rw-r--r--src/GF/Canon/Look.hs8
-rw-r--r--src/GF/Compile/ShellState.hs20
-rw-r--r--src/GF/Infra/Modules.hs15
-rw-r--r--src/Today.hs2
5 files changed, 38 insertions, 10 deletions
diff --git a/src/GF/API.hs b/src/GF/API.hs
index 927c9683c..dfaf3bd27 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -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
diff --git a/src/GF/Canon/Look.hs b/src/GF/Canon/Look.hs
index 2126edd60..1f55e4cdb 100644
--- a/src/GF/Canon/Look.hs
+++ b/src/GF/Canon/Look.hs
@@ -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
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 4d0c8b260..1f3078c48 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -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
diff --git a/src/GF/Infra/Modules.hs b/src/GF/Infra/Modules.hs
index 4b642fd72..4eba62283 100644
--- a/src/GF/Infra/Modules.hs
+++ b/src/GF/Infra/Modules.hs
@@ -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
diff --git a/src/Today.hs b/src/Today.hs
index 854a5e9da..ebaac4647 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -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"