diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-09-13 19:26:56 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-09-14 13:08:46 -0400 |
| commit | ecb316c44e56d62017c7fe1bea0dddfc6bf405a9 (patch) | |
| tree | 60c501e8a8243083835d7eaeeb882557d4688289 | |
| parent | 04bb8736e1b0573ac45905a0f8c96bcb91564e2d (diff) | |
| download | haskell-ecb316c44e56d62017c7fe1bea0dddfc6bf405a9.tar.gz | |
nativeGen: A few strictness fixes
Test Plan: Validate
Reviewers: austin, simonmar
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3948
| -rw-r--r-- | compiler/cmm/CmmContFlowOpt.hs | 5 | ||||
| -rw-r--r-- | compiler/cmm/CmmProcPoint.hs | 6 |
2 files changed, 6 insertions, 5 deletions
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 219b68e42a..7981671c61 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module CmmContFlowOpt ( cmmCfgOpts @@ -194,7 +195,7 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id } maybe_concat :: CmmBlock -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int) -> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int) - maybe_concat block (blocks, shortcut_map, backEdges) + maybe_concat block (!blocks, !shortcut_map, !backEdges) -- If: -- (1) current block ends with unconditional branch to b' and -- (2) it has exactly one predecessor (namely, current block) @@ -416,4 +417,4 @@ removeUnreachableBlocksProc proc@(CmmProc info lbl live g) used_blocks = postorderDfs g used_lbls :: LabelSet - used_lbls = foldr (setInsert . entryLabel) setEmpty used_blocks + used_lbls = setFromList $ map entryLabel used_blocks diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index 2e2c22c10d..5d611d1f25 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -19,7 +19,7 @@ import CmmUtils import CmmInfo import CmmLive import CmmSwitch -import Data.List (sortBy) +import Data.List (sortBy, foldl') import Maybes import Control.Monad import Outputable @@ -279,8 +279,8 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap where block_lbl = blockLbl pp procLabels :: LabelMap (CLabel, Maybe CLabel) - procLabels = foldl add_label mapEmpty - (filter (flip mapMember (toBlockMap g)) (setElems procPoints)) + procLabels = foldl' add_label mapEmpty + (filter (flip mapMember (toBlockMap g)) (setElems procPoints)) -- In each new graph, add blocks jumping off to the new procedures, -- and replace branches to procpoints with branches to the jump-off blocks |