functor DATAOPT(
    structure F:FlowSig
    structure S:sig
        type Item
        type Set
        val empty : Set
        val member: Set -> Item -> bool
        val insert: Set -> Item -> Set
        val contains : Set -> Set -> bool
        val sing  : Item -> Set
        val union : Set -> Set -> Set
        val image : (Item -> Set) -> (Set -> Set)
    end 
    structure D: sig
        type Key
        type Item
        type Dict
        exception Lookup
        val empty : Dict
        val lookup: Dict -> Key -> Item 
        val enter : ((Key * Item) * Dict) -> Dict
    end
    structure Basic: sig
        val filter : ('a -> bool) -> 'a list -> 'a list
        val member : ''a list -> ''a -> bool
        val delete : ''a -> ''a list -> ''a list
        exception Lookup
        val lookup : (''a * 'b) list -> ''a -> 'b
        val fold : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
    end
    sharing type S.Item = string
        and type D.Key  = F.G.Vertex = int
        and type D.Item = S.Set) :
sig 
   structure OF: FlowSig
   val dataOpt : F.G.Graph -> OF.G.Graph
end
=
struct

structure OF =
struct
   structure B = F.B
   structure C = F.C
   structure G =
   struct
      type Vertex = int
      datatype Graph = 
         FG of( Vertex 
                * ( Vertex list * (B.Block * C.Cond) )
              ) list

      fun vertices (FG g) = map #1 g
      fun adj  (FG g) v   = #1(Basic.lookup g v)
   end
   fun data (G.FG g) v        = #2(Basic.lookup g v)
end

open F.B

fun entry dict k = (D.lookup dict k; true) handle D.Lookup => false

fun leaves (x *** y) = S.union (leaves x) (leaves y)
  | leaves (x --- y) = S.union (leaves x) (leaves y)
  | leaves (x +++ y) = S.union (leaves x) (leaves y)
  | leaves (x /// y) = S.union (leaves x) (leaves y)
  | leaves (Id x)    = S.sing x
  | leaves (Lit _)   = S.empty

fun dataOpt g = 
let
val set = Basic.fold S.insert S.empty
val all = Basic.fold (fn s => fn j => S.union s
                       let val Block b = #1(F.data g j)
                       in
                         set (map #1 b)
                       end
                     )
                      S.empty (F.G.vertices g)

fun depends j x = let val Block b = #1(F.data g j)
                  in
                      leaves (Basic.lookup b x) 
                      handle Basic.Lookup => S.sing x
                  end

fun outputs odict n = D.lookup odict n handle Lookup => all
fun inputs  odict n = S.image (depends n) (outputs odict n)
(* if odict gives the required outputs of a block, inputs odict gives required inputs *)

fun onestep x outputs = S.image (depends x) outputs
fun reaches x outputs =
    let val onemore = onestep x outputs
     in
        if S.contains onemore outputs then outputs
        else reaches x (S.union onemore outputs)
     end

local open F.C
in
fun s (Lit _) = []
  | s (Id x)  = [x]

fun cvars j = case #2(F.data g j) of
                 (x <<< y) => s x @ s y
               | (x <<= y) => s x @ s y
               | (x >>= y) => s x @ s y
               | (x >>> y) => s x @ s y
               | (x === y) => s x @ s y
               | (x !!= y) => s x @ s y
               |  _        => []
end

fun outputs _    []       dict = dict
  | outputs path (h :: t) dict = 
    outputs path t 
    (if entry dict h then dict
     else if Basic.member path h then 
          doloop path h dict
     else case F.G.adj g h of
          [] => (D.enter((h,all),dict)) (* all required at termination *)
        | a  => let val dict' = outputs (h :: path) a dict
                    val oh = Basic.fold (fn s => fn j => S.union s (inputs dict' j)) 
                                         S.empty a
                    val ch = set(cvars h)
                in
                    D.enter((h, S.union ch oh),dict')
                end
    )
and doloop path h dict = 
    let val a = F.G.adj g h
    in if Basic.member a h
       then case Basic.delete h a of
            []  => D.enter((h,all), dict) 
          | [n] => let val dict' = outputs path [n] dict
                   in 
                        D.enter((h,reaches h (onestep h (inputs dict' n))), dict') 
                   end
       else D.enter((h,all), dict) 
     end

val needed = outputs [] [0] D.empty

fun prune j (Block b, c) = 
    let val reqj = S.member (D.lookup needed j)
    in
        (Block (Basic.filter (reqj o #1) b), c)
    end
in
   OF.G.FG(map (fn j => (j, (F.G.adj g j, prune j (F.data g j)))) (F.G.vertices g))
end
end