1
0
forked from GitHub/gf-core

more clee fix

This commit is contained in:
aarne
2005-09-19 12:01:18 +00:00
parent 19c696217b
commit 7f65334c46
2 changed files with 23 additions and 16 deletions

View File

@@ -5,16 +5,16 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/19 10:05:48 $ -- > CVS $Date: 2005/09/19 13:01:18 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.2 $ -- > CVS $Revision: 1.3 $
-- --
-- Common subexpression elimination. -- Common subexpression elimination.
-- all tables. AR 18\/9\/2005. -- all tables. AR 18\/9\/2005.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Canon.Subexpressions ( module GF.Canon.Subexpressions (
elimSubtermsMod, prSubtermStat, unSubelimCanon elimSubtermsMod, prSubtermStat, unSubelimCanon, unSubelimModule
) where ) where
import GF.Canon.AbsGFC import GF.Canon.AbsGFC
@@ -76,17 +76,24 @@ prSubtermStat gr = unlines [prt mo ++++ expsIn mo js | (mo,js) <- mos] where
unSubelimCanon :: CanonGrammar -> CanonGrammar unSubelimCanon :: CanonGrammar -> CanonGrammar
unSubelimCanon gr@(M.MGrammar modules) = unSubelimCanon gr@(M.MGrammar modules) =
M.MGrammar $ map unparModule modules where M.MGrammar $ map unSubelimModule modules
unparModule (i,m) = case m of
unSubelimModule :: CanonModule -> CanonModule
unSubelimModule mo@(i,m) = case m of
M.ModMod (M.Module mt@(M.MTConcrete _) st fs me ops js) -> 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) _ -> (i,m)
unparInfo (c,info) = case info of where
CncFun k xs t m -> (c, CncFun k xs (unparTerm t) m) unparInfo (c,info) = case info of
_ -> (c,info) CncFun k xs t m -> [(c, CncFun k xs (unparTerm t) m)]
unparTerm t = case t of ResOper _ _ -> []
I c -> errVal t $ liftM unparTerm $ lookupGlobal gr c _ -> [(c,info)]
_ -> C.composSafeOp unparTerm t 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 -- implementation

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/18 22:55:46 $ -- > CVS $Date: 2005/09/19 13:01:18 $
-- > CVS $Author: aarne $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.42 $ -- > CVS $Revision: 1.43 $
-- --
-- The top-level compilation chain from source file to gfc\/gfr. -- 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.Optimize
import GF.Compile.GrammarToCanon import GF.Compile.GrammarToCanon
import GF.Canon.Share import GF.Canon.Share
import GF.Canon.Subexpressions (elimSubtermsMod) import GF.Canon.Subexpressions (elimSubtermsMod,unSubelimModule)
import qualified GF.Canon.CanonToGrammar as CG 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 -- for canonical gf, read the file and update environment, also source env
"gfc" -> do "gfc" -> do
cm <- putp ("+ reading" +++ file) $ getCanonModule file cm <- putp ("+ reading" +++ file) $ getCanonModule file
sm <- ioeErr $ CG.canon2sourceModule cm sm <- ioeErr $ CG.canon2sourceModule $ unSubelimModule cm
ft <- getReadTimes file ft <- getReadTimes file
extendCompileEnv env (sm, cm) ft extendCompileEnv env (sm, cm) ft