Commit b99bae6d authored by Michal Terepeta's avatar Michal Terepeta Committed by Ben Gamari

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's avatarMichal Terepeta <michal.terepeta@gmail.com>

Test Plan: ./validate

Reviewers: austin, bgamari, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3530
parent c5b28e06
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment