X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgCmmRep.hs;h=ee1206eb7039798be705dbf4f36fb815343440a0;hb=5ea42b1f44fb4ac1de57e063cf7348754457702e;hp=f0dc535cedec873d3e073a3a652a31301e3e5b25;hpb=c886dd30160f26f69336adc7dfc3aab5b89a4dfb;p=ghc-hetmet.git

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index f0dc535..ee1206e 100644
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -11,11 +11,9 @@ module ZipCfgCmmRep
   )
 where
 
-#include "HsVersions.h"
-
 import CmmExpr
 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
-           , CmmCallTarget(..), CmmActuals, CmmFormals
+           , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..)
            , CmmStmt(CmmSwitch) -- imported in order to call ppr
            )
 import PprCmm()
@@ -28,6 +26,7 @@ import MachOp
 import qualified ZipDataflow0 as DF
 import ZipCfg 
 import MkZipCfg
+import Util
 
 import Maybes
 import Outputable
@@ -197,9 +196,6 @@ instance Outputable Convention where
 
 instance DF.DebugNodes Middle Last
 
-instance Outputable CmmGraph where
-    ppr = pprLgraph
-
 debugPpr :: Bool
 debugPpr = debugIsOn
 
@@ -207,12 +203,12 @@ pprMiddle :: Middle -> SDoc
 pprMiddle stmt = (case stmt of
 
     CopyIn conv args _ ->
-        if null args then ptext SLIT("empty CopyIn")
+        if null args then ptext (sLit "empty CopyIn")
         else commafy (map pprHinted args) <+> equals <+>
-             ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...")
+             ptext (sLit "foreign") <+> doubleQuotes(ppr conv) <+> ptext (sLit "...")
 
     CopyOut conv args ->
-        ptext SLIT("next, pass") <+> doubleQuotes(ppr conv) <+>
+        ptext (sLit "next, pass") <+> doubleQuotes(ppr conv) <+>
         parens (commafy (map pprHinted args))
 
     --  // text
@@ -232,8 +228,8 @@ pprMiddle stmt = (case stmt of
         hcat [ if null results
                   then empty
                   else parens (commafy $ map ppr results) <>
-                       ptext SLIT(" = "),
-               ptext SLIT("call"), space, 
+                       ptext (sLit " = "),
+               ptext (sLit "call"), space, 
                doubleQuotes(ppr cconv), space,
                ppr_target fn, parens  ( commafy $ map ppr args ),
                semi ]
@@ -244,7 +240,7 @@ pprMiddle stmt = (case stmt of
           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
 
     MidAddToContext ra args ->
-        hcat [ ptext SLIT("return via ")
+        hcat [ ptext (sLit "return via ")
              , ppr_target ra, parens (commafy $ map ppr args), semi ]
 
   ) <>
@@ -265,20 +261,20 @@ ppr_target t@(CmmLit _) = ppr t
 ppr_target fn'          = parens (ppr fn')
 
 
-pprHinted :: Outputable a => (a, MachHint) -> SDoc
-pprHinted (a, NoHint)     = ppr a
-pprHinted (a, PtrHint)    = doubleQuotes (text "address") <+> ppr a
-pprHinted (a, SignedHint) = doubleQuotes (text "signed")  <+> ppr a
-pprHinted (a, FloatHint)  = doubleQuotes (text "float")   <+> ppr a
+pprHinted :: Outputable a => CmmHinted a -> SDoc
+pprHinted (CmmHinted a NoHint)     = ppr a
+pprHinted (CmmHinted a PtrHint)    = doubleQuotes (text "address") <+> ppr a
+pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed")  <+> ppr a
+pprHinted (CmmHinted a FloatHint)  = doubleQuotes (text "float")   <+> ppr a
 
 pprLast :: Last -> SDoc    
 pprLast stmt = (case stmt of
-    LastBranch ident          -> ptext SLIT("goto") <+> ppr ident <> semi
+    LastBranch ident          -> ptext (sLit "goto") <+> ppr ident <> semi
     LastCondBranch expr t f   -> genFullCondBranch expr t f
-    LastJump expr             -> hcat [ ptext SLIT("jump"), space, pprFun expr
-                                      , ptext SLIT("(...)"), semi]
-    LastReturn                -> hcat [ ptext SLIT("return"), space 
-                                      , ptext SLIT("(...)"), semi]
+    LastJump expr             -> hcat [ ptext (sLit "jump"), space, pprFun expr
+                                      , ptext (sLit "(...)"), semi]
+    LastReturn                -> hcat [ ptext (sLit "return"), space 
+                                      , ptext (sLit "(...)"), semi]
     LastSwitch arg ids        -> ppr $ CmmSwitch arg ids
     LastCall tgt k            -> genBareCall tgt k
   ) <>
@@ -294,10 +290,10 @@ pprLast stmt = (case stmt of
 
 genBareCall :: CmmExpr -> Maybe BlockId -> SDoc
 genBareCall fn k =
-        hcat [ ptext SLIT("call"), space
-             , pprFun fn, ptext SLIT("(...)"), space
-             , case k of Nothing -> ptext SLIT("never returns")
-                         Just k -> ptext SLIT("returns to") <+> ppr k
+        hcat [ ptext (sLit "call"), space
+             , pprFun fn, ptext (sLit "(...)"), space
+             , case k of Nothing -> ptext (sLit "never returns")
+                         Just k -> ptext (sLit "returns to") <+> ppr k
              , semi ]
         where
 
@@ -307,11 +303,11 @@ pprFun f = parens (ppr f)
 
 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 genFullCondBranch expr t f =
-    hsep [ ptext SLIT("if")
+    hsep [ ptext (sLit "if")
          , parens(ppr expr)
-         , ptext SLIT("goto")
+         , ptext (sLit "goto")
          , ppr t <> semi
-         , ptext SLIT("else goto")
+         , ptext (sLit "else goto")
          , ppr f <> semi
          ]