Commit fdba7999 authored by simonpj's avatar simonpj
Browse files

[project @ 2004-12-23 14:59:46 by simonpj]

Simplifications, dead code elimination
parent af3dc1ff
......@@ -14,8 +14,6 @@ module Subst (
zapSubstEnv, setSubstEnv,
getTvSubst, getTvSubstEnv, setTvSubstEnv,
bindSubst, unBindSubst, bindSubstList, unBindSubstList,
-- Binders
simplBndr, simplBndrs, simplLetId, simplLamBndr, simplIdInfo,
substAndCloneId, substAndCloneIds, substAndCloneRecIds,
......@@ -39,8 +37,7 @@ import CoreFVs ( exprFreeVars )
import CoreUtils ( exprIsTrivial )
import qualified Type ( substTy )
import Type ( Type, tyVarsOfType, mkTyVarTy,
TvSubstEnv, TvSubst(..), substTyVarBndr )
import Type ( Type, tyVarsOfType, TvSubstEnv, TvSubst(..), substTyVarBndr )
import VarSet
import VarEnv
import Var ( setVarUnique, isId, mustHaveLocalBinding )
......@@ -60,7 +57,7 @@ import UniqSupply ( UniqSupply, uniqFromSupply, uniqsFromSupply )
import Var ( Var, Id, TyVar, isTyVar )
import Outputable
import PprCore () -- Instances
import Util ( mapAccumL, foldl2 )
import Util ( mapAccumL )
import FastTypes
\end{code}
......@@ -215,38 +212,6 @@ extendInScopeIds (Subst in_scope ids tvs) vs
= Subst (in_scope `extendInScopeSetList` vs)
(ids `delVarEnvList` vs) tvs
-------------------------------
bindSubst :: Subst -> Var -> Var -> Subst
-- Extend with a substitution, v1 -> Var v2
-- and extend the in-scopes with v2
bindSubst (Subst in_scope ids tvs) old_bndr new_bndr
| isId old_bndr
= Subst (in_scope `extendInScopeSet` new_bndr)
(extendVarEnv ids old_bndr (DoneEx (Var new_bndr)))
tvs
| otherwise
= Subst (in_scope `extendInScopeSet` new_bndr)
ids
(extendVarEnv tvs old_bndr (mkTyVarTy new_bndr))
unBindSubst :: Subst -> Var -> Var -> Subst
-- Reverse the effect of bindSubst
-- If old_bndr was already in the substitution, this doesn't quite work
unBindSubst (Subst in_scope ids tvs) old_bndr new_bndr
= Subst (in_scope `delInScopeSet` new_bndr)
(delVarEnv ids old_bndr)
(delVarEnv tvs old_bndr)
-- And the "List" forms
bindSubstList :: Subst -> [Var] -> [Var] -> Subst
bindSubstList subst old_bndrs new_bndrs
= foldl2 bindSubst subst old_bndrs new_bndrs
unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
unBindSubstList subst old_bndrs new_bndrs
= foldl2 unBindSubst subst old_bndrs new_bndrs
-------------------------------
setInScopeSet :: Subst -> InScopeSet -> Subst
setInScopeSet (Subst _ ids tvs) in_scope
......
......@@ -58,7 +58,8 @@ import CoreSyn
import CmdLineOpts ( FloatOutSwitches(..) )
import CoreUtils ( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
import CoreFVs -- all of it
import Subst
import Subst ( Subst, SubstResult(..), emptySubst, extendInScope, extendIdSubst,
substAndCloneId, substAndCloneRecIds )
import Id ( Id, idType, mkSysLocalUnencoded,
isOneShotLambda, zapDemandIdInfo,
idSpecialisation, idWorkerInfo, setIdInfo
......
......@@ -19,13 +19,12 @@ import OccurAnal ( occurAnalyseRule )
import CoreFVs ( exprFreeVars, exprsFreeVars, ruleRhsFreeVars )
import CoreUnfold ( isCheapUnfolding, unfoldingTemplate )
import CoreUtils ( tcEqExprX )
import Type ( Type )
import CoreTidy ( pprTidyIdRules )
import Subst ( IdSubstEnv, SubstResult(..) )
import Id ( Id, idUnfolding, idSpecialisation, setIdSpecialisation )
import Var ( Var )
import VarSet
import VarEnv
import TcType ( TvSubstEnv )
import Unify ( tcMatchTyX, MatchEnv(..) )
import BasicTypes ( Activation, CompilerPhase, isActive )
......@@ -156,12 +155,27 @@ matchN in_scope tmpl_vars tmpl_es target_es
Just ty -> Type ty
Nothing -> unbound tmpl_var
| otherwise = case lookupVarEnv id_subst tmpl_var of
Just (DoneEx e) -> e
other -> unbound tmpl_var
Just e -> e
other -> unbound tmpl_var
unbound var = pprPanic "Template variable unbound in rewrite rule" (ppr var)
\end{code}
emptySubstEnv :: (TvSubstEnv, IdSubstEnv)
---------------------------------------------
The inner workings of matching
---------------------------------------------
\begin{code}
-- These two definitions are not the same as in Subst,
-- but they simple and direct, and purely local to this module
-- The third, for TvSubstEnv, is the same as in VarEnv, but repeated here
-- for uniformity with IdSubstEnv
type SubstEnv = (TvSubstEnv, IdSubstEnv)
type IdSubstEnv = IdEnv CoreExpr
type TvSubstEnv = TyVarEnv Type
emptySubstEnv :: SubstEnv
emptySubstEnv = (emptyVarEnv, emptyVarEnv)
......@@ -175,10 +189,10 @@ emptySubstEnv = (emptyVarEnv, emptyVarEnv)
match :: MatchEnv
-> (TvSubstEnv, IdSubstEnv)
-> SubstEnv
-> CoreExpr -- Template
-> CoreExpr -- Target
-> Maybe (TvSubstEnv, IdSubstEnv)
-> Maybe SubstEnv
-- See the notes with Unify.match, which matches types
-- Everything is very similar for terms
......@@ -204,10 +218,10 @@ match menv subst@(tv_subst, id_subst) (Var v1) e2
-- e.g. match forall a. (\x-> a x) against (\y. y y)
| otherwise
-> Just (tv_subst, extendVarEnv id_subst v1 (DoneEx e2))
-> Just (tv_subst, extendVarEnv id_subst v1 e2)
Just (DoneEx e2') | tcEqExprX (nukeRnEnvL rn_env) e2' e2
-> Just subst
Just e2' | tcEqExprX (nukeRnEnvL rn_env) e2' e2
-> Just subst
other -> Nothing
......@@ -294,10 +308,10 @@ match menv subst e1 e2 = Nothing
------------------------------------------
match_alts :: MatchEnv
-> (TvSubstEnv, IdSubstEnv)
-> SubstEnv
-> [CoreAlt] -- Template
-> [CoreAlt] -- Target
-> Maybe (TvSubstEnv, IdSubstEnv)
-> Maybe SubstEnv
match_alts menv subst [] []
= return subst
match_alts menv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment