X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FStackColor.hs;h=03af1818afab90b1392a114c3d6cfbd8e36b7554;hp=f3c1c32cdbd6c3d1924e3e41e0db7ddd8276c1a4;hb=e6243a818496aad82b6f47511d3bd9bc800f747d;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69 diff --git a/compiler/cmm/StackColor.hs b/compiler/cmm/StackColor.hs index f3c1c32..03af181 100644 --- a/compiler/cmm/StackColor.hs +++ b/compiler/cmm/StackColor.hs @@ -33,11 +33,11 @@ fold_edge_facts_b f comp graph env z = head_fold (ZFirst id _) out z = f (bt_first_in comp out id) (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