summaryrefslogtreecommitdiff
path: root/compiler/simplCore
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-05-08 10:25:22 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2012-05-09 16:03:44 +0100
commite08cad76e8a434aca42996f79fc8bb790f291570 (patch)
treee3e0f7443ee210b479438d507c9484633fd69bba /compiler/simplCore
parent4bbd6baee066b906ed93a0659205ecbffdbd0954 (diff)
downloadhaskell-e08cad76e8a434aca42996f79fc8bb790f291570.tar.gz
Wibbles to 'simplify the SimplCont data type'
Diffstat (limited to 'compiler/simplCore')
-rw-r--r--compiler/simplCore/SimplUtils.lhs2
-rw-r--r--compiler/simplCore/Simplify.lhs4
2 files changed, 3 insertions, 3 deletions
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index d68e2a4a46..87aefbab89 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 3ff0ebb262..56e0bededd 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