extra prettyprinting only when debugging

[ghc-hetmet.git] / compiler / cmm / CmmCvt.hs

diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index 35ebb4f..f0c2df5 100644 (file)
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -6,8 +6,8 @@ module CmmCvt
 where
 import Cmm
 import CmmExpr
-import ZipCfgCmm
-import MkZipCfg 
+import MkZipCfgCmm hiding (CmmGraph)
+import ZipCfgCmmRep -- imported for reverse conversion
 import CmmZipUtil
 import FastString
 import Outputable
@@ -27,7 +27,7 @@ cmmOfZgraph = cmmMapGraph  ofZgraph
 
 toZgraph :: String -> ListGraph CmmStmt -> UniqSM CmmGraph
 toZgraph _ (ListGraph []) = lgraphOfAGraph emptyAGraph
-toZgraph fun_name (ListGraph (BasicBlock id ss : other_blocks)) = 
+toZgraph fun_name g@(ListGraph (BasicBlock id ss : other_blocks)) = 
            labelAGraph id $ mkStmts ss <*> foldr addBlock emptyAGraph other_blocks
   where addBlock (BasicBlock id ss) g = mkLabel id   <*> mkStmts ss <*> g
         mkStmts (CmmNop        : ss)  = mkNop        <*> mkStmts ss 
@@ -39,12 +39,11 @@ toZgraph fun_name (ListGraph (BasicBlock id ss : other_blocks)) =
         mkStmts (CmmCall f res args CmmUnsafe CmmMayReturn : ss) =
                       mkUnsafeCall f res args     <*> mkStmts ss
         mkStmts (CmmCondBranch e l : fbranch) =
-            mkIfThenElse (mkCbranch e) (mkBranch l) (mkStmts fbranch)
+            mkCmmIfThenElse e (mkBranch l) (mkStmts fbranch)
         mkStmts (last : []) = mkLast last
         mkStmts []          = bad "fell off end"
         mkStmts (_ : _ : _) = bad "last node not at end"
-        bad msg = panic (msg {- ++ " in block " ++ showSDoc (ppr b) -}
-                            ++ " in function " ++ fun_name)
+        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (ppr g)
         mkLast (CmmCall f  []     args _ CmmNeverReturns) = mkFinalCall f args
         mkLast (CmmSwitch scrutinee table) = mkSwitch scrutinee table
         mkLast (CmmJump tgt args)          = mkJump tgt args
@@ -79,7 +78,7 @@ ofZgraph g = ListGraph $ swallow blocks
           mid m@(CopyIn {})   = pcomment (ppr m <+> text "(proc point)")
           pcomment p = scomment $ showSDoc p
           block' id prev'
-              | id == G.gr_entry g = BasicBlock id $ extend_entry    (reverse prev')
+              | id == G.lg_entry g = BasicBlock id $ extend_entry    (reverse prev')
               | otherwise          = BasicBlock id $ extend_block id (reverse prev')
           last id prev' l n =
               let endblock stmt = block' id (stmt : prev') : swallow n in