[commit: ghc] master: nativeGen: A few strictness fixes (ecb316c)

git at git.haskell.org git at git.haskell.org
Thu Sep 14 17:09:13 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ecb316c44e56d62017c7fe1bea0dddfc6bf405a9/ghc

>---------------------------------------------------------------

commit ecb316c44e56d62017c7fe1bea0dddfc6bf405a9
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Sep 13 19:26:56 2017 -0400

    nativeGen: A few strictness fixes
    
    Test Plan: Validate
    
    Reviewers: austin, simonmar
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3948


>---------------------------------------------------------------

ecb316c44e56d62017c7fe1bea0dddfc6bf405a9
 compiler/cmm/CmmContFlowOpt.hs | 5 +++--
 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 219b68e..7981671 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 at 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 2e2c22c..5d611d1 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



More information about the ghc-commits mailing list