diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-08-08 16:05:11 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-08-09 09:08:58 +0100 |
| commit | 3a5788c7e09fd6fe3986e731efe71a0cbca24b1d (patch) | |
| tree | 751273f11b3629bb87344bad5598bd050bbb8546 /compiler | |
| parent | 50f5016a67060538a5272cd5fa6f4532d0396ef2 (diff) | |
| download | haskell-3a5788c7e09fd6fe3986e731efe71a0cbca24b1d.tar.gz | |
a couple of small optimisations
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/cmm/CmmContFlowOpt.hs | 13 |
1 files changed, 6 insertions, 7 deletions
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index abbaa63336..aa2925fe53 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -151,8 +151,8 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id } _otherwise -> l shouldConcatWith b block - | num_preds b == 1 = True -- only one predecessor: go for it | okToDuplicate block = True -- short enough to duplicate + | num_preds b == 1 = True -- only one predecessor: go for it | otherwise = False where num_preds bid = mapLookup bid backEdges `orElse` 0 @@ -166,7 +166,7 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id } backEdges :: BlockEnv Int -- number of predecessors for each block backEdges = mapInsertWith (+) entry_id 1 $ -- add 1 for the entry id - mapMap setSize $ predMap blocks + predMap blocks splice :: Block CmmNode C O -> CmmBlock -> CmmBlock splice head rest = head `blockAppend` snd (blockSplitHead rest) @@ -253,12 +253,11 @@ mkCmmCondBranch p t f = if t == f then CmmBranch t else CmmCondBranch p t f ---------------------------------------------------------------- -- Build a map from a block to its set of predecessors. Very useful. -predMap :: [CmmBlock] -> BlockEnv BlockSet +predMap :: [CmmBlock] -> BlockEnv Int predMap blocks = foldr add_preds mapEmpty blocks -- find the back edges - where add_preds block env = foldl (add (entryLabel block)) env (successors block) - add bid env b' = - mapInsert b' (setInsert bid (mapLookup b' env `orElse` setEmpty)) env - + where + add_preds block env = foldr add env (successors block) + where add lbl env = mapInsertWith (+) lbl 1 env ----------------------------------------------------------------------------- -- |