-check_single_exit :: LGraph l m -> a -> a
-check_single_exit g =
- let check block found = case last (unzip block) of
- LastExit -> if found then panic "graph has multiple exits"
- else True
- _ -> found
- in if not (foldUFM check False (gr_blocks g)) then
- panic "graph does not have an exit"
- else
- \a -> a
-
-freshBlockId :: String -> UniqSM BlockId
-freshBlockId _ = do { u <- getUniqueUs; return $ BlockId u }
-
-entry :: LGraph m l -> FGraph m l -- focus on edge out of entry node
-entry g@(LGraph eid _) = focus eid g
-
-
-
-postorder_dfs g@(LGraph _ blocks) =
- let FGraph _ eblock _ = entry g
- in vnode (zip eblock) (\acc _visited -> acc) [] emptyBlockSet
+-- | Used in assertions; tells if a graph has exactly one exit
+single_exit :: LGraph l m -> Bool
+single_exit g = foldUFM check 0 (lg_blocks g) == 1
+ where check block count = case last (unzip block) of
+ LastExit -> count + (1 :: Int)
+ _ -> count
+
+-- | Used in assertions; tells if a graph has exactly one exit
+single_exitg :: Graph l m -> Bool
+single_exitg (Graph tail blocks) = foldUFM add (exit_count (lastTail tail)) blocks == 1
+ where add block count = count + exit_count (last (unzip block))
+ exit_count LastExit = 1 :: Int
+ exit_count _ = 0
+
+------------------ graph traversals
+
+-- | This is the most important traversal over this data structure. It drops
+-- unreachable code and puts blocks in an order that is good for solving forward
+-- dataflow problems quickly. The reverse order is good for solving backward
+-- dataflow problems quickly. The forward order is also reasonably good for
+-- emitting instructions, except that it will not usually exploit Forrest
+-- Baskett's trick of eliminating the unconditional branch from a loop. For
+-- that you would need a more serious analysis, probably based on dominators, to
+-- identify loop headers.
+--
+-- The ubiquity of 'postorder_dfs' is one reason for the ubiquity of the 'LGraph'
+-- representation, when for most purposes the plain 'Graph' representation is
+-- more mathematically elegant (but results in more complicated code).
+--
+-- Here's an easy way to go wrong! Consider
+-- A -> [B,C]
+-- B -> D
+-- C -> D
+-- Then ordinary dfs would give [A,B,D,C] which has a back ref from C to D.
+-- Better to geot [A,B,C,D]
+
+
+postorder_dfs g@(LGraph _ blockenv) =
+ let FGraph id eblock _ = entry g in
+ zip eblock : postorder_dfs_from_except blockenv eblock (unitUniqSet id)
+
+postorder_dfs_from_except :: (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