[commit: ghc] master: Use strict types and folds in CoreStats (09d7010)
git at git.haskell.org
git at git.haskell.org
Wed Apr 5 02:23:08 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/09d70107ac1634663ee09d6c0f98293dbb77db5f/ghc
>---------------------------------------------------------------
commit 09d70107ac1634663ee09d6c0f98293dbb77db5f
Author: Reid Barton <rwbarton at gmail.com>
Date: Tue Apr 4 21:46:45 2017 -0400
Use strict types and folds in CoreStats
This only has a significant effect when compiling with -v
(or -dshow-passes), but still there's no reason not to do it.
Test Plan: harbormaster
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3401
>---------------------------------------------------------------
09d70107ac1634663ee09d6c0f98293dbb77db5f
compiler/coreSyn/CoreStats.hs | 20 +++++++++++---------
1 file changed, 11 insertions(+), 9 deletions(-)
diff --git a/compiler/coreSyn/CoreStats.hs b/compiler/coreSyn/CoreStats.hs
index 4da81fd..dd29be7 100644
--- a/compiler/coreSyn/CoreStats.hs
+++ b/compiler/coreSyn/CoreStats.hs
@@ -20,11 +20,13 @@ import Type (Type, typeSize, seqType)
import Id (idType, isJoinId)
import CoreSeq (megaSeqIdInfo)
-data CoreStats = CS { cs_tm :: Int -- Terms
- , cs_ty :: Int -- Types
- , cs_co :: Int -- Coercions
- , cs_vb :: Int -- Local value bindings
- , cs_jb :: Int } -- Local join bindings
+import Data.List (foldl')
+
+data CoreStats = CS { cs_tm :: !Int -- Terms
+ , cs_ty :: !Int -- Types
+ , cs_co :: !Int -- Coercions
+ , cs_vb :: !Int -- Local value bindings
+ , cs_jb :: !Int } -- Local join bindings
instance Outputable CoreStats where
@@ -46,7 +48,7 @@ zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }
oneTM = zeroCS { cs_tm = 1 }
sumCS :: (a -> CoreStats) -> [a] -> CoreStats
-sumCS f = foldr (plusCS . f) zeroCS
+sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS
coreBindsStats :: [CoreBind] -> CoreStats
coreBindsStats = sumCS (bindStats TopLevel)
@@ -99,7 +101,7 @@ coreBindsSize :: [CoreBind] -> Int
-- We use coreBindStats for user printout
-- but this one is a quick and dirty basis for
-- the simplifier's tick limit
-coreBindsSize bs = foldr ((+) . bindSize) 0 bs
+coreBindsSize bs = sum (map bindSize bs)
exprSize :: CoreExpr -> Int
-- ^ A measure of the size of the expressions, strictly greater than 0
@@ -111,7 +113,7 @@ exprSize (App f a) = exprSize f + exprSize a
exprSize (Lam b e) = bndrSize b + exprSize e
exprSize (Let b e) = bindSize b + exprSize e
exprSize (Case e b t as) = seqType t `seq`
- exprSize e + bndrSize b + 1 + foldr ((+) . altSize) 0 as
+ exprSize e + bndrSize b + 1 + sum (map altSize as)
exprSize (Cast e co) = (seqCo co `seq` 1) + exprSize e
exprSize (Tick n e) = tickSize n + exprSize e
exprSize (Type t) = seqType t `seq` 1
@@ -132,7 +134,7 @@ bndrsSize = sum . map bndrSize
bindSize :: CoreBind -> Int
bindSize (NonRec b e) = bndrSize b + exprSize e
-bindSize (Rec prs) = foldr ((+) . pairSize) 0 prs
+bindSize (Rec prs) = sum (map pairSize prs)
pairSize :: (Var, CoreExpr) -> Int
pairSize (b,e) = bndrSize b + exprSize e
More information about the ghc-commits
mailing list