Rollback INLINE patches

[ghc-hetmet.git] / compiler / simplCore / SimplEnv.lhs

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 12b3ce5..a2e06a0 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -29,7 +29,7 @@ module SimplEnv (
 
        simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs, 
        simplBinder, simplBinders, addBndrRules,
-       substExpr, substTy, substUnfolding,
+       substExpr, substWorker, substTy, 
 
        -- Floats
        Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
@@ -49,7 +49,7 @@ import VarEnv
 import VarSet
 import OrdList
 import Id
-import qualified CoreSubst     ( Subst, mkSubst, substExpr, substSpec, substUnfolding )
+import qualified CoreSubst     ( Subst, mkSubst, substExpr, substSpec, substWorker )
 import qualified Type          ( substTy, substTyVarBndr )
 import Type hiding             ( substTy, substTyVarBndr )
 import Coercion
@@ -528,7 +528,7 @@ simplLamBndr env bndr
   where
     old_unf = idUnfolding bndr
     (env1, id1) = substIdBndr env bndr
-    id2  = id1 `setIdUnfolding` substUnfolding env False old_unf
+    id2  = id1 `setIdUnfolding` substUnfolding env old_unf
     env2 = modifyInScope env1 id2
 
 ---------------
@@ -660,6 +660,29 @@ addBndrRules env in_id out_id
     old_rules = idSpecialisation in_id
     new_rules = CoreSubst.substSpec subst out_id old_rules
     final_id  = out_id `setIdSpecialisation` new_rules
+
+------------------
+substIdType :: SimplEnv -> Id -> Id
+substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
+  | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
+  | otherwise  = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
+               -- The tyVarsOfType is cheaper than it looks
+               -- because we cache the free tyvars of the type
+               -- in a Note in the id's type itself
+  where
+    old_ty = idType id
+
+------------------
+substUnfolding :: SimplEnv -> Unfolding -> Unfolding
+substUnfolding _   NoUnfolding                = NoUnfolding
+substUnfolding _   (OtherCon cons)            = OtherCon cons
+substUnfolding env (CompulsoryUnfolding rhs)   = CompulsoryUnfolding (substExpr env rhs)
+substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
+
+------------------
+substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
+substWorker _   NoWorker = NoWorker
+substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
 \end{code}
 
 
@@ -695,28 +718,9 @@ mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id
     fiddle (DoneId v)       = Var v
     fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
 
-------------------
-substIdType :: SimplEnv -> Id -> Id
-substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
-  | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
-  | otherwise  = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
-               -- The tyVarsOfType is cheaper than it looks
-               -- because we cache the free tyvars of the type
-               -- in a Note in the id's type itself
-  where
-    old_ty = idType id
-
-------------------
 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
 substExpr env expr = CoreSubst.substExpr (mkCoreSubst env) expr
   -- Do *not* short-cut in the case of an empty substitution
   -- See CoreSubst: Note [Extending the Subst]
-
-substUnfolding :: SimplEnv -> Bool -> Unfolding -> Unfolding
-substUnfolding env is_top_lvl unf 
-  | InlineRule {} <- unf' = unf' { uf_is_top = is_top_lvl }
-  | otherwise             = unf'
-  where
-    unf' = CoreSubst.substUnfolding (mkCoreSubst env) unf
 \end{code}