diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-01 16:39:20 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-07 09:55:13 +0100 |
| commit | 31399bef865dd02ea9f326907b46ee82bb04fb14 (patch) | |
| tree | 915d576a93389c73e6d89eb86a6e0f1d20ba5ef6 | |
| parent | 61baf71021976a105080b060f72df1f1f611389e (diff) | |
| download | haskell-31399bef865dd02ea9f326907b46ee82bb04fb14.tar.gz | |
Move Outputable instance for FloatBind to the data type definition
| -rw-r--r-- | compiler/coreSyn/MkCore.lhs | 9 | ||||
| -rw-r--r-- | compiler/simplCore/FloatOut.lhs | 5 |
2 files changed, 7 insertions, 7 deletions
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 5213f92bac..3ba8b1d6ee 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -415,12 +415,17 @@ mkBigCoreTupTy = mkChunkified mkBoxedTupleTy %************************************************************************ \begin{code} -data FloatBind +data FloatBind = FloatLet CoreBind - | FloatCase CoreExpr Id AltCon [Var] + | FloatCase CoreExpr Id AltCon [Var] -- case e of y { C ys -> ... } -- See Note [Floating cases] in SetLevels +instance Outputable FloatBind where + ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b + ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b) + 2 (ppr c <+> ppr bs) + wrapFloat :: FloatBind -> CoreExpr -> CoreExpr wrapFloat (FloatLet defns) body = Let defns body wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)] diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index dbab552431..37d6dc8568 100644 --- a/compiler/simplCore/FloatOut.lhs +++ b/compiler/simplCore/FloatOut.lhs @@ -458,11 +458,6 @@ data FloatBinds = FB !(Bag FloatLet) -- Destined for top level !MajorEnv -- Levels other than top -- See Note [Representation of FloatBinds] -instance Outputable FloatBind where - ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b - ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b) - 2 (ppr c <+> ppr bs) - instance Outputable FloatBinds where ppr (FB fbs defs) = ptext (sLit "FB") <+> (braces $ vcat |