diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:54:35 +0000 |
| commit | e9e80fc389365e24d4300d7d5390c7d833a96c50 (patch) | |
| tree | f0b58473adaa670bd8fc52ada419d8cad470ee03 /src-3.0/GF/Compile/BackOpt.hs | |
| parent | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff) | |
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'src-3.0/GF/Compile/BackOpt.hs')
| -rw-r--r-- | src-3.0/GF/Compile/BackOpt.hs | 105 |
1 files changed, 0 insertions, 105 deletions
diff --git a/src-3.0/GF/Compile/BackOpt.hs b/src-3.0/GF/Compile/BackOpt.hs deleted file mode 100644 index 8667023c0..000000000 --- a/src-3.0/GF/Compile/BackOpt.hs +++ /dev/null @@ -1,105 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : BackOpt --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:21:33 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.6 $ --- --- Optimizations on GF source code: sharing, parametrization, value sets. --- --- optimization: sharing branches in tables. AR 25\/4\/2003. --- following advice of Josef Svenningsson ------------------------------------------------------------------------------ - -module GF.Compile.BackOpt (shareModule, OptSpec) where - -import GF.Grammar.Grammar -import GF.Infra.Ident -import GF.Infra.Option -import qualified GF.Grammar.Macros as C -import GF.Grammar.PrGrammar (prt) -import GF.Data.Operations -import Data.List -import qualified GF.Infra.Modules as M -import qualified Data.ByteString.Char8 as BS - -import Data.Set (Set) -import qualified Data.Set as Set - -type OptSpec = Set Optimization - -shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo) -shareModule opt (i,m) = case m of - M.ModMod mo -> - (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))) - _ -> (i,m) - -shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m) -shareInfo opt (c, CncFun kxs (Yes t) m) = (c,CncFun kxs (Yes (shareOptim opt c t)) m) -shareInfo opt (c, ResOper ty (Yes t)) = (c,ResOper ty (Yes (shareOptim opt c t))) -shareInfo _ i = i - --- the function putting together optimizations -shareOptim :: OptSpec -> Ident -> Term -> Term -shareOptim opt c = (if OptValues `Set.member` opt then values else id) - . (if OptParametrize `Set.member` opt then factor c 0 else id) - --- do even more: factor parametric branches - -factor :: Ident -> Int -> Term -> Term -factor c i t = case t of - T _ [_] -> t - T _ [] -> t - T (TComp ty) cs -> - T (TTyped ty) $ factors i [(p, factor c (i+1) v) | (p, v) <- cs] - _ -> C.composSafeOp (factor c i) t - where - - factors i psvs = -- we know psvs has at least 2 elements - let p = qqIdent c i - vs' = map (mkFun p) psvs - in if allEqs vs' - then mkCase p vs' - else psvs - - mkFun p (patt, val) = replace (C.patt2term patt) (Vr p) val - - allEqs (v:vs) = all (==v) vs - - mkCase p (v:_) = [(PV p, v)] - ---- we hope this will be fresh and don't check... in GFC would be safe - -qqIdent c i = identC (BS.pack ("q_" ++ prt c ++ "__" ++ show i)) - - --- we need to replace subterms - -replace :: Term -> Term -> Term -> Term -replace old new trm = case trm of - - -- these are the important cases, since they can correspond to patterns - QC _ _ | trm == old -> new - App t ts | trm == old -> new - App t ts -> App (repl t) (repl ts) - R _ | isRec && trm == old -> new - _ -> C.composSafeOp repl trm - where - repl = replace old new - isRec = case trm of - R _ -> True - _ -> False - --- It is very important that this is performed only after case --- expansion since otherwise the order and number of values can --- be incorrect. Guaranteed by the TComp flag. - -values :: Term -> Term -values t = case t of - T ty [(ps,t)] -> T ty [(ps,values t)] -- don't destroy parametrization - T (TComp ty) cs -> V ty [values t | (_, t) <- cs] - _ -> C.composSafeOp values t |
