X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplUtils.lhs;h=c4f528e182196c307370cef3189d54c028e52c81;hb=09518039f8f793e6464c1703506089a107926d11;hp=387cbd80b8a21cc05fe3c3169263b478457c92f9;hpb=75e81ca47e2efb85a560fa9a48f0a993d1474730;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
index 387cbd8..c4f528e 100644
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ b/ghc/compiler/simplCore/SimplUtils.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module SimplUtils (
-	simplBinder, simplBinders, simplIds,
+	simplBinder, simplBinders, simplRecIds, simplLetId,
 	tryRhsTyLam, tryEtaExpansion,
 	mkCase,
 
@@ -25,9 +25,10 @@ import CmdLineOpts	( switchIsOn, SimplifierSwitch(..),
 import CoreSyn
 import CoreUtils	( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, 
 			  etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce,
-			  findDefault, findAlt
+			  findDefault
 			)
-import Subst		( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr )
+import Subst		( InScopeSet, mkSubst, substExpr )
+import qualified Subst	( simplBndrs, simplBndr, simplLetId )
 import Id		( idType, idName, 
 			  idUnfolding, idStrictness,
 			  mkVanillaId, idInfo
@@ -45,7 +46,7 @@ import Type		( Type, mkForAllTys, seqType, repType,
 import TyCon		( tyConDataConsIfAvailable )
 import DataCon		( dataConRepArity )
 import VarEnv		( SubstEnv )
-import Util		( lengthExceeds )
+import Util		( lengthExceeds, mapAccumL )
 import Outputable
 \end{code}
 
@@ -428,7 +429,7 @@ simplBinders :: [InBinder] -> ([OutBinder] -> SimplM a) -> SimplM a
 simplBinders bndrs thing_inside
   = getSubst		`thenSmpl` \ subst ->
     let
-	(subst', bndrs') = substBndrs subst bndrs
+	(subst', bndrs') = Subst.simplBndrs subst bndrs
     in
     seqBndrs bndrs'	`seq`
     setSubst subst' (thing_inside bndrs')
@@ -437,23 +438,29 @@ simplBinder :: InBinder -> (OutBinder -> SimplM a) -> SimplM a
 simplBinder bndr thing_inside
   = getSubst		`thenSmpl` \ subst ->
     let
-	(subst', bndr') = substBndr subst bndr
+	(subst', bndr') = Subst.simplBndr subst bndr
     in
     seqBndr bndr'	`seq`
     setSubst subst' (thing_inside bndr')
 
 
--- Same semantics as simplBinders, but a little less 
--- plumbing and hence a little more efficient.
--- Maybe not worth the candle?
-simplIds :: [InBinder] -> ([OutBinder] -> SimplM a) -> SimplM a
-simplIds ids thing_inside
+simplRecIds :: [InBinder] -> ([OutBinder] -> SimplM a) -> SimplM a
+simplRecIds ids thing_inside
   = getSubst		`thenSmpl` \ subst ->
     let
-	(subst', bndrs') = substIds subst ids
+	(subst', ids') = mapAccumL Subst.simplLetId subst ids
     in
-    seqBndrs bndrs'	`seq`
-    setSubst subst' (thing_inside bndrs')
+    seqBndrs ids'	`seq`
+    setSubst subst' (thing_inside ids')
+
+simplLetId :: InBinder -> (OutBinder -> SimplM a) -> SimplM a
+simplLetId id thing_inside
+  = getSubst		`thenSmpl` \ subst ->
+    let
+	(subst', id') = Subst.simplLetId subst id
+    in
+    seqBndr id'	`seq`
+    setSubst subst' (thing_inside id')
 
 seqBndrs [] = ()
 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs