X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FStackColor.hs;h=bf5f9a0fdad05a4a0c6f1efd956de91f995f0ac6;hb=2bb3a439c106935d97fae7f7a0b60c21493d1bef;hp=03af1818afab90b1392a114c3d6cfbd8e36b7554;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d;p=ghc-hetmet.git diff --git a/compiler/cmm/StackColor.hs b/compiler/cmm/StackColor.hs index 03af181..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,13 +27,13 @@ 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@(LGraph entry _ _) = +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