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