Fix an egregious strictness analyser bug (Trac #4924)
[ghc-hetmet.git] / compiler / cmm / Dataflow.hs
1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
2
3 module Dataflow (
4         fixedpoint
5   ) where
6
7 -----------------------------------------------------------------------------
8 -- | Solve the fixed-point of a dataflow problem.
9 --
10 -- Complexity: O(N+H*E) calls to the update function where:
11 --   N = number of nodes,
12 --   E = number of edges,
13 --   H = maximum height of the lattice for any particular node.
14 --
15 -- Sketch for proof of complexity:
16 -- Note that the state is threaded through the entire execution.
17 -- Also note that the height of the latice at any particular node
18 -- is the number of times 'update' can return non-Nothing for a
19 -- particular node.  Every call (except for the top level one)
20 -- must be caused by a non-Nothing result and each non-Nothing
21 -- result causes as many calls as it has out-going edges.
22 -- Thus any particular node, n, may cause in total at
23 -- most H*out(n) further calls.  When summed over all nodes,
24 -- that is H*E.  The N term of the complexity is from the initial call
25 -- when 'update' will be passed 'Nothing'.
26 fixedpoint ::
27     (node -> [node])            -- map from nodes to those who's
28                                 -- value depend on the argument node
29     -> (node -> Maybe node -> s -> Maybe s)
30                                 -- Given the node which needs to be
31                                 -- updated, and which node caused that node
32                                 -- to need to be updated, update the state.
33                                 --
34                                 -- The causing node will be 'Nothing' if
35                                 -- this is the initial/bootstrapping update.
36                                 --
37                                 -- Must return 'Nothing' if no change,
38                                 -- otherwise returrn 'Just' of the new state.
39
40     -> [node]                   -- Nodes that should initially be updated
41
42     -> s                        -- Initial state
43                                 -- (usually a map from node to
44                                 -- the value for that node)
45
46     -> s                        -- Final state
47 fixedpoint dependants update nodes state =
48     foldr (fixedpoint' Nothing) state nodes where
49         -- Use a depth first traversal of nodes based on the update graph.
50         -- Terminate the traversal when the update doesn't change anything.
51         fixedpoint' cause node state =
52             case update node cause state of
53               Nothing -> state
54               Just state' ->
55                   foldr (fixedpoint' (Just node)) state' (dependants node)