Fix typos and add Outputable constraints to aid debugging.

[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Linear / Main.hs

diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 64dbe75..6b39009 100644 (file)
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -48,7 +48,7 @@ The algorithm is roughly:
 
        (c) Update the current assignment
 
-       (d) If the intstruction is a branch:
+       (d) If the instruction is a branch:
              if the destination block already has a register assignment,
                Generate a new block with fixup code and redirect the
                jump to the new block.
@@ -102,7 +102,7 @@ import Instruction
 import Reg
 
 import BlockId
-import Cmm hiding (RegSet)
+import OldCmm hiding (RegSet)
 
 import Digraph
 import Unique
@@ -132,12 +132,12 @@ regAlloc (CmmData sec d)
                ( CmmData sec d
                , Nothing )
        
-regAlloc (CmmProc (LiveInfo info _ _) lbl params [])
-       = return ( CmmProc info lbl params (ListGraph [])
+regAlloc (CmmProc (LiveInfo info _ _ _) lbl [])
+       = return ( CmmProc info lbl (ListGraph [])
                 , Nothing )
        
-regAlloc (CmmProc static lbl params sccs)
-       | LiveInfo info (Just first_id) (Just block_live)       <- static
+regAlloc (CmmProc static lbl sccs)
+       | LiveInfo info (Just first_id) (Just block_live) _     <- static
        = do    
                -- do register allocation on each component.
                (final_blocks, stats)
@@ -148,11 +148,11 @@ regAlloc (CmmProc static lbl params sccs)
                let ((first':_), rest')
                                = partition ((== first_id) . blockId) final_blocks
 
-               return  ( CmmProc info lbl params (ListGraph (first' : rest'))
+               return  ( CmmProc info lbl (ListGraph (first' : rest'))
                        , Just stats)
        
 -- bogus. to make non-exhaustive match warning go away.
-regAlloc (CmmProc _ _ _ _)
+regAlloc (CmmProc _ _ _)
        = panic "RegAllocLinear.regAlloc: no match"
 
 
@@ -228,7 +228,7 @@ process first_id block_live (b@(BasicBlock id _) : blocks)
  = do  
        block_assig <- getBlockAssigR
 
-       if isJust (lookupBlockEnv block_assig id) 
+       if isJust (mapLookup id block_assig) 
              || id == first_id
          then do 
                b'  <- processBlock block_live b
@@ -259,7 +259,7 @@ processBlock block_live (BasicBlock id instrs)
 initBlock :: BlockId -> RegM ()
 initBlock id
  = do  block_assig     <- getBlockAssigR
-       case lookupBlockEnv block_assig id of
+       case mapLookup id block_assig of
                -- no prior info about this block: assume everything is
                -- free and the assignment is empty.
                Nothing
@@ -331,7 +331,7 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
     -- register does not already have an assignment,
     -- and the source register is assigned to a register, not to a spill slot,
     -- then we can eliminate the instruction.
-    -- (we can't eliminitate it if the source register is on the stack, because
+    -- (we can't eliminate it if the source register is on the stack, because
     --  we do not want to use one spill slot for different virtual registers)
     case takeRegRegMoveInstr instr of
        Just (src,dst)  | src `elementOfUniqSet` (liveDieRead live), 
@@ -497,7 +497,7 @@ releaseRegs regs = do
 
 
 saveClobberedTemps
-       :: Instruction instr
+       :: (Outputable instr, Instruction instr)
        => [RealReg]            -- real registers clobbered by this instruction
        -> [Reg]                -- registers which are no longer live after this insn
        -> RegM [instr]         -- return: instructions to spill any temps that will
@@ -536,7 +536,7 @@ saveClobberedTemps clobbered dying
 
 
 
--- | Mark all these regal regs as allocated,
+-- | Mark all these real regs as allocated,
 --     and kick out their vreg assignments.
 --
 clobberRegs :: [RealReg] -> RegM ()
@@ -579,7 +579,7 @@ clobberRegs clobbered
 --   the list of free registers and free stack slots.
 
 allocateRegsAndSpill
-       :: Instruction instr
+       :: (Outputable instr, Instruction instr)
        => Bool                 -- True <=> reading (load up spilled regs)
        -> [VirtualReg]         -- don't push these out
        -> [instr]              -- spill insns
@@ -599,7 +599,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs)
                        allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
                -- case (1b): already in a register (and memory)
-               -- NB1. if we're writing this register, update its assignemnt to be
+               -- NB1. if we're writing this register, update its assignment to be
                -- InReg, because the memory value is no longer valid.
                -- NB2. This is why we must process written registers here, even if they
                -- are also read by the same instruction.
@@ -709,7 +709,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs loc assig
 
 -- | Load up a spilled temporary if we need to.
 loadTemp
-       :: Instruction instr
+       :: (Outputable instr, Instruction instr)
        => Bool
        -> VirtualReg   -- the temp being loaded
        -> Maybe Loc    -- the current location of this temp