More CPP removal: pprDynamicLinkerAsmLabel in CLabel
[ghc.git] / compiler / cmm / PprCmm.hs
index 521ab05..d32f129 100644 (file)
@@ -59,12 +59,12 @@ import Prelude hiding (succ)
 instance Outputable CmmStackInfo where
     ppr = pprStackInfo
 
-instance Outputable CmmTopInfo where
-    ppr = pprTopInfo
+instance PlatformOutputable CmmTopInfo where
+    pprPlatform = pprTopInfo
 
 
-instance Outputable (CmmNode e x) where
-    ppr = pprNode
+instance PlatformOutputable (CmmNode e x) where
+    pprPlatform = pprNode
 
 instance Outputable Convention where
     ppr = pprConvention
@@ -72,18 +72,18 @@ instance Outputable Convention where
 instance Outputable ForeignConvention where
     ppr = pprForeignConvention
 
-instance Outputable ForeignTarget where
-    ppr = pprForeignTarget
+instance PlatformOutputable ForeignTarget where
+    pprPlatform = pprForeignTarget
 
 
 instance PlatformOutputable (Block CmmNode C C) where
-    pprPlatform = pprBlock
+    pprPlatform = pprBlock
 instance PlatformOutputable (Block CmmNode C O) where
-    pprPlatform = pprBlock
+    pprPlatform = pprBlock
 instance PlatformOutputable (Block CmmNode O C) where
-    pprPlatform = pprBlock
+    pprPlatform = pprBlock
 instance PlatformOutputable (Block CmmNode O O) where
-    pprPlatform = pprBlock
+    pprPlatform = pprBlock
 
 instance PlatformOutputable (Graph CmmNode e x) where
     pprPlatform = pprGraph
@@ -99,22 +99,23 @@ pprStackInfo (StackInfo {arg_space=arg_space, updfr_space=updfr_space}) =
   ptext (sLit "arg_space: ") <> ppr arg_space <+>
   ptext (sLit "updfr_space: ") <> ppr updfr_space
 
-pprTopInfo :: CmmTopInfo -> SDoc
-pprTopInfo (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
-  vcat [ptext (sLit "info_tbl: ") <> ppr info_tbl,
+pprTopInfo :: Platform -> CmmTopInfo -> SDoc
+pprTopInfo platform (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) =
+  vcat [ptext (sLit "info_tbl: ") <> pprPlatform platform info_tbl,
         ptext (sLit "stack_info: ") <> ppr stack_info]
 
 ----------------------------------------------------------
 -- Outputting blocks and graphs
 
 pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
-         => Block CmmNode e x -> IndexedCO e SDoc SDoc
-pprBlock block = foldBlockNodesB3 ( ($$) . ppr
-                                  , ($$) . (nest 4) . ppr
-                                  , ($$) . (nest 4) . ppr
-                                  )
-                                  block
-                                  empty
+         => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
+pprBlock platform block
+    = foldBlockNodesB3 ( ($$) . pprPlatform platform
+                       , ($$) . (nest 4) . pprPlatform platform
+                       , ($$) . (nest 4) . pprPlatform platform
+                       )
+                       block
+                       empty
 
 pprGraph :: Platform -> Graph CmmNode e x -> SDoc
 pprGraph _ GNil = empty
@@ -152,23 +153,25 @@ pprConvention (Private {})          = text "<private-convention>"
 pprForeignConvention :: ForeignConvention -> SDoc
 pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
 
-pprForeignTarget :: ForeignTarget -> SDoc
-pprForeignTarget (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
+pprForeignTarget :: Platform -> ForeignTarget -> SDoc
+pprForeignTarget platform (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
   where ppr_fc :: ForeignConvention -> SDoc
         ppr_fc (ForeignConvention c args res) =
           doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res
         ppr_target :: CmmExpr -> SDoc
-        ppr_target t@(CmmLit _) = ppr t
-        ppr_target fn'          = parens (ppr fn')
+        ppr_target t@(CmmLit _) = pprPlatform platform t
+        ppr_target fn'          = parens (pprPlatform platform fn')
 
-pprForeignTarget (PrimTarget op)
+pprForeignTarget platform (PrimTarget op)
  -- HACK: We're just using a ForeignLabel to get this printed, the label
  --       might not really be foreign.
- = ppr (CmmLabel (mkForeignLabel
-                        (mkFastString (show op))
-                        Nothing ForeignLabelInThisPackage IsFunction))
-pprNode :: CmmNode e x -> SDoc
-pprNode node = pp_node <+> pp_debug
+ = pprPlatform platform
+               (CmmLabel (mkForeignLabel
+                         (mkFastString (show op))
+                         Nothing ForeignLabelInThisPackage IsFunction))
+
+pprNode :: Platform -> CmmNode e x -> SDoc
+pprNode platform node = pp_node <+> pp_debug
   where
     pp_node :: SDoc
     pp_node = case node of
@@ -179,10 +182,10 @@ pprNode node = pp_node <+> pp_debug
       CmmComment s -> text "//" <+> ftext s
 
       -- reg = expr;
-      CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
+      CmmAssign reg expr -> ppr reg <+> equals <+> pprPlatform platform expr <> semi
 
       -- rep[lv] = expr;
-      CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
+      CmmStore lv expr -> rep <> brackets(pprPlatform platform lv) <+> equals <+> pprPlatform platform expr <> semi
           where
             rep = ppr ( cmmExprType expr )
 
@@ -192,7 +195,7 @@ pprNode node = pp_node <+> pp_debug
           hsep [ ppUnless (null results) $
                     parens (commafy $ map ppr results) <+> equals,
                  ptext $ sLit "call",
-                 ppr target <> parens (commafy $ map ppr args) <> semi]
+                 pprPlatform platform target <> parens (commafy $ map (pprPlatform platform) args) <> semi]
 
       -- goto label;
       CmmBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi
@@ -200,7 +203,7 @@ pprNode node = pp_node <+> pp_debug
       -- if (expr) goto t; else goto f;
       CmmCondBranch expr t f ->
           hsep [ ptext (sLit "if")
-               , parens(ppr expr)
+               , parens(pprPlatform platform expr)
                , ptext (sLit "goto")
                , ppr t <> semi
                , ptext (sLit "else goto")
@@ -211,7 +214,9 @@ pprNode node = pp_node <+> pp_debug
           hang (hcat [ ptext (sLit "switch [0 .. ")
                      , int (length maybe_ids - 1)
                      , ptext (sLit "] ")
-                     , if isTrivialCmmExpr expr then ppr expr else parens (ppr expr)
+                     , if isTrivialCmmExpr expr
+                       then pprPlatform platform expr
+                       else parens (pprPlatform platform expr)
                      , ptext (sLit " {")
                      ])
              4 (vcat ( map caseify pairs )) $$ rbrace
@@ -232,15 +237,15 @@ pprNode node = pp_node <+> pp_debug
                                                      <+> parens (ppr res)
                , ptext (sLit " with update frame") <+> ppr updfr_off
                , semi ]
-          where pprFun f@(CmmLit _) = ppr f
-                pprFun f = parens (ppr f)
+          where pprFun f@(CmmLit _) = pprPlatform platform f
+                pprFun f = parens (pprPlatform platform f)
 
       CmmForeignCall {tgt=t, res=rs, args=as, succ=s, updfr=u, intrbl=i} ->
           hcat $ if i then [ptext (sLit "interruptible"), space] else [] ++
                [ ptext (sLit "foreign call"), space
-               , ppr t, ptext (sLit "(...)"), space
+               , pprPlatform platform t, ptext (sLit "(...)"), space
                , ptext (sLit "returns to") <+> ppr s
-                    <+> ptext (sLit "args:") <+> parens (ppr as)
+                    <+> ptext (sLit "args:") <+> parens (pprPlatform platform as)
                     <+> ptext (sLit "ress:") <+> parens (ppr rs)
                , ptext (sLit " with update frame") <+> ppr u
                , semi ]