[project @ 2003-04-10 14:44:18 by simonpj]

[ghc-hetmet.git] / ghc / compiler / coreSyn / Subst.lhs

diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs
index ce5d8bc..212e914 100644 (file)
--- a/ghc/compiler/coreSyn/Subst.lhs
+++ b/ghc/compiler/coreSyn/Subst.lhs
@@ -28,10 +28,10 @@ module Subst (
 
        -- Type stuff
        mkTyVarSubst, mkTopTyVarSubst, 
-       substTyWith, substTy, substTheta,
+       substTyWith, substTy, substTheta, deShadowTy,
 
        -- Expression stuff
-       substExpr
+       substExpr, substRules
     ) where
 
 #include "HsVersions.h"
@@ -373,13 +373,21 @@ type TyVarSubst = Subst   -- TyVarSubst are expected to have range elements
 -- it'll never be evaluated
 mkTyVarSubst :: [TyVar] -> [Type] -> Subst
 mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys)) 
-                               (zip_ty_env tyvars tys emptySubstEnv)
+                               (zipTyEnv tyvars tys)
 
 -- mkTopTyVarSubst is called when doing top-level substitutions.
 -- Here we expect that the free vars of the range of the
 -- substitution will be empty.
 mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
-mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
+mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zipTyEnv tyvars tys)
+
+zipTyEnv tyvars tys
+#ifdef DEBUG
+  | length tyvars /= length tys
+  = pprTrace "mkTopTyVarSubst" (ppr tyvars $$ ppr tys) emptySubstEnv
+  | otherwise
+#endif
+  = zip_ty_env tyvars tys emptySubstEnv
 
 zip_ty_env []       []       env = env
 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
@@ -407,6 +415,9 @@ substTy :: Subst -> Type  -> Type
 substTy subst ty | isEmptySubst subst = ty
                 | otherwise          = subst_ty subst ty
 
+deShadowTy :: Type -> Type             -- Remove any shadowing from the type
+deShadowTy ty = subst_ty emptySubst ty
+
 substTheta :: TyVarSubst -> ThetaType -> ThetaType
 substTheta subst theta
   | isEmptySubst subst = theta
@@ -740,7 +751,6 @@ substIdInfo subst is_fragile_occ info
   | otherwise     = Just (info `setOccInfo`              (if zap_occ then NoOccInfo else old_occ)
                               `setSpecInfo`      substRules  subst old_rules
                               `setWorkerInfo`    substWorker subst old_wrkr
-                              `setLBVarInfo`     substLBVar  subst old_lbv
                               `setUnfoldingInfo` noUnfolding)
                        -- setSpecInfo does a seq
                        -- setWorkerInfo does a seq
@@ -748,14 +758,12 @@ substIdInfo subst is_fragile_occ info
     nothing_to_do = not zap_occ && 
                    isEmptyCoreRules old_rules &&
                    not (workerExists old_wrkr) &&
-                   hasNoLBVarInfo old_lbv &&
                    not (hasUnfolding (unfoldingInfo info))
     
     zap_occ   = is_fragile_occ old_occ
     old_occ   = occInfo info
     old_rules = specInfo info
     old_wrkr  = workerInfo info
-    old_lbv   = lbvarInfo info
 
 ------------------
 substIdType :: Subst -> Id -> Id
@@ -820,10 +828,4 @@ substVarSet subst fvs
                            DoneEx expr     -> exprFreeVars expr
                            DoneTy ty       -> tyVarsOfType ty 
                            ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
-
-------------------
-substLBVar subst NoLBVarInfo    = NoLBVarInfo
-substLBVar subst (LBVarInfo ty) = ty1 `seq` LBVarInfo ty1
-                               where
-                                 ty1 = substTy subst ty
 \end{code}