-import Data.List
-
-type M = ExtendWithSpills Middle
-
-
-foldConflicts :: (RegSet -> a -> a) -> a -> LGraph M Last -> a
-foldConflicts f z g =
- 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
- in fold_edge_facts_b f' dualLiveness g lookup z
+-- import Data.List
+
+fold_edge_facts_b ::
+ LastNode l => (DualLive -> a -> a) -> BackwardTransfers m l DualLive -> LGraph m l
+ -> (BlockId -> DualLive) -> a -> a
+fold_edge_facts_b f comp graph env z =
+ foldl fold_block_facts z (postorder_dfs graph)
+ where
+ 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 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 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 _) =
+ 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 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
+ --in fold_edge_facts_b f' dualLiveness g lookup z