End REACHABLE.
(** We now define a generic solver for forward dataflow inequations that works over any semi-lattice structure. *)
Module Dataflow_Solver (LAT: SEMILATTICE) (NS: NODE_SET) <:
DATAFLOW_SOLVER with Module L := LAT.
Module L := LAT.
Section Kildall.
Context {A: Type}.
Variable code: PTree.t A.
Variable successors: A -> list positive.
Variable transf: positive -> L.t -> L.t.
(** The state of the iteration has three components: - [aval]: A mapping from program points to values of type [L.t] representing the candidate solution found so far. - [worklist]: A worklist of program points that remain to be considered. - [visited]: A set of program points that were visited already (i.e. put on the worklist at some point in the past).  Only the first two components are computationally relevant.  The third is a ghost variable used only for stating and proving invariants. For this reason, [visited] is defined at sort [Prop] so that it is erased during program extraction. *)
Record state : Type :=
mkstate { aval: PTree.t L.t; worklist: NS.t; visited: positive -> Prop }.
Definition abstr_value (n: positive) (s: state) : L.t :=
match s.(aval)!n with
| None => L.bot
| Some v => v
end.
(** Kildall's algorithm, in pseudo-code, is as follows: << while worklist is not empty, do extract a node n from worklist compute out = transf n aval[n] for each successor s of n: compute in = lub aval[s] out if in <> aval[s]: aval[s] := in worklist := worklist union {s} visited := visited union {s} end if end for end while return aval >> *)
(** [propagate_succ] corresponds, in the pseudocode, to the body of the [for] loop iterating over all successors. *)
Definition propagate_succ (s: state) (out: L.t) (n: positive) :=
match s.(aval)!n with
| None =>
{| aval := PTree.set n out s.(aval);
worklist := NS.add n s.(worklist);
visited := fun p => p = n \/ s.(visited) p |}
| Some oldl =>
let newl := L.lub oldl out in
if L.beq oldl newl
then s
else {| aval := PTree.set n newl s.(aval);
worklist := NS.add n s.(worklist);
visited := fun p => p = n \/ s.(visited) p |}
end.
(** [propagate_succ_list] corresponds, in the pseudocode, to the [for] loop iterating over all successors. *)
Fixpoint propagate_succ_list (s: state) (out: L.t) (succs: list positive)
{struct succs} : state :=
match succs with
| nil => s
| n :: rem => propagate_succ_list (propagate_succ s out n) out rem
end.
(** [step] corresponds to the body of the outer [while] loop in the pseudocode. *)
Definition step (s: state) : PMap.t L.t + state :=
match NS.pick s.(worklist) with
| None =>
inl _ (L.bot, s.(aval))
| Some(n, rem) =>
match code!n with
| None =>
inr _ {| aval := s.(aval); worklist := rem; visited := s.(visited) |}
| Some instr =>
inr _ (propagate_succ_list
{| aval := s.(aval); worklist := rem; visited := s.(visited) |}
(transf n (abstr_value n s))
(successors instr))
end
end.
(** The whole fixpoint computation is the iteration of [step] from an initial state. *)
Definition fixpoint_from (start: state) : option (PMap.t L.t) :=
PrimIter.iterate _ _ step start.
(** There are several ways to build the initial state.  For forward dataflow analyses, the initial worklist is the function entry point, and the initial mapping sets the function entry point to the given abstract value, and leaves unset all other program points, which corresponds to [L.bot] initial abstract values. *)
Definition start_state (enode: positive) (eval: L.t) :=
{| aval := PTree.set enode eval (PTree.empty L.t);
worklist := NS.add enode NS.empty;
visited := fun n => n = enode |}.
Definition fixpoint (enode: positive) (eval: L.t) :=
fixpoint_from (start_state enode eval).
(** For backward analyses (viewed as forward analyses on the reversed CFG), the following two variants are more useful.  Both start with an empty initial mapping, where all program points start at [L.bot]. The first initializes the worklist with a given set of entry points in the reversed CFG.  (See the backward dataflow solver below for how this list is computed.)  The second start state construction initializes the worklist with all program points of the given CFG. *)
Definition start_state_nodeset (enodes: NS.t) :=
{| aval := PTree.empty L.t;
worklist := enodes;
visited := fun n => NS.In n enodes |}.
Definition fixpoint_nodeset (enodes: NS.t) :=
fixpoint_from (start_state_nodeset enodes).
Definition start_state_allnodes :=
{| aval := PTree.empty L.t;
worklist := NS.all_nodes code;
visited := fun n => exists instr, code!n = Some instr |}.
Definition fixpoint_allnodes :=
fixpoint_from start_state_allnodes.
(** ** Characterization of the propagation functions *)
Inductive optge: option L.t -> option L.t -> Prop :=
| optge_some: forall l l',
L.ge l l' -> optge (Some l) (Some l')
| optge_none: forall ol,
optge ol None.
Remark optge_refl: forall ol, optge ol ol.
Remark optge_abstr_value:
forall st st' n,
optge st.(aval)!n st'.(aval)!n ->
L.ge (abstr_value n st) (abstr_value n st').

(* Specifications: *)
Lemma propagate_succ_charact:
forall st out n,
let st' := propagate_succ st out n in
optge st'.(aval)!n (Some out)
/\ (forall s, n <> s -> st'.(aval)!s = st.(aval)!s)
/\ (forall s, optge st'.(aval)!s st.(aval)!s)
/\ (NS.In n st'.(worklist) \/ st'.(aval)!n = st.(aval)!n)
/\ (forall n', NS.In n' st.(worklist) -> NS.In n' st'.(worklist))
/\ (forall n', NS.In n' st'.(worklist) -> n' = n \/ NS.In n' st.(worklist))
/\ (forall n', st.(visited) n' -> st'.(visited) n')
/\ (forall n', st'.(visited) n' -> NS.In n' st'.(worklist) \/ st.(visited) n')
/\ (forall n', st.(aval)!n' = None -> st'.(aval)!n' <> None -> st'.(visited) n').
Lemma propagate_succ_list_charact:
forall out l st,
let st' := propagate_succ_list st out l in
(forall n, In n l -> optge st'.(aval)!n (Some out))
/\ (forall n, ~In n l -> st'.(aval)!n = st.(aval)!n)
/\ (forall n, optge st'.(aval)!n st.(aval)!n)
/\ (forall n, NS.In n st'.(worklist) \/ st'.(aval)!n = st.(aval)!n)
/\ (forall n', NS.In n' st.(worklist) -> NS.In n' st'.(worklist))
/\ (forall n', NS.In n' st'.(worklist) -> In n' l \/ NS.In n' st.(worklist))
/\ (forall n', st.(visited) n' -> st'.(visited) n')
/\ (forall n', st'.(visited) n' -> NS.In n' st'.(worklist) \/ st.(visited) n')
/\ (forall n', st.(aval)!n' = None -> st'.(aval)!n' <> None -> st'.(visited) n').