From 88297438d550a93f72261447a215b6a58b4fae55 Mon Sep 17 00:00:00 2001 From: Bartosz Nitka Date: Sun, 21 Jan 2018 12:11:28 -0500 Subject: 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 --- compiler/cmm/Hoopl/Dataflow.hs | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) (limited to 'compiler') diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index b2a7716c62..2310db2619 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 -- cgit v1.2.1