summaryrefslogtreecommitdiff
path: root/src/GF/Compile
diff options
context:
space:
mode:
authoraarne <unknown>2005-02-18 13:53:29 +0000
committeraarne <unknown>2005-02-18 13:53:29 +0000
commit75b03fb624af33c9b90c3f3dccacadf18b442d17 (patch)
tree4731876ea45b88a38a2f71934c55e9be7b4ca632 /src/GF/Compile
parentbafc9fbd0570626749261061c858cbbf95ccdcfb (diff)
working on resource doc and exx, fixing bugs
Diffstat (limited to 'src/GF/Compile')
-rw-r--r--src/GF/Compile/ModDeps.hs10
-rw-r--r--src/GF/Compile/Optimize.hs4
-rw-r--r--src/GF/Compile/ShellState.hs10
3 files changed, 14 insertions, 10 deletions
diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs
index 797b445e0..bc47e23a5 100644
--- a/src/GF/Compile/ModDeps.hs
+++ b/src/GF/Compile/ModDeps.hs
@@ -118,12 +118,14 @@ openInterfaces ds m = do
-- | this function finds out what modules are really needed in the canoncal gr.
-- its argument is typically a concrete module name
-requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i]
-requiredCanModules gr = nub . iterFix (concatMap more) . singleton where
+requiredCanModules :: (Ord i, Show i) => MGrammar i f a -> i -> [i]
+requiredCanModules gr = nub . iterFix (concatMap more) . allExtends gr where
more i = errVal [] $ do
m <- lookupModMod gr i
- return $ extends m ++ map openedModule (opens m)
-
+ return $ extends m ++ [o | o <- map openedModule (opens m), notReuse o]
+ notReuse i = errVal True $ do
+ m <- lookupModMod gr i
+ return $ isModRes m -- to exclude reused Cnc and Abs from required
{-
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index 605d50061..1b0d5e464 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -112,8 +112,8 @@ evalCncInfo gr cnc abs (c,info) = case info of
return (c, CncCat ptyp pde' ppr')
- CncFun (mt@(Just (_,ty))) pde ppr -> eIn ("linearization in type" +++
- show ty +++ "of") $ do
+ CncFun (mt@(Just (_,ty@(cont,val)))) pde ppr ->
+ eIn ("linearization in type" +++ prt (mkProd (cont,val,[])) ++++ "of function") $ do
pde' <- case pde of
Yes de -> do
liftM yes $ pEval ty de
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index ebd85784a..abda01100 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -123,16 +123,18 @@ cncModuleIdST = stateGrammarST
-- | form a shell state from a canonical grammar
grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState
grammar2shellState opts (gr,sgr) =
- updateShellState opts emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
+ updateShellState opts Nothing emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
-- | update a shell state from a canonical grammar
-updateShellState :: Options -> ShellState ->
+updateShellState :: Options -> Maybe Ident -> ShellState ->
((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) ->
Err ShellState
-updateShellState opts sh ((_,sgr,gr),rts) = do
+updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
let cgr0 = M.updateMGrammar (canModules sh) gr
- a' = M.greatestAbstract cgr0
+ a' <- return $ case mcnc of
+ Just cnc -> err (const Nothing) Just $ M.abstractOfConcrete cgr0 cnc
+ _ -> M.greatestAbstract cgr0
abstr0 <- case abstract sh of
Just a -> do
-- test that abstract is compatible --- unsafe exception for old?