[commit: ghc] master: Wibbles to 'simplify the SimplCont data type' (e08cad7)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e08cad76e8a434aca42996f79fc8bb790f291570

>---------------------------------------------------------------

commit e08cad76e8a434aca42996f79fc8bb790f291570
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue May 8 10:25:22 2012 +0100

    Wibbles to 'simplify the SimplCont data type'

>---------------------------------------------------------------

 compiler/simplCore/SimplUtils.lhs |    2 +-
 compiler/simplCore/Simplify.lhs   |    4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index d68e2a4..87aefba 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -162,7 +162,7 @@ addArgTo ai arg = ai { ai_args = arg : ai_args ai
                      , ai_type = applyTypeToArg (ai_type ai) arg  }
 
 instance Outputable SimplCont where
-  ppr (Stop _ interesting)    	     = ptext (sLit "Stop") <> brackets (ppr interesting)
+  ppr (Stop ty interesting)    	     = ptext (sLit "Stop") <> brackets (ppr interesting) <+> ppr ty
   ppr (ApplyTo dup arg _ cont)       = ((ptext (sLit "ApplyTo") <+> ppr dup <+> pprParendExpr arg)
 				       	  {-  $$ nest 2 (pprSimplEnv se) -}) $$ ppr cont
   ppr (StrictBind b _ _ _ cont)      = (ptext (sLit "StrictBind") <+> ppr b) $$ ppr cont
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 3ff0ebb..56e0bed 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -339,13 +339,13 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
 			--    f = /\a. \x. g a x  
 			-- should eta-reduce
 
-                body_out_ty :: OutType
-                body_out_ty = substTy env (exprType body)
 
         ; (body_env, tvs') <- simplBinders rhs_env tvs
                 -- See Note [Floating and type abstraction] in SimplUtils
 
         -- Simplify the RHS
+        ; let   body_out_ty :: OutType
+                body_out_ty = substTy body_env (exprType body)
         ; (body_env1, body1) <- simplExprF body_env body (mkRhsStop body_out_ty)
         -- ANF-ise a constructor or PAP rhs
         ; (body_env2, body2) <- prepareRhs top_lvl body_env1 bndr1 body1