[project @ 2001-12-12 18:12:45 by sewardj]

[ghc-hetmet.git] / ghc / compiler / nativeGen / AsmCodeGen.lhs

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 2d65224..8ec5901 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -36,6 +36,8 @@ import MachMisc               ( IF_ARCH_i386(i386_insert_ffrees,) )
 import qualified Pretty
 import Outputable
 
+-- DEBUGGING ONLY
+--import OrdList
 \end{code}
 
 The 96/03 native-code generator has machine-independent and
@@ -125,7 +127,8 @@ absCtoNat absC
      _scc_ "x86fp_kludge"     x86fp_kludge almost_final    `bind`   \ final_mach_code ->
      _scc_ "vcat"     Pretty.vcat (map pprInstr final_mach_code)  `bind`   \ final_sdoc ->
      _scc_ "pprStixTrees"     pprStixStmts stixOpt         `bind`   \ stix_sdoc ->
-     returnUs (stix_sdoc, final_sdoc)
+     returnUs ({-\_ -> Pretty.vcat (map pprInstr almost_final),-}
+               stix_sdoc, final_sdoc)
      where
         bind f x = x f
 
@@ -241,12 +244,18 @@ stixStmt_ConFold stmt
         StJump dsts addr
            -> StJump dsts (stixExpr_ConFold addr)
         StCondJump addr test
-           -> StCondJump addr (stixExpr_ConFold test)
+           -> let test_opt = stixExpr_ConFold test
+              in 
+              if  manifestlyZero test_opt
+              then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+              else StCondJump addr (stixExpr_ConFold test)
         StData pk datas
            -> StData pk (map stixExpr_ConFold datas)
         other
            -> other
-
+     where
+        manifestlyZero (StInt 0) = True
+        manifestlyZero other     = False
 
 stixExpr_ConFold expr
    = case expr of