X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=865acdc98df9420d4766571c36c7bc3ac9fa7ca7;hb=5289f5d85610f71625a439747a09384876655eb5;hp=b341b87c951f10a5c88eec6ab5e1f9c04b5ecd1a;hpb=b8ee6f14ca6e9e49015ee9b404cf8b8191fede05;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index b341b87..865acdc 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -131,7 +131,13 @@ pprSimplEnv :: SimplEnv -> SDoc
 -- Used for debugging; selective
 pprSimplEnv env
   = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
- 	  ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
+ 	  ptext (sLit "IdSubst:") <+> ppr (seIdSubst env),
+          ptext (sLit "InScope:") <+> vcat (map ppr_one in_scope_vars)
+    ]
+  where
+   in_scope_vars = varEnvElts (getInScopeVars (seInScope env))
+   ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)
+             | otherwise = ppr v
 
 type SimplIdSubst = IdEnv SimplSR	-- IdId |--> OutExpr
 	-- See Note [Extending the Subst] in CoreSubst
@@ -154,7 +160,8 @@ instance Outputable SimplSR where
 	-- keep uniq _ = uniq `elemUFM_Directly` fvs
 \end{code}
 
-
+Note [SimplEnv invariants]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
 seInScope: 
 	The in-scope part of Subst includes *all* in-scope TyVars and Ids
 	The elements of the set may have better IdInfo than the
@@ -190,9 +197,8 @@ seIdSubst:
 * substId adds a binding (DoneId new_id) to the substitution if 
 	the Id's unique has changed
 
-
   Note, though that the substitution isn't necessarily extended
-  if the type changes.  Why not?  Because of the next point:
+  if the type of the Id changes.  Why not?  Because of the next point:
 
 * We *always, always* finish by looking up in the in-scope set 
   any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
@@ -397,7 +403,9 @@ addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
 -- in-scope set (although it might also have been created with newId)
 -- but it may now have more IdInfo
 addNonRec env id rhs
-  = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
+  = id `seq`   -- This seq forces the Id, and hence its IdInfo,
+	       -- and hence any inner substitutions
+    env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
 	  seInScope = extendInScopeSet (seInScope env) id }
 
 extendFloats :: SimplEnv -> OutBind -> SimplEnv
@@ -528,7 +536,7 @@ simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
 -- The substitution is extended only if the variable is cloned, because
 -- we *don't* need to use it to track occurrence info.
 simplBinder env bndr
-  | isTyVar bndr  = do	{ let (env', tv) = substTyVarBndr env bndr
+  | isTyCoVar bndr  = do	{ let (env', tv) = substTyVarBndr env bndr
 			; seqTyVar tv `seq` return (env', tv) }
   | otherwise     = do	{ let (env', id) = substIdBndr env bndr
 			; seqId id `seq` return (env', id) }
@@ -735,12 +743,14 @@ substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
 ------------------
 substExpr :: SDoc -> SimplEnv -> CoreExpr -> CoreExpr
 substExpr doc env
-  = CoreSubst.substExprSC (text "SimplEnv.substExpr1" <+> doc) 
-                          (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env) 
+  = CoreSubst.substExpr (text "SimplEnv.substExpr1" <+> doc) 
+                        (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env) 
   -- Do *not* short-cut in the case of an empty substitution
-  -- See CoreSubst: Note [Extending the Subst]
+  -- See Note [SimplEnv invariants]
 
 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
-substUnfolding env unf = CoreSubst.substUnfoldingSC (mkCoreSubst (text "subst-unfolding") env) unf
+substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst (text "subst-unfolding") env) unf
+  -- Do *not* short-cut in the case of an empty substitution
+  -- See Note [SimplEnv invariants]
 \end{code}