-insertLateReloads :: LGraph M Last -> FuelMonad (LGraph M Last)
-insertLateReloads g = mapM_blocks insertM g
- where env = cmmAvailableReloads g
- avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
- insertM b = fuelConsumingPass "late reloads" (insert b)
- insert (Block id tail) fuel = propagate (ZFirst id) (avail id) tail fuel
- propagate h avail (ZTail m t) fuel =
- let (h', fuel') = maybe_add_reload h avail m fuel in
- propagate (ZHead h' m) (middleAvail m avail) t fuel'
- propagate h avail (ZLast l) fuel =
- let (h', fuel') = maybe_add_reload h avail l fuel in
- (zipht h' (ZLast l), fuel')
- maybe_add_reload h avail node fuel =
- let used = filterRegsUsed (elemAvail avail) node
- in if not (canRewriteWithFuel fuel) || isEmptyUniqSet used then (h,fuel)
- else (ZHead h (Reload used), oneLessFuel fuel)
-
-insertLateReloads' :: UniqSupply -> (Graph M Last) -> FuelMonad (Graph M Last)
-insertLateReloads' us g =
- runDFM us availRegsLattice $
- f_shallow_rewrite avail_reloads_transfer insert bot g
- where bot = fact_bot availRegsLattice
- insert = null_f_ft { fc_middle_out = middle, fc_last_outs = last }
- middle :: AvailRegs -> M -> Maybe (Graph M Last)
- last :: AvailRegs -> Last -> Maybe (Graph M Last)
- middle avail m = maybe_reload_before avail m (ZTail m (ZLast LastExit))
- last avail l = maybe_reload_before avail l (ZLast (LastOther l))
- maybe_reload_before avail node tail =
- let used = filterRegsUsed (elemAvail avail) node
- in if isEmptyUniqSet used then Nothing
- else Just $ graphOfZTail $ ZTail (Reload used) tail
-
-_lateReloadsWithoutFuel :: LGraph M Last -> LGraph M Last
-_lateReloadsWithoutFuel g = map_blocks insert g
- where env = cmmAvailableReloads g
- avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
- insert (Block id tail) = propagate (ZFirst id) (avail id) tail
- propagate h avail (ZTail m t) =
- propagate (ZHead (maybe_add_reload h avail m) m) (middleAvail m avail) t
- propagate h avail (ZLast l) =
- zipht (maybe_add_reload h avail l) (ZLast l)
- maybe_add_reload h avail node =
- let used = filterRegsUsed (elemAvail avail) node
- in if isEmptyUniqSet used then h
- else ZHead h (Reload used)
-
-
-removeDeadAssignmentsAndReloads :: BPass M Last DualLive
-removeDeadAssignmentsAndReloads = a_ft_b dualLiveness remove_deads
- where remove_deads = BComp "dead-assignment & -reload elim" exit last middle first
- exit = Nothing
- last = \_ _ -> Nothing
- middle = middleRemoveDeads
+insertLateReloads :: Graph M Last -> FuelMonad (Graph M Last)
+insertLateReloads g =
+ do env <- cmmAvailableReloads g
+ g <- lGraphOfGraph g
+ liftM graphOfLGraph $ mapM_blocks (insertM env) g
+ where insertM env b = fuelConsumingPass "late reloads" (insert b)
+ where avail id = lookupBlockEnv env id `orElse` AvailRegs emptyRegSet
+ insert (Block id tail) fuel = propagate (ZFirst id) (avail id) tail fuel
+ propagate h avail (ZTail m t) fuel =
+ let (h', fuel') = maybe_add_reload h avail m fuel in
+ propagate (ZHead h' m) (middleAvail m avail) t fuel'
+ propagate h avail (ZLast l) fuel =
+ let (h', fuel') = maybe_add_reload h avail l fuel in
+ (zipht h' (ZLast l), fuel')
+ maybe_add_reload h avail node fuel =
+ let used = filterRegsUsed (elemAvail avail) node
+ in if not (canRewriteWithFuel fuel) || isEmptyUniqSet used
+ then (h,fuel)
+ else (ZHead h (Reload used), oneLessFuel fuel)
+
+type LateReloadFix = FuelMonad (ForwardFixedPoint M Last AvailRegs (Graph M Last))
+
+insertLateReloads' :: (Graph M Last) -> FuelMonad (Graph M Last)
+insertLateReloads' g = liftM zdfFpContents $ (res :: LateReloadFix)
+ where res = zdfRewriteFrom RewriteShallow emptyBlockEnv "insert late reloads"
+ availRegsLattice avail_reloads_transfer rewrites bot g
+ bot = fact_bot availRegsLattice
+ rewrites = ForwardRewrites first middle last exit