Module Sort := Mergesort.Sort(PositiveOrd).
(** The traversal is presented as an iteration that modifies the following state. *)
Record state : Type := mkstate {
gr: graph;                    (**r current graph, without already-visited nodes *)
wrk: list (node * list node); (**r worklist *)
map: PTree.t positive;        (**r current mapping node -> postorder number *)
next: positive                (**r number to use for next numbering *)
}.
Definition init_state (g: graph) (root: node) :=
match g!root with
| Some succs =>
{| gr := PTree.remove root g;
wrk := (root, Sort.sort succs) :: nil;
map := PTree.empty positive;
next := 1%positive |}
| None =>
{| gr := g;
wrk := nil;
map := PTree.empty positive;
next := 1%positive |}
end.
Definition transition (s: state) : PTree.t positive + state :=
match s.(wrk) with
| nil =>                              (**r empty worklist, we are done *)
inl _ s.(map)
| (x, nil) :: l =>                    (**r all successors of [x] are numbered; number [x] itself *)
inr _ {| gr := s.(gr);
wrk := l;
map := PTree.set x s.(next) s.(map);
next := Pos.succ s.(next) |}
| (x, y :: succs_x) :: l =>           (**r consider [y], the next unnumbered successor of [x] *)
match s.(gr)!y with
| None =>                         (**r [y] is already numbered: discard from worklist *)
inr _ {| gr := s.(gr);
wrk := (x, succs_x) :: l;
map := s.(map);
next := s.(next) |}
| Some succs_y =>                 (**r push [y] on the worklist *)
inr _ {| gr := PTree.remove y s.(gr);
wrk := (y, Sort.sort succs_y) :: (x, succs_x) :: l;
map := s.(map);
next := s.(next) |}
end
end.
Section POSTORDER.
Variable ginit: graph.
Variable root: node.
Inductive invariant (s: state) : Prop :=
Invariant
(* current graph is a subset of ginit *)
(SUB: forall x y, s.(gr)!x = Some y -> ginit!x = Some y)
(* root is not in current graph *)
(ROOT: s.(gr)!root = None)
(* mapped nodes have their numbers below next *)
(BELOW: forall x y, s.(map)!x = Some y -> Plt y s.(next))
(* mapping is injective *)
(INJ: forall x1 x2 y, s.(map)!x1 = Some y -> s.(map)!x2 = Some y -> x1 = x2)
(* nodes not yet visited have no number *)
(REM: forall x y, s.(gr)!x = Some y -> s.(map)!x = None)
(* black nodes have no white son *)
(COLOR: forall x succs n y,
ginit!x = Some succs -> s.(map)!x = Some n ->
In y succs -> s.(gr)!y = None)
(* worklist is well-formed *)
(WKLIST: forall x l, In (x, l) s.(wrk) ->
s.(gr)!x = None /\
exists l', ginit!x = Some l'
/\ forall y, In y l' -> ~In y l -> s.(gr)!y = None)
(* all grey nodes are on the worklist *)
(GREY: forall x, ginit!x <> None -> s.(gr)!x = None -> s.(map)!x = None ->
exists l, In (x,l) s.(wrk)).
Inductive postcondition (map: PTree.t positive) : Prop :=
Postcondition
(INJ: forall x1 x2 y, map!x1 = Some y -> map!x2 = Some y -> x1 = x2)
(ROOT: ginit!root <> None -> map!root <> None)
(SUCCS: forall x succs y, ginit!x = Some succs -> map!x <> None -> In y succs -> ginit!y <> None -> map!y <> None).
Remark In_sort:
forall x l, In x l <-> In x (Sort.sort l).

(* Specifications: *)
Lemma transition_spec:
forall s, invariant s ->
match transition s with inr s' => invariant s' | inl m => postcondition m end.
Lemma initial_state_spec:
invariant (init_state ginit root).