+ add new old =
+ let join = interAvail new old in
+ if join `smallerAvail` old then aTx join else noTx join
+
+
+interAvail :: AvailRegs -> AvailRegs -> AvailRegs
+interAvail (UniverseMinus s) (UniverseMinus s') = UniverseMinus (s `plusRegSet` s')
+interAvail (AvailRegs s) (AvailRegs s') = AvailRegs (s `timesRegSet` s')
+interAvail (AvailRegs s) (UniverseMinus s') = AvailRegs (s `minusRegSet` s')
+interAvail (UniverseMinus s) (AvailRegs s') = AvailRegs (s' `minusRegSet` s )
+
+smallerAvail :: AvailRegs -> AvailRegs -> Bool
+smallerAvail (AvailRegs _) (UniverseMinus _) = True
+smallerAvail (UniverseMinus _) (AvailRegs _) = False
+smallerAvail (AvailRegs s) (AvailRegs s') = sizeUniqSet s < sizeUniqSet s'
+smallerAvail (UniverseMinus s) (UniverseMinus s') = sizeUniqSet s > sizeUniqSet s'
+
+extendAvail :: AvailRegs -> LocalReg -> AvailRegs
+extendAvail (UniverseMinus s) r = UniverseMinus (deleteFromRegSet s r)
+extendAvail (AvailRegs s) r = AvailRegs (extendRegSet s r)
+
+delFromAvail :: AvailRegs -> LocalReg -> AvailRegs
+delFromAvail (UniverseMinus s) r = UniverseMinus (extendRegSet s r)
+delFromAvail (AvailRegs s) r = AvailRegs (deleteFromRegSet s r)
+
+elemAvail :: AvailRegs -> LocalReg -> Bool
+elemAvail (UniverseMinus s) r = not $ elemRegSet r s
+elemAvail (AvailRegs s) r = elemRegSet r s
+
+type AvailFix = FuelMonad (ForwardFixedPoint Middle Last AvailRegs ())
+
+cmmAvailableReloads :: LGraph Middle Last -> FuelMonad (BlockEnv AvailRegs)
+cmmAvailableReloads g = liftM zdfFpFacts $ (res :: AvailFix)
+ where res = zdfSolveFromL emptyBlockEnv "available reloads" availRegsLattice
+ avail_reloads_transfer empty g
+ empty = fact_bot availRegsLattice
+
+avail_reloads_transfer :: ForwardTransfers Middle Last AvailRegs
+avail_reloads_transfer = ForwardTransfers (flip const) middleAvail lastAvail id
+
+middleAvail :: Middle -> AvailRegs -> AvailRegs
+middleAvail (MidAssign (CmmLocal r) (CmmLoad l _)) avail
+ | l `isStackSlotOf` r = extendAvail avail r
+middleAvail (MidAssign lhs _) avail = foldRegsDefd delFromAvail avail lhs
+middleAvail (MidStore l (CmmReg (CmmLocal r))) avail
+ | l `isStackSlotOf` r = avail
+middleAvail (MidStore (CmmStackSlot (RegSlot r) _) _) avail = delFromAvail avail r
+middleAvail (MidStore {}) avail = avail
+middleAvail (MidForeignCall {}) _ = AvailRegs emptyRegSet
+middleAvail (MidComment {}) avail = avail
+
+lastAvail :: Last -> AvailRegs -> LastOutFacts AvailRegs
+lastAvail (LastCall _ (Just k) _ _ _) _ = LastOutFacts [(k, AvailRegs emptyRegSet)]
+lastAvail l avail = LastOutFacts $ map (\id -> (id, avail)) $ succs l
+
+type LateReloadFix = FuelMonad (ForwardFixedPoint Middle Last AvailRegs CmmGraph)
+
+availRewrites :: ForwardRewrites Middle Last AvailRegs
+availRewrites = ForwardRewrites first middle last exit
+ where first _ _ = Nothing
+ middle m avail = maybe_reload_before avail m (mkMiddle m)
+ last l avail = maybe_reload_before avail l (mkLast l)
+ exit _ = Nothing
+ maybe_reload_before avail node tail =
+ let used = filterRegsUsed (elemAvail avail) node
+ in if isEmptyUniqSet used then Nothing
+ else Just $ reloadTail used tail
+ reloadTail regset t = foldl rel t $ uniqSetToList regset
+ where rel t r = mkMiddle (reload r) <*> t
+
+
+insertLateReloads :: (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+insertLateReloads g = liftM zdfFpContents $ (res :: LateReloadFix)
+ where res = zdfFRewriteFromL RewriteShallow emptyBlockEnv "insert late reloads"
+ availRegsLattice avail_reloads_transfer availRewrites bot g
+ bot = fact_bot availRegsLattice
+
+removeDeadAssignmentsAndReloads :: BlockSet -> (LGraph Middle Last) -> FuelMonad (LGraph Middle Last)
+removeDeadAssignmentsAndReloads procPoints g@(LGraph entry _) =
+ liftM zdfFpContents $ (res :: LiveReloadFix (LGraph Middle Last))
+ where res = zdfBRewriteFromL RewriteDeep emptyBlockEnv "dead-assignment & -reload elim"
+ dualLiveLattice (dualLiveTransfers entry procPoints)
+ rewrites (fact_bot dualLiveLattice) g
+ rewrites = BackwardRewrites nothing middleRemoveDeads nothing Nothing
+ nothing _ _ = Nothing
+
+middleRemoveDeads :: Middle -> DualLive -> Maybe (AGraph Middle Last)
+middleRemoveDeads (MidAssign (CmmLocal reg') _) live
+ | not (reg' `elemRegSet` in_regs live) = Just emptyAGraph
+middleRemoveDeads _ _ = Nothing
+