-elimSpillAndReload :: StackSlotMap -> LGraph M l -> FuelMonad (StackSlotMap, LGraph Middle l)
-elimSpillAndReload slots g = fold_blocks block (return (slots, [])) g >>= toGraph
- where toGraph (slots, l) = return (slots, of_block_list (lg_entry g) l)
- block (Block id t) z =
- do (slots, blocks) <- z
- (slots, t) <- tail t slots
- return (slots, Block id t : blocks)
- tail (ZLast l) slots = return (slots, ZLast l)
- tail (ZTail m t) slots =
- do (slots, t) <- tail t slots
- middle m t slots
- middle (Spill regs) t slots = foldUniqSet spill (return (slots, t)) regs
- middle (Reload regs) t slots = foldUniqSet reload (return (slots, t)) regs
- middle (NotSpillOrReload m) t slots = return (slots, ZTail m t)
- move f r z = do let reg = CmmLocal r
- (slots, t) <- z
- (slots, slot) <- getSlot slots reg
- return (slots, ZTail (f (CmmStack slot) reg) t)
- spill = move (\ slot reg -> MidAssign slot (CmmReg reg))
- reload = move (\ slot reg -> MidAssign reg (CmmReg slot))
+elimSpillAndReload :: StackSlotMap -> LGraph M l -> (StackSlotMap, LGraph Middle l)
+elimSpillAndReload slots g = toGraph $ fold_blocks block ((slots, [])) g
+ where toGraph (slots, l) = (slots, of_block_list (lg_entry g) l)
+ block (Block id t) (slots, blocks) =
+ lift (\ t' -> Block id t' : blocks) $ tail t slots
+ tail (ZLast l) slots = (slots, ZLast l)
+ tail (ZTail m t) slots = middle m $ tail t slots
+ middle (NotSpillOrReload m) (slots, t) = (slots, ZTail m t)
+ middle (Spill regs) z = foldUniqSet spill z regs
+ middle (Reload regs) z = foldUniqSet reload z regs
+ move f r (slots, t) =
+ lift (\ slot -> ZTail (f slot (CmmLocal r)) t) $ getSlot slots r
+ spill = move (\ slot reg -> MidStore slot (CmmReg reg))
+ reload = move (\ slot reg -> MidAssign reg slot)
+ lift f (slots, x) = (slots, f x)