Trim unused imports detected by new unused-import code

[ghc-hetmet.git] / compiler / nativeGen / SPARC / CodeGen.hs

diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 550a1a3..39ab5eb 100644 (file)
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -18,12 +18,14 @@ where
 #include "MachDeps.h"
 
 -- NCG stuff:
+import SPARC.CodeGen.Sanity
 import SPARC.CodeGen.Amode
 import SPARC.CodeGen.CondCode
 import SPARC.CodeGen.Gen64
 import SPARC.CodeGen.Gen32
 import SPARC.CodeGen.CCall
 import SPARC.CodeGen.Base
+import SPARC.Ppr       ()
 import SPARC.Instr
 import SPARC.Imm
 import SPARC.AddrMode
@@ -40,7 +42,6 @@ import CLabel
 -- The rest:
 import StaticFlags     ( opt_PIC )
 import OrdList
-import qualified Outputable as O
 import Outputable
 
 import Control.Monad   ( mapAndUnzipM )
@@ -57,46 +58,49 @@ cmmTopCodeGen _
  = do  
        (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
 
---     picBaseMb       <- getPicBaseMaybeNat
        let proc        = CmmProc info lab params (ListGraph $ concat nat_blocks)
        let tops        = proc : concat statics
 
---     case picBaseMb of
---      Just picBase -> initializePicBase picBase tops
---      Nothing -> return tops
-  
        return tops
   
-  
 cmmTopCodeGen _ (CmmData sec dat) = do
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 
-
+-- | Do code generation on a single block of CMM code.
+--     code generation may introduce new basic block boundaries, which
+--     are indicated by the NEWBLOCK instruction.  We must split up the
+--     instruction stream into basic blocks again.  Also, we extract
+--     LDATAs here too.
 basicBlockCodeGen 
        :: CmmBasicBlock
        -> NatM ( [NatBasicBlock Instr]
                , [NatCmmTop Instr])
 
-basicBlockCodeGen (BasicBlock id stmts) = do
+basicBlockCodeGen cmm@(BasicBlock id stmts) = do
   instrs <- stmtsToInstrs stmts
-  -- code generation may introduce new basic block boundaries, which
-  -- are indicated by the NEWBLOCK instruction.  We must split up the
-  -- instruction stream into basic blocks again.  Also, we extract
-  -- LDATAs here too.
   let
-       (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
+       (top,other_blocks,statics) 
+               = foldrOL mkBlocks ([],[],[]) instrs
        
        mkBlocks (NEWBLOCK id) (instrs,blocks,statics) 
          = ([], BasicBlock id instrs : blocks, statics)
+
        mkBlocks (LDATA sec dat) (instrs,blocks,statics) 
          = (instrs, blocks, CmmData sec dat:statics)
+
        mkBlocks instr (instrs,blocks,statics)
          = (instr:instrs, blocks, statics)
-  -- in
-  return (BasicBlock id top : other_blocks, statics)
+
+       -- do intra-block sanity checking
+       blocksChecked
+               = map (checkBlock cmm)
+               $ BasicBlock id top : other_blocks
+
+  return (blocksChecked, statics)
 
 
+-- | Convert some Cmm statements to SPARC instructions.
 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
 stmtsToInstrs stmts
    = do instrss <- mapM stmtToInstrs stmts