diff options
| author | aarne <unknown> | 2005-02-18 13:53:29 +0000 |
|---|---|---|
| committer | aarne <unknown> | 2005-02-18 13:53:29 +0000 |
| commit | 75b03fb624af33c9b90c3f3dccacadf18b442d17 (patch) | |
| tree | 4731876ea45b88a38a2f71934c55e9be7b4ca632 /src/GF/Compile | |
| parent | bafc9fbd0570626749261061c858cbbf95ccdcfb (diff) | |
working on resource doc and exx, fixing bugs
Diffstat (limited to 'src/GF/Compile')
| -rw-r--r-- | src/GF/Compile/ModDeps.hs | 10 | ||||
| -rw-r--r-- | src/GF/Compile/Optimize.hs | 4 | ||||
| -rw-r--r-- | src/GF/Compile/ShellState.hs | 10 |
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? |
