[commit: ghc] master: Move Outputable instance for FloatBind to the data type definition (31399be)

git at git.haskell.org git at git.haskell.org
Thu Aug 7 08:55:31 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/31399bef865dd02ea9f326907b46ee82bb04fb14/ghc

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

commit 31399bef865dd02ea9f326907b46ee82bb04fb14
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Aug 1 16:39:20 2014 +0100

    Move Outputable instance for FloatBind to the data type definition


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

31399bef865dd02ea9f326907b46ee82bb04fb14
 compiler/coreSyn/MkCore.lhs     | 5 +++++
 compiler/simplCore/FloatOut.lhs | 5 -----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 5213f92..3ba8b1d 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -421,6 +421,11 @@ data FloatBind
       -- 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 dbab552..37d6dc8 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



More information about the ghc-commits mailing list