X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FStackColor.hs;h=03af1818afab90b1392a114c3d6cfbd8e36b7554;hb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0;hp=4d544bdbc870bfde10e195c3718dda81766e3127;hpb=0d80489c9b9f2421f65d8dd86c1e50c6bb429715;p=ghc-hetmet.git

diff --git a/compiler/cmm/StackColor.hs b/compiler/cmm/StackColor.hs
index 4d544bd..03af181 100644
--- a/compiler/cmm/StackColor.hs
+++ b/compiler/cmm/StackColor.hs
@@ -8,7 +8,6 @@ import CmmExpr
 import CmmSpillReload
 import DFMonad
 import qualified GraphOps
-import MachOp
 import ZipCfg
 import ZipCfgCmmRep
 import ZipDataflow
@@ -19,8 +18,6 @@ import UniqSet
 
 import Data.List
 
-type M = ExtendWithSpills Middle
-
 fold_edge_facts_b ::
   LastNode l => (DualLive -> a -> a) -> BackwardTransfers m l DualLive -> LGraph m l
                                      -> (BlockId -> DualLive) -> a -> a
@@ -32,15 +29,15 @@ fold_edge_facts_b f comp graph env z =
           last_in _ LastExit = fact_bot dualLiveLattice
           last_in env (LastOther l) = bt_last_in comp env l
       in head_fold h (last_in env l) z
-    head_fold (ZHead h m) out z = head_fold h (bt_middle_in comp out m) (f out z)
-    head_fold (ZFirst id) out z = f (bt_first_in comp out id) (f out z)
+    head_fold (ZHead h m)   out z = head_fold h (bt_middle_in comp out m) (f out z)
+    head_fold (ZFirst id _) out z = f (bt_first_in comp out id) (f out z)
 
-foldConflicts :: (RegSet -> a -> a) -> a -> LGraph M Last -> FuelMonad a
-foldConflicts f z g =
-  do env <- dualLiveness emptyBlockSet $ graphOfLGraph g
+foldConflicts :: (RegSet -> a -> a) -> a -> LGraph Middle Last -> FuelMonad a
+foldConflicts f z g@(LGraph entry _ _) =
+  do env <- dualLiveness emptyBlockSet g
      let lookup id = lookupBlockEnv env id `orElse` fact_bot dualLiveLattice
          f' dual z = f (on_stack dual) z
-     return $ fold_edge_facts_b f' (dualLiveTransfers emptyBlockSet) g lookup z
+     return $ fold_edge_facts_b f' (dualLiveTransfers entry emptyBlockSet) g lookup z
   --let env = runDFA dualLiveLattice (run_b_anal dualLiveness g >> getAllFacts)
   --    lookup id = lookupBlockEnv env id `orElse` fact_bot dualLiveLattice
   --    f' dual z = f (on_stack dual) z
@@ -50,7 +47,7 @@ foldConflicts f z g =
 type IGraph = Color.Graph LocalReg SlotClass StackPlacement
 type ClassCount = [(SlotClass, Int)]
 
-buildIGraphAndCounts :: LGraph M Last -> FuelMonad (IGraph, ClassCount)
+buildIGraphAndCounts :: LGraph Middle Last -> FuelMonad (IGraph, ClassCount)
 buildIGraphAndCounts g = igraph_and_counts
     where igraph_and_counts = foldConflicts add (Color.initGraph, zero) g
           zero = map (\c -> (c, 0)) allSlotClasses
@@ -73,16 +70,14 @@ graphAddConflictSet :: RegSet -> IGraph -> IGraph
 graphAddConflictSet set graph = GraphOps.addConflicts set slotClass graph
 
 slotClass :: LocalReg -> SlotClass
-slotClass (LocalReg _ machRep _) = 
-    case machRep of -- the horror, the horror
-      I8   -> SlotClass32
-      I16  -> SlotClass32
-      I32  -> SlotClass32
-      I64  -> SlotClass64
-      I128 -> SlotClass128
-      F32  -> SlotClass32
-      F64  -> SlotClass64
-      F80  -> SlotClass64
+slotClass (LocalReg _ ty) = 
+    case typeWidth ty of -- the horror, the horror
+      W8   -> SlotClass32
+      W16  -> SlotClass32
+      W32  -> SlotClass32
+      W64  -> SlotClass64
+      W128 -> SlotClass128
+      W80  -> SlotClass64
 
 {-
 colorMe :: (IGraph, ClassCount) -> (IGraph, UniqSet LocalReg)