summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2019-06-17 15:40:14 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-06-18 16:03:19 -0400
commit4549cadf855d14a6b737ceddf4e474faf8e343ff (patch)
tree4f4fd00e86b3679b3d44f9077e5b549ef181f250
parent6a92f59d7385397fb9ee013efe102c797319243c (diff)
downloadhaskell-4549cadf855d14a6b737ceddf4e474faf8e343ff.tar.gz
Make sure mkSplitUniqSupply stores the precomputed mask only.
mkSplitUniqSupply was lazy on the boxed char. This caused a bunch of issues: * The closure captured the boxed Char * The mask was recomputed on every split of the supply. * It also caused the allocation of MkSplitSupply to happen in it's own (allocated) closure. The reason of which I did not further investigate. We know force the computation of the mask inside mkSplitUniqSupply. * This way the mask is computed at most once per UniqSupply creation. * It allows ww to kick in, causing the closure to retain the unboxed value. Requesting Uniques in a loop is now faster by about 20%. I did not check the impact on the overall compiler, but I added a test to avoid regressions.
-rw-r--r--compiler/basicTypes/UniqSupply.hs3
-rw-r--r--testsuite/tests/perf/should_run/UniqLoop.hs17
-rw-r--r--testsuite/tests/perf/should_run/all.T8
3 files changed, 27 insertions, 1 deletions
diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 9697566efc..2ab80e99bd 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE BangPatterns #-}
#if !defined(GHC_LOADED_INTO_GHCI)
{-# LANGUAGE UnboxedTuples #-}
@@ -88,7 +89,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
mkSplitUniqSupply c
= case ord c `shiftL` uNIQUE_BITS of
- mask -> let
+ !mask -> let
-- here comes THE MAGIC:
-- This is one of the most hammered bits in the whole compiler
diff --git a/testsuite/tests/perf/should_run/UniqLoop.hs b/testsuite/tests/perf/should_run/UniqLoop.hs
new file mode 100644
index 0000000000..d4455f99b6
--- /dev/null
+++ b/testsuite/tests/perf/should_run/UniqLoop.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import UniqSupply
+import Unique
+
+-- Generate a lot of uniques
+main = do
+ us <- mkSplitUniqSupply 'v'
+ seq (churn us 10000000) (return ())
+
+churn :: UniqSupply -> Int -> Int
+churn !us 0 = getKey $ uniqFromSupply us
+churn us n =
+ let (!x,!us') = takeUniqFromSupply us
+ in churn us' (n-1)
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 2273ddd400..eecd15f57f 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -367,3 +367,11 @@ test('T15578',
only_ways(['normal'])],
compile_and_run,
['-O2'])
+
+# Test performance of creating Uniques.
+test('UniqLoop',
+ [collect_stats('bytes allocated',5),
+ only_ways(['normal'])
+ ],
+ compile_and_run,
+ ['-O -package ghc']) \ No newline at end of file