[commit: ghc] master: Use IntSet in Dataflow (8829743)
git at git.haskell.org
git at git.haskell.org
Mon Jan 22 01:39:56 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/88297438d550a93f72261447a215b6a58b4fae55/ghc
>---------------------------------------------------------------
commit 88297438d550a93f72261447a215b6a58b4fae55
Author: Bartosz Nitka <niteria at gmail.com>
Date: Sun Jan 21 12:11:28 2018 -0500
Use IntSet in Dataflow
Before this change, a list was used as a substitute for a heap.
This led to quadratic behavior on a simple program (see new
test case).
This change replaces it with IntSet in effect reverting
5a1a2633553. @simonmar said it's fine to revert as long as nofib
results are good.
Test Plan:
new test case:
20% improvement
3x improvement when N=10000
nofib:
I run it twice for before and after because the compile time
results are noisy.
- Compile Allocations:
```
before before re-run after after re-run
-1 s.d. ----- -0.0% -0.1% -0.1%
+1 s.d. ----- +0.0% +0.1% +0.1%
Average ----- +0.0% -0.0% -0.0%
```
- Compile Time:
```
before before re-run after after re-run
-1 s.d. ----- -0.1% -2.3% -2.6%
+1 s.d. ----- +5.2% +3.7% +4.4%
Average ----- +2.5% +0.7% +0.8%
```
I checked each case and couldn't find consistent slow-down/speed-up on
compile time. Full results here: P173
Reviewers: simonpj, simonmar, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter, simonmar
GHC Trac Issues: #14667
Differential Revision: https://phabricator.haskell.org/D4329
>---------------------------------------------------------------
88297438d550a93f72261447a215b6a58b4fae55
compiler/cmm/Hoopl/Dataflow.hs | 34 ++++++++---------------
testsuite/tests/perf/compiler/all.T | 12 ++++++++
testsuite/tests/perf/compiler/genManyAlternatives | 34 +++++++++++++++++++++++
3 files changed, 57 insertions(+), 23 deletions(-)
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index b2a7716..2310db2 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -132,7 +132,8 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start
blocks = sortBlocks direction entries blockmap
num_blocks = length blocks
block_arr = {-# SCC "block_arr" #-} listArray (0, num_blocks - 1) blocks
- start = {-# SCC "start" #-} [0 .. num_blocks - 1]
+ start = {-# SCC "start" #-} IntSet.fromDistinctAscList
+ [0 .. num_blocks - 1]
dep_blocks = {-# SCC "dep_blocks" #-} mkDepBlocks direction blocks
join = fact_join lattice
@@ -140,8 +141,7 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start
:: IntHeap -- ^ Worklist, i.e., blocks to process
-> FactBase f -- ^ Current result (increases monotonically)
-> FactBase f
- loop [] !fbase1 = fbase1
- loop (index : todo1) !fbase1 =
+ loop todo !fbase1 | Just (index, todo1) <- IntSet.minView todo =
let block = block_arr ! index
out_facts = {-# SCC "do_block" #-} do_block block fbase1
-- For each of the outgoing edges, we join it with the current
@@ -151,6 +151,7 @@ fixpointAnalysis direction lattice do_block entries blockmap = loop start
mapFoldWithKey
(updateFact join dep_blocks) (todo1, fbase1) out_facts
in loop todo2 fbase2
+ loop _ !fbase1 = fbase1
rewriteCmmBwd
:: DataflowLattice f
@@ -196,7 +197,8 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap
num_blocks = length blocks
block_arr = {-# SCC "block_arr_rewrite" #-}
listArray (0, num_blocks - 1) blocks
- start = {-# SCC "start_rewrite" #-} [0 .. num_blocks - 1]
+ start = {-# SCC "start_rewrite" #-}
+ IntSet.fromDistinctAscList [0 .. num_blocks - 1]
dep_blocks = {-# SCC "dep_blocks_rewrite" #-} mkDepBlocks dir blocks
join = fact_join lattice
@@ -205,8 +207,8 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap
-> LabelMap CmmBlock -- ^ Rewritten blocks.
-> FactBase f -- ^ Current facts.
-> UniqSM (LabelMap CmmBlock, FactBase f)
- loop [] !blocks1 !fbase1 = return (blocks1, fbase1)
- loop (index : todo1) !blocks1 !fbase1 = do
+ loop todo !blocks1 !fbase1
+ | Just (index, todo1) <- IntSet.minView todo = do
-- Note that we use the *original* block here. This is important.
-- We're optimistically rewriting blocks even before reaching the fixed
-- point, which means that the rewrite might be incorrect. So if the
@@ -220,6 +222,7 @@ fixpointRewrite dir lattice do_block entries blockmap = loop start blockmap
mapFoldWithKey
(updateFact join dep_blocks) (todo1, fbase1) out_facts
loop todo2 blocks2 fbase2
+ loop _ !blocks1 !fbase1 = return (blocks1, fbase1)
{-
@@ -344,7 +347,7 @@ updateFact fact_join dep_blocks lbl new_fact (todo, fbase)
(NotChanged _) -> (todo, fbase)
(Changed f) -> let !z = mapInsert lbl f fbase in (changed, z)
where
- changed = IntSet.foldr insertIntHeap todo $
+ changed = todo `IntSet.union`
mapFindWithDefault IntSet.empty lbl dep_blocks
{-
@@ -436,19 +439,4 @@ joinBlocksOO (BMiddle n) b = blockCons n b
joinBlocksOO b (BMiddle n) = blockSnoc b n
joinBlocksOO b1 b2 = BCat b1 b2
--- -----------------------------------------------------------------------------
--- a Heap of Int
-
--- We should really use a proper Heap here, but my attempts to make
--- one have not succeeded in beating the simple ordered list. Another
--- alternative is IntSet (using deleteFindMin), but that was also
--- slower than the ordered list in my experiments --SDM 25/1/2012
-
-type IntHeap = [Int] -- ordered
-
-insertIntHeap :: Int -> [Int] -> [Int]
-insertIntHeap x [] = [x]
-insertIntHeap x (y:ys)
- | x < y = x : y : ys
- | x == y = x : ys
- | otherwise = y : insertIntHeap x ys
+type IntHeap = IntSet
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index bd038a2..51dc6e8 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1166,6 +1166,18 @@ test('ManyConstructors',
multimod_compile,
['ManyConstructors', '-v0'])
+test('ManyAlternatives',
+ [ compiler_stats_num_field('bytes allocated',
+ [(wordsize(64), 1398898072, 10),
+ # initial: 1756999240
+ # 2018-01-20: 1398898072 Use IntSet in Dataflow
+ ]),
+ pre_cmd('./genManyAlternatives'),
+ extra_files(['genManyAlternatives']),
+ ],
+ multimod_compile,
+ ['ManyAlternatives', '-v0'])
+
test('T13701',
[ compiler_stats_num_field('bytes allocated',
[(platform('x86_64-apple-darwin'), 2217187888, 10),
diff --git a/testsuite/tests/perf/compiler/genManyAlternatives b/testsuite/tests/perf/compiler/genManyAlternatives
new file mode 100755
index 0000000..1035425
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genManyAlternatives
@@ -0,0 +1,34 @@
+SIZE=1000
+MODULE=ManyAlternatives
+
+# Generates a module with a large number of alternatives that looks
+# like this:
+#
+# module ManyAlternatives where
+#
+# data A1000 = A0
+# | A0001
+# | A0002
+# ...
+# | A1000
+#
+# f :: A -> Int
+# f A0001 = 1990001
+# f A0002 = 1990002
+# ...
+# f A1000 = 1991000
+#
+# The point of this test is to check if we don't regress on #14667 reintroducing
+# some code that's quadratic in the number of alternatives.
+
+echo "module $MODULE where" > $MODULE.hs
+echo >> $MODULE.hs
+echo "data A$SIZE = A0" >> $MODULE.hs
+for i in $(seq -w 1 $SIZE); do
+ echo " | A$i" >> $MODULE.hs
+done
+echo >> $MODULE.hs
+echo "f :: A$SIZE -> Int" >> $MODULE.hs
+for i in $(seq -w 1 $SIZE); do
+ echo "f A$i = 199$i" >> $MODULE.hs
+done
More information about the ghc-commits
mailing list