[project @ 2001-09-10 07:24:09 by simonpj]

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

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 371a0c7..3a75225 100644 (file)
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module SimplUtils (
-       simplBinder, simplBinders, simplRecIds, simplLetId,
+       simplBinder, simplBinders, simplRecIds, simplLetId, simplLamBinder,
        tryRhsTyLam, tryEtaExpansion,
        mkCase,
 
@@ -28,12 +28,11 @@ import CoreUtils    ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap,
                          findDefault
                        )
 import Subst           ( InScopeSet, mkSubst, substExpr )
-import qualified Subst ( simplBndrs, simplBndr, simplLetId )
+import qualified Subst ( simplBndrs, simplBndr, simplLetId, simplLamBndr )
 import Id              ( idType, idName, 
                          idUnfolding, idNewStrictness,
                          mkLocalId, idInfo
                        )
-import IdInfo          ( StrictnessInfo(..) )
 import Maybes          ( maybeToBool, catMaybes )
 import Name            ( setNameUnique )
 import NewDemand       ( isStrictDmd, isBotRes, splitStrictSig )
@@ -429,6 +428,16 @@ simplBinder bndr thing_inside
     setSubst subst' (thing_inside bndr')
 
 
+simplLamBinder :: InBinder -> (OutBinder -> SimplM a) -> SimplM a
+simplLamBinder bndr thing_inside
+  = getSubst           `thenSmpl` \ subst ->
+    let
+       (subst', bndr') = Subst.simplLamBndr subst bndr
+    in
+    seqBndr bndr'      `seq`
+    setSubst subst' (thing_inside bndr')
+
+
 simplRecIds :: [InBinder] -> ([OutBinder] -> SimplM a) -> SimplM a
 simplRecIds ids thing_inside
   = getSubst           `thenSmpl` \ subst ->