+postorder_dfs g@(LGraph _ blockenv) =
+ let FGraph id eblock _ = entry g
+ dfs1 = zip eblock :
+ postorder_dfs_from_except blockenv eblock (unitUniqSet id)
+ dfs2 = postorder_dfs' g
+-- in ASSERT (map blockId dfs1 == map blockId dfs2) dfs2
+ in if (map blockId dfs1 == map blockId dfs2) then dfs2 else panic "inconsistent DFS"
+
+postorder_dfs_from
+ :: (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> [Block m l]
+postorder_dfs_from blocks b = postorder_dfs_from_except blocks b emptyBlockSet
+
+postorder_dfs_from_except :: forall b m l . (HavingSuccessors b, LastNode l) => BlockEnv (Block m l) -> b -> BlockSet -> [Block m l]
+postorder_dfs_from_except blocks b visited =
+ vchildren (get_children b) (\acc _visited -> acc) [] visited
+ where
+ -- vnode ::
+ -- Block m l -> ([Block m l] -> BlockSet -> a) -> [Block m l] -> BlockSet -> a
+ vnode block@(Block id _) cont acc visited =
+ if elemBlockSet id visited then
+ cont acc visited
+ else
+ let cont' acc visited = cont (block:acc) visited in
+ vchildren (get_children block) cont' acc (extendBlockSet visited id)
+ vchildren bs cont acc visited =
+ let next children acc visited =
+ case children of [] -> cont acc visited
+ (b:bs) -> vnode b (next bs) acc visited
+ in next bs acc visited
+ get_children block = foldl add_id [] (succs block)
+ add_id rst id = case lookupBlockEnv blocks id of
+ Just b -> b : rst
+ Nothing -> rst
+