forked from GitHub/gf-core
more clee fix
This commit is contained in:
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user