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

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index b710a94..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()
@@ -25,9 +23,10 @@ import ClosureInfo
 import FastString
 import ForeignCall
 import MachOp
-import qualified ZipDataflow as DF
+import qualified ZipDataflow0 as DF
 import ZipCfg 
 import MkZipCfg
+import Util
 
 import Maybes
 import Outputable
@@ -182,10 +181,6 @@ instance UserOfLocalRegs Last where
             last (LastCondBranch e _ _) = foldRegsUsed f z e
             last (LastSwitch e _tbl)    = foldRegsUsed f z e
 
-instance UserOfLocalRegs (ZLast Last) where
-    foldRegsUsed  f z (LastOther l) = foldRegsUsed f z l
-    foldRegsUsed _f z LastExit      = z
-
 
 ----------------------------------------------------------------------
 ----- Instance declarations for prettyprinting (avoids recursive imports)
@@ -201,9 +196,6 @@ instance Outputable Convention where
 
 instance DF.DebugNodes Middle Last
 
-instance Outputable CmmGraph where
-    ppr = pprLgraph
-
 debugPpr :: Bool
 debugPpr = debugIsOn
 
@@ -211,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
@@ -236,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 ]
@@ -248,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 ]
 
   ) <>
@@ -269,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
   ) <>
@@ -298,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
 
@@ -311,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
          ]