Commit 846a43cb authored by Simon Marlow's avatar Simon Marlow

Small improvement to control-flow optimisation

parent df3f5f93
...@@ -12,14 +12,11 @@ where ...@@ -12,14 +12,11 @@ where
import BlockId import BlockId
import Cmm import Cmm
import CmmUtils import CmmUtils
import Digraph
import Maybes import Maybes
import Outputable
import Hoopl import Hoopl
import Control.Monad import Control.Monad
import Prelude hiding (succ, unzip, zip) import Prelude hiding (succ, unzip, zip)
import qualified Data.IntMap as Map
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- --
...@@ -106,16 +103,30 @@ blockConcat g@CmmGraph { g_entry = entry_id } ...@@ -106,16 +103,30 @@ blockConcat g@CmmGraph { g_entry = entry_id }
, shouldConcatWith b' blk' , shouldConcatWith b' blk'
= (mapInsert bid (splice head blk') blocks, shortcut_map) = (mapInsert bid (splice head blk') blocks, shortcut_map)
-- calls: if we can shortcut the continuation label, then
-- we must *also* remember to substitute for the label in the
-- code, because we will push it somewhere.
| Just b' <- callContinuation_maybe last | Just b' <- callContinuation_maybe last
, Just blk' <- mapLookup b' blocks , Just blk' <- mapLookup b' blocks
, Just dest <- canShortcut blk' , Just dest <- canShortcut blk'
= (blocks, mapInsert b' dest shortcut_map) = (blocks, mapInsert b' dest shortcut_map)
-- replaceLabels will substitute dest for b' everywhere, later -- replaceLabels will substitute dest for b' everywhere, later
| otherwise = unchanged -- non-calls: see if we can shortcut any of the successors.
| Nothing <- callContinuation_maybe last
= ( mapInsert bid (blockJoinTail head shortcut_last) blocks
, shortcut_map )
| otherwise
= (blocks, shortcut_map)
where where
(head, last) = blockSplitTail block (head, last) = blockSplitTail block
bid = entryLabel block bid = entryLabel block
shortcut_last = mapSuccessors shortcut last
shortcut l =
case mapLookup l blocks of
Just b | Just dest <- canShortcut b -> dest
_otherwise -> l
shouldConcatWith b block shouldConcatWith b block
| num_preds b == 1 = True -- only one predecessor: go for it | num_preds b == 1 = True -- only one predecessor: go for it
......
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