[commit: ghc] master: Dataflow: use IntSet for mkDepBlocks (b99bae6)

git at git.haskell.org git at git.haskell.org
Tue May 9 02:27:15 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b99bae6d132e083b73283963be85932596341ddd/ghc

>---------------------------------------------------------------

commit b99bae6d132e083b73283963be85932596341ddd
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Mon May 8 17:47:02 2017 -0400

    Dataflow: use IntSet for mkDepBlocks
    
    Using `IntSet` instead of `[Int]` is nicer since it gets rid of
    appending to a list (in the backward case) and folding over it is
    ordered.
    
    I also added a comment about how `mkDepBlocks` works since its
    behavior can be a bit surprising at first sight (it took me some time
    to see that it's doing the right thing ;)
    
    Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>
    
    Test Plan: ./validate
    
    Reviewers: austin, bgamari, simonmar
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3530


>---------------------------------------------------------------

b99bae6d132e083b73283963be85932596341ddd
 compiler/cmm/Hoopl/Dataflow.hs | 60 +++++++++++++++++++++++++-----------------
 1 file changed, 36 insertions(+), 24 deletions(-)

diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index b98c681..197a9c4 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -35,6 +35,8 @@ import Cmm
 import Data.Array
 import Data.List
 import Data.Maybe
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
 
 -- Hide definitions from Hoopl's Dataflow module.
 import Compiler.Hoopl hiding ( DataflowLattice, OldFact, NewFact, JoinFun
@@ -215,42 +217,52 @@ sortBlocks direction entries blockmap =
 -- reverse of what is used for the forward one.
 
 
--- | construct a mapping from L -> block indices.  If the fact for L
--- changes, re-analyse the given blocks.
-mkDepBlocks :: NonLocal n => Direction -> [Block n C C] -> LabelMap [Int]
+-- | Construct a mapping from a @Label@ to the block indexes that should be
+-- re-analyzed if the facts at that @Label@ change.
+--
+-- Note that we're considering here the entry point of the block, so if the
+-- facts change at the entry:
+-- * for a backward analysis we need to re-analyze all the predecessors, but
+-- * for a forward analysis, we only need to re-analyze the current block
+--   (and that will in turn propagate facts into its successors).
+mkDepBlocks :: Direction -> [CmmBlock] -> LabelMap IntSet
 mkDepBlocks Fwd blocks = go blocks 0 mapEmpty
-  where go []     !_  m = m
-        go (b:bs) !n m = go bs (n+1) $! mapInsert (entryLabel b) [n] m
+  where
+    go []     !_ !dep_map = dep_map
+    go (b:bs) !n !dep_map =
+        go bs (n + 1) $ mapInsert (entryLabel b) (IntSet.singleton n) dep_map
 mkDepBlocks Bwd blocks = go blocks 0 mapEmpty
-  where go []     !_ m = m
-        go (b:bs) !n m = go bs (n+1) $! go' (successors b) m
-            where go' [] m = m
-                  go' (l:ls) m = go' ls (mapInsertWith (++) l [n] m)
-
+  where
+    go []     !_ !dep_map = dep_map
+    go (b:bs) !n !dep_map =
+        let insert m l = mapInsertWith IntSet.union l (IntSet.singleton n) m
+        in go bs (n + 1) $ foldl' insert dep_map (successors b)
 
 -- | After some new facts have been generated by analysing a block, we
 -- fold this function over them to generate (a) a list of block
 -- indices to (re-)analyse, and (b) the new FactBase.
---
-updateFact :: JoinFun f -> LabelMap [Int]
-           -> Label -> f       -- out fact
-           -> (IntHeap, FactBase f)
-           -> (IntHeap, FactBase f)
-
+updateFact
+    :: JoinFun f
+    -> LabelMap IntSet
+    -> Label
+    -> f -- out fact
+    -> (IntHeap, FactBase f)
+    -> (IntHeap, FactBase f)
 updateFact fact_join dep_blocks lbl new_fact (todo, fbase)
   = case lookupFact lbl fbase of
-      Nothing       -> let !z = mapInsert lbl new_fact fbase in (changed, z)
-                           -- Note [no old fact]
+      Nothing ->
+          -- Note [No old fact]
+          let !z = mapInsert lbl new_fact fbase in (changed, z)
       Just old_fact ->
-        case fact_join (OldFact old_fact) (NewFact new_fact) of
-          (NotChanged _) -> (todo, fbase)
-          (Changed f) -> let !z = mapInsert lbl f fbase in (changed, z)
+          case fact_join (OldFact old_fact) (NewFact new_fact) of
+              (NotChanged _) -> (todo, fbase)
+              (Changed f) -> let !z = mapInsert lbl f fbase in (changed, z)
   where
-     changed = foldr insertIntHeap todo $
-                 mapFindWithDefault [] lbl dep_blocks
+    changed = IntSet.foldr insertIntHeap todo $
+              mapFindWithDefault IntSet.empty lbl dep_blocks
 
 {-
-Note [no old fact]
+Note [No old fact]
 
 We know that the new_fact is >= _|_, so we don't need to join.  However,
 if the new fact is also _|_, and we have already analysed its block,



More information about the ghc-commits mailing list