Section Solver.
Context {A: Type}.
Variable code: PTree.t A.
Variable successors: A -> list positive.
Variable transf: positive -> L.t -> L.t.
Variable entrypoint: positive.
Variable P: L.t -> Prop.
Hypothesis Ptop: P L.top.
Hypothesis Ptransf: forall pc instr x, code!pc = Some instr -> P x -> P (transf pc x).
Definition bbmap := positive -> bool.
Definition result := PMap.t L.t.
(** As in Kildall's solver, the state of the iteration has two components: - A mapping from program points to values of type [L.t] representing the candidate solution found so far. - A worklist of program points that remain to be considered. *)
Record state : Type := mkstate
{ aval: result; worklist: list positive }.
(** The ``extended basic block'' algorithm, in pseudo-code, is as follows: << worklist := the set of all points n having multiple predecessors aval  := the mapping n -> L.top  while worklist is not empty, do extract a node n from worklist compute out = transf n aval[n] for each successor s of n: if s has only one predecessor (namely, n): aval[s] := out worklist := worklist union {s} end if end for end while return aval >> **)
Fixpoint propagate_successors
(bb: bbmap) (succs: list positive) (l: L.t) (st: state)
{struct succs} : state :=
match succs with
| nil => st
| s1 :: sl =>
if bb s1 then
propagate_successors bb sl l st
else
propagate_successors bb sl l
(mkstate (PMap.set s1 l st.(aval))
(s1 :: st.(worklist)))
end.
Definition step (bb: bbmap) (st: state) : result + state :=
match st.(worklist) with
| nil => inl _ st.(aval)
| pc :: rem =>
match code!pc with
| None =>
inr _ (mkstate st.(aval) rem)
| Some instr =>
inr _ (propagate_successors
bb (successors instr)
(transf pc st.(aval)!!pc)
(mkstate st.(aval) rem))
end
end.
(** Recognition of program points that have more than one predecessor. *)
Definition is_basic_block_head
(preds: PTree.t (list positive)) (pc: positive) : bool :=
if peq pc entrypoint then true else
match preds!!!pc with
| nil => false
| s :: nil => peq s pc
| _ :: _ :: _ => true
end.
Definition basic_block_map : bbmap :=
is_basic_block_head (make_predecessors code successors).
Definition basic_block_list (bb: bbmap) : list positive :=
PTree.fold (fun l pc instr => if bb pc then pc :: l else l)
code nil.
(** The computation of the approximate solution. *)
Definition fixpoint : option result :=
let bb := basic_block_map in
PrimIter.iterate _ _ (step bb) (mkstate (PMap.init L.top) (basic_block_list bb)).
(** ** Properties of predecessors and multiple-predecessors nodes *)
Definition predecessors := make_predecessors code successors.
(** ** Correctness invariant *)
(** The invariant over the state is as follows: - Points with several predecessors are mapped to [L.top] - Points not in the worklist satisfy their inequations (as in Kildall's algorithm). *)
Definition state_invariant (st: state) : Prop :=
(forall n, basic_block_map n = true -> st.(aval)!!n = L.top)
/\
(forall n,
In n st.(worklist) \/
(forall instr s, code!n = Some instr -> In s (successors instr) ->
L.ge st.(aval)!!s (transf n st.(aval)!!n))).

Lemma propagate_successors_invariant:
forall pc instr res rem,
code!pc = Some instr ->
state_invariant (mkstate res (pc :: rem)) ->
state_invariant
(propagate_successors basic_block_map (successors instr)
(transf pc res!!pc)
(mkstate res rem)).