diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2019-06-17 15:40:14 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-18 16:03:19 -0400 |
commit | 4549cadf855d14a6b737ceddf4e474faf8e343ff (patch) | |
tree | 4f4fd00e86b3679b3d44f9077e5b549ef181f250 | |
parent | 6a92f59d7385397fb9ee013efe102c797319243c (diff) | |
download | haskell-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.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/perf/should_run/UniqLoop.hs | 17 | ||||
-rw-r--r-- | testsuite/tests/perf/should_run/all.T | 8 |
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 |