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

Simplifications, dead code elimination

diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs
index 859c1d4..86508c2 100644 (file)
--- a/ghc/compiler/coreSyn/Subst.lhs
+++ b/ghc/compiler/coreSyn/Subst.lhs
@@ -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}
 
@@ -216,38 +213,6 @@ extendInScopeIds (Subst in_scope ids tvs) 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
   = Subst in_scope ids tvs 

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index d0f043b..e677488 100644 (file)
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -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

diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs
index 095a0a5..8bd967b 100644 (file)
--- a/ghc/compiler/specialise/Rules.lhs
+++ b/ghc/compiler/specialise/Rules.lhs
@@ -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)