X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FStackColor.hs;h=bf5f9a0fdad05a4a0c6f1efd956de91f995f0ac6;hb=2bb3a439c106935d97fae7f7a0b60c21493d1bef;hp=f3c1c32cdbd6c3d1924e3e41e0db7ddd8276c1a4;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/cmm/StackColor.hs b/compiler/cmm/StackColor.hs
index f3c1c32..bf5f9a0 100644
--- a/compiler/cmm/StackColor.hs
+++ b/compiler/cmm/StackColor.hs
@@ -16,7 +16,7 @@ import Maybes
 import Panic
 import UniqSet
 
-import Data.List
+-- import Data.List
 
 fold_edge_facts_b ::
   LastNode l => (DualLive -> a -> a) -> BackwardTransfers m l DualLive -> LGraph m l
@@ -27,17 +27,17 @@ fold_edge_facts_b f comp graph env z =
     fold_block_facts z b =              
       let (h, l) = goto_end (ZipCfg.unzip b) 
           last_in _ LastExit = fact_bot dualLiveLattice
-          last_in env (LastOther l) = bt_last_in comp env l
+          last_in env (LastOther l) = bt_last_in comp l env
       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 m out) (f out z)
+    head_fold (ZFirst id) out z = f (bt_first_in comp id out) (f out z)
 
 foldConflicts :: (RegSet -> a -> a) -> a -> LGraph Middle Last -> FuelMonad a
-foldConflicts f z g =
+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