Commit cbdda5e0 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu

added monadic mapM_blocks. the fear, the fear...

parent 03637b41
......@@ -13,7 +13,7 @@ module ZipCfg
, blockId, zip, unzip, last, goto_end, zipht, tailOfLast
, splice_tail, splice_head, splice_head_only', splice_head'
, of_block_list, to_block_list
, map_blocks, map_nodes
, map_blocks, map_nodes, mapM_blocks
, postorder_dfs, postorder_dfs_from, postorder_dfs_from_except
, fold_layout
, fold_blocks
......@@ -266,7 +266,9 @@ fold_blocks :: (Block m l -> a -> a) -> a -> LGraph m l -> a
map_nodes :: (BlockId -> BlockId) -> (m -> m') -> (l -> l') -> LGraph m l -> LGraph m' l'
-- mapping includes the entry id!
map_blocks :: (Block m l -> Block m' l') -> LGraph m l -> LGraph m' l'
map_blocks :: (Block m l -> Block m' l') -> LGraph m l -> LGraph m' l'
mapM_blocks :: Monad mm
=> (Block m l -> mm (Block m' l')) -> LGraph m l -> mm (LGraph m' l')
-- | These translation functions are speculative. I hope eventually
-- they will be used in the native-code back ends ---NR
......@@ -485,6 +487,14 @@ map_nodes idm middle last (LGraph eid blocks) = LGraph (idm eid) (mapUFM block b
tail (ZLast LastExit) = ZLast LastExit
tail (ZLast (LastOther l)) = ZLast (LastOther (last l))
mapM_blocks f (LGraph eid blocks) = blocks' >>= return . LGraph eid
where blocks' =
foldUFM (\b mblocks -> do { blocks <- mblocks
; b <- f b
; return $ insertBlock b blocks })
(return emptyBlockEnv) blocks
fold_blocks f z (LGraph _ blocks) = foldUFM f z blocks
of_block_list e blocks = LGraph e $ foldr insertBlock emptyBlockEnv blocks
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment