From 517d7ec419e8f5a0f9a56e10dbdfe1bbe82fafa5 Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 19 Sep 2005 12:01:18 +0000 Subject: [PATCH] more clee fix --- src/GF/Canon/Subexpressions.hs | 31 +++++++++++++++++++------------ src/GF/Compile/Compile.hs | 8 ++++---- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/GF/Canon/Subexpressions.hs b/src/GF/Canon/Subexpressions.hs index 6d351a0b2..b1891d065 100644 --- a/src/GF/Canon/Subexpressions.hs +++ b/src/GF/Canon/Subexpressions.hs @@ -5,16 +5,16 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/09/19 10:05:48 $ +-- > CVS $Date: 2005/09/19 13:01:18 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.2 $ +-- > CVS $Revision: 1.3 $ -- -- Common subexpression elimination. -- all tables. AR 18\/9\/2005. ----------------------------------------------------------------------------- module GF.Canon.Subexpressions ( - elimSubtermsMod, prSubtermStat, unSubelimCanon + elimSubtermsMod, prSubtermStat, unSubelimCanon, unSubelimModule ) where import GF.Canon.AbsGFC @@ -76,17 +76,24 @@ prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where unSubelimCanon :: CanonGrammar -> CanonGrammar unSubelimCanon gr@(M.MGrammar modules) = - M.MGrammar $ map unparModule modules where - unparModule (i,m) = case m of + M.MGrammar $ map unSubelimModule modules + +unSubelimModule :: CanonModule -> CanonModule +unSubelimModule mo@(i,m) = case m of M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) -> - (i, M.ModMod (M.Module mt st fs me ops (mapTree unparInfo js))) + (i, M.ModMod (M.Module mt st fs me ops + (rebuild (map unparInfo (tree2list js))))) _ -> (i,m) - unparInfo (c,info) = case info of - CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m) - _ -> (c,info) - unparTerm t = case t of - I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c - _ -> C.composSafeOp unparTerm t + where + unparInfo (c,info) = case info of + CncFun k xs t m -> [(c, CncFun k xs (unparTerm t) m)] + ResOper _ _ -> [] + _ -> [(c,info)] + unparTerm t = case t of + I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c + _ -> C.composSafeOp unparTerm t + gr = M.MGrammar [mo] + rebuild = buildTree . concat -- implementation diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index 13710791d..306b8d1bf 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/09/18 22:55:46 $ +-- > CVS $Date: 2005/09/19 13:01:18 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.42 $ +-- > CVS $Revision: 1.43 $ -- -- The top-level compilation chain from source file to gfc\/gfr. ----------------------------------------------------------------------------- @@ -38,7 +38,7 @@ import GF.Compile.CheckGrammar import GF.Compile.Optimize import GF.Compile.GrammarToCanon import GF.Canon.Share -import GF.Canon.Subexpressions (elimSubtermsMod) +import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule) import qualified GF.Canon.CanonToGrammar as CG @@ -189,7 +189,7 @@ compileOne opts env@((_,srcgr,_),_) file = do -- for canonical gf, read the file and update environment, also source env "gfc" -> do cm <- putp ("+ reading" +++ file) $ getCanonModule file - sm <- ioeErr $ CG.canon2sourceModule cm + sm <- ioeErr $ CG.canon2sourceModule $ unSubelimModule cm ft <- getReadTimes file extendCompileEnv env (sm, cm) ft