Commit 9474d364 authored by charguer's avatar charguer

DFS proof fixed

parent bce17edb
(** Representation of fixed-size circular buffers. *) (** Representation of fixed-size circular buffers. *)
module Make (Capa : CapacitySig.S) (Item : InhabType.S) = module Make (Capa : CapacitySig.S) (Item : InhabType.S) =
struct struct
(*--------------------------------------------------------------------------*) (*--------------------------------------------------------------------------*)
...@@ -24,7 +23,7 @@ type t = { ...@@ -24,7 +23,7 @@ type t = {
(** Builds a new queue *) (** Builds a new queue *)
let create () = let create () =
{ head = 0; { head = 0;
size = 0; size = 0;
data = Array.make capacity Item.inhab; } data = Array.make capacity Item.inhab; }
...@@ -59,15 +58,15 @@ let wrap_down i = ...@@ -59,15 +58,15 @@ let wrap_down i =
(** Pop an element from the front (assumes non-empty queue) *) (** Pop an element from the front (assumes non-empty queue) *)
let pop_front q = let pop_front q =
let x = Array.get q.data q.head in let x = Array.get q.data q.head in
q.head <- wrap_up (q.head + 1); q.head <- wrap_up (q.head + 1);
q.size <- q.size - 1; q.size <- q.size - 1;
x x
(** Pop an element from the back (assumes non-empty queue) *) (** Pop an element from the back (assumes non-empty queue) *)
let pop_back q = let pop_back q =
q.size <- q.size - 1; q.size <- q.size - 1;
let i = wrap_up (q.head + q.size) in let i = wrap_up (q.head + q.size) in
Array.get q.data i Array.get q.data i
...@@ -92,12 +91,12 @@ let push_back x q = ...@@ -92,12 +91,12 @@ let push_back x q =
let debug = false let debug = false
(** Internal: copy n elements from an array t1 of size capacity, (** Internal: copy n elements from an array t1 of size capacity,
starting at index i1 and possibly wrapping around, into an starting at index i1 and possibly wrapping around, into an
array t2 starting at index i2 and not wrapping around. *) array t2 starting at index i2 and not wrapping around. *)
let copy_data_wrap_src t1 i1 t2 i2 n = let copy_data_wrap_src t1 i1 t2 i2 n =
if (debug && (i1 < 0 || i1 > capacity || i2 < 0 || i2 + n > capacity || n < 0)) if (debug && (i1 < 0 || i1 > capacity || i2 < 0 || i2 + n > capacity || n < 0))
then failwith (Printf.sprintf "copy_data_wrap_src error: %d %d %d" i1 i2 n); then failwith (Printf.sprintf "copy_data_wrap_src error: %d %d %d" i1 i2 n);
let j1 = i1 + n in let j1 = i1 + n in
if j1 <= capacity then begin if j1 <= capacity then begin
Array.blit t1 i1 t2 i2 n Array.blit t1 i1 t2 i2 n
...@@ -107,7 +106,7 @@ let copy_data_wrap_src t1 i1 t2 i2 n = ...@@ -107,7 +106,7 @@ let copy_data_wrap_src t1 i1 t2 i2 n =
Array.blit t1 i1 t2 i2 na; Array.blit t1 i1 t2 i2 na;
Array.blit t1 0 t2 i2' (n - na); Array.blit t1 0 t2 i2' (n - na);
end end
(** Internal: copy n elements from an array t1 starting at index i1 (** Internal: copy n elements from an array t1 starting at index i1
and not wrapping around, into an array t2 of size capacity, and not wrapping around, into an array t2 of size capacity,
starting at index i2 and possibly wrapping around. *) starting at index i2 and possibly wrapping around. *)
...@@ -126,7 +125,7 @@ let copy_data_wrap_dst t1 i1 t2 i2 n = ...@@ -126,7 +125,7 @@ let copy_data_wrap_dst t1 i1 t2 i2 n =
end end
(** Internal: copy n elements from an array t1 starting at index i1 (** Internal: copy n elements from an array t1 starting at index i1
and possibly wrapping around, into an array t2 starting at index and possibly wrapping around, into an array t2 starting at index
i2 and possibly wrapping around. Both arrays are assumed to be i2 and possibly wrapping around. Both arrays are assumed to be
of size capacity. *) of size capacity. *)
...@@ -149,7 +148,7 @@ let copy_data_wrap_src_and_dst t1 i1 t2 i2 n = ...@@ -149,7 +148,7 @@ let copy_data_wrap_src_and_dst t1 i1 t2 i2 n =
(** Transfer N items from the back of a buffer to the front of another buffer *) (** Transfer N items from the back of a buffer to the front of another buffer *)
let transfer_back_to_front n q1 q2 = let transfer_back_to_front n q1 q2 =
if n < 0 || n > q1.size || n + q2.size > capacity if n < 0 || n > q1.size || n + q2.size > capacity
then invalid_arg "CircularArray.transfer_back_to_front"; then invalid_arg "CircularArray.transfer_back_to_front";
let h1 = wrap_down (wrap_up (q1.head + q1.size) - n) in let h1 = wrap_down (wrap_up (q1.head + q1.size) - n) in
let h2 = wrap_down (q2.head - n) in let h2 = wrap_down (q2.head - n) in
...@@ -161,7 +160,7 @@ let transfer_back_to_front n q1 q2 = ...@@ -161,7 +160,7 @@ let transfer_back_to_front n q1 q2 =
(** Transfer N items from the front of a buffer to the back of another buffer *) (** Transfer N items from the front of a buffer to the back of another buffer *)
let transfer_front_to_back n q1 q2 = let transfer_front_to_back n q1 q2 =
if n < 0 || n > q1.size || n + q2.size > capacity if n < 0 || n > q1.size || n + q2.size > capacity
then invalid_arg "CircularArray.transfer_front_to_back"; then invalid_arg "CircularArray.transfer_front_to_back";
let h1 = q1.head in let h1 = q1.head in
let h2 = wrap_up (q2.head + q2.size) in let h2 = wrap_up (q2.head + q2.size) in
...@@ -187,8 +186,8 @@ let transfer_all_to_back q1 q2 = ...@@ -187,8 +186,8 @@ let transfer_all_to_back q1 q2 =
(** Pop N elements from the front into an array *) (** Pop N elements from the front into an array *)
let popn_front_to_array n q = let popn_front_to_array n q =
if n < 0 || n > q.size if n < 0 || n > q.size
then invalid_arg "CircularArray.popn_front_to_array"; then invalid_arg "CircularArray.popn_front_to_array";
if n = 0 then [||] else begin if n = 0 then [||] else begin
let h = q.head in let h = q.head in
...@@ -201,7 +200,7 @@ let popn_front_to_array n q = ...@@ -201,7 +200,7 @@ let popn_front_to_array n q =
(** Pop N elements from the back into an array *) (** Pop N elements from the back into an array *)
let popn_back_to_array n q = let popn_back_to_array n q =
if n < 0 || n > q.size then invalid_arg "CircularArray.popn_back_to_array"; if n < 0 || n > q.size then invalid_arg "CircularArray.popn_back_to_array";
if n = 0 then [||] else begin if n = 0 then [||] else begin
let h = wrap_down (wrap_up (q.head + q.size) - n) in let h = wrap_down (wrap_up (q.head + q.size) - n) in
...@@ -281,7 +280,7 @@ let to_list q = ...@@ -281,7 +280,7 @@ let to_list q =
let cell_at q i = let cell_at q i =
wrap_up (q.head + i) wrap_up (q.head + i)
let get q i = let get q i =
q.data.(cell_at q i) q.data.(cell_at q i)
let set q i v = let set q i v =
......
Set Implicit Arguments. Set Implicit Arguments.
Require Import CFLib. Require Import CFML.CFLib.
Require Import DFS_ml. Require Import DFS_ml.
Require Import Stdlib. Require Import Stdlib.
Require Import LibListZ. Require Import TLC.LibListZ.
Require Import Array_proof. Require Import Array_proof.
Require Import List_proof. Require Import List_proof.
Open Scope tag_scope. Open Scope tag_scope.
Ltac auto_star ::= Ltac auto_star ::=
try solve [ subst; intuition eauto with maths ]. try solve [ subst; intuition eauto with maths ].
...@@ -21,49 +21,51 @@ Definition heap_contains H1 H2 := ...@@ -21,49 +21,51 @@ Definition heap_contains H1 H2 :=
Global Instance incl_inst : BagIncl hprop. Global Instance incl_inst : BagIncl hprop.
Proof. constructor. applys heap_contains. Defined. Proof. constructor. applys heap_contains. Defined.
Lemma heap_contains_intro : forall (H H1 H2 : hprop), Lemma heap_contains_intro : forall (H H1 H2 : hprop),
(H2 ==> H1 \* H) -> (H2 ==> H1 \* H) ->
(H1 \* H ==> H2) -> (H1 \* H ==> H2) ->
(H1 \c H2). (H1 \c H2).
Proof using. introv M1 M2. hnf. exists H. apply* pred_le_extens. Qed. Proof using. introv M1 M2. hnf. exists H. apply* antisym_pred_incl. Qed.
Lemma heap_contains_elim : forall (H1 H2 : hprop), Lemma heap_contains_elim : forall (H1 H2 : hprop),
(H1 \c H2) -> exists H, (H1 \c H2) -> exists H,
(H2 ==> H1 \* H) (H2 ==> H1 \* H)
/\ (H1 \* H ==> H2). /\ (H1 \* H ==> H2).
Proof using. introv (H&M). exists H. split*. Qed. Proof using. introv (H&M). exists H. split*. Qed.
Global Opaque heap_contains. Global Opaque heap_contains.
Lemma No_duplicates_app_inv : forall A (L1 L2 : list A), (*
No_duplicates (L1 ++ L2) -> Search noduplicates.
No_duplicates L1 Lemma noduplicates_app_inv : forall A (L1 L2 : list A),
/\ No_duplicates L2 noduplicates (L1 ++ L2) ->
/\ (~ exists x, Mem x L1 /\ Mem x L2). noduplicates L1
/\ noduplicates L2
/\ (~ exists x, mem x L1 /\ mem x L2).
Proof using. Proof using.
introv ND. splits. introv ND. splits.
induction L1. induction L1.
constructors. constructors.
rew_list in ND. inverts ND as ND1 ND2. rewrite Mem_app_or_eq in ND1. rew_logic* in ND1. rew_list in ND. inverts ND as ND1 ND2. rewrite mem_app_or_eq in ND1. rew_logic* in ND1.
induction L1. induction L1.
rew_list~ in ND. rew_list~ in ND.
rew_list in ND. inverts~ ND. rew_list in ND. inverts~ ND.
introv (x&I1&I2). induction I1; rew_list in ND. introv (x&I1&I2). induction I1; rew_list in ND.
inverts ND as ND1 ND2. false ND1. apply* Mem_app_or. inverts ND as ND1 ND2. false ND1. apply* mem_app_or.
apply IHI1. inverts~ ND. apply IHI1. inverts~ ND.
Qed. Qed.
*)
(*************************************************************************) (*************************************************************************)
(** Set of list predicate : TODO: move *) (** Set of list predicate : TODO: move *)
Definition set_of_list_monoid A := Definition set_of_list_monoid A :=
(monoid_ (union : _ -> _ -> set A) (\{}:set A)). (monoid_make (union : _ -> _ -> set A) (\{}:set A)).
Definition set_of_list A (L : list A) := Definition set_of_list A (L : list A) :=
LibList.fold (@set_of_list_monoid A) (fun x => \{x}) L. LibList.fold (@set_of_list_monoid A) (fun x => \{x}) L.
Section SetOfList. Section SetOfList.
Variables (A:Type). Variables (A:Type).
Implicit Types l : list A. Implicit Types l : list A.
...@@ -76,7 +78,7 @@ Proof using. ...@@ -76,7 +78,7 @@ Proof using.
apply union_empty_r. apply union_empty_r.
Qed. Qed.
Local Hint Resolve set_of_list_monoid_Monoid. Local Hint Resolve set_of_list_monoid_Monoid.
Lemma set_of_list_nil : Lemma set_of_list_nil :
set_of_list (@nil A) = \{}. set_of_list (@nil A) = \{}.
Proof using. auto. Qed. Proof using. auto. Qed.
Lemma set_of_list_cons : forall x l, Lemma set_of_list_cons : forall x l,
...@@ -89,12 +91,12 @@ Lemma set_of_list_app : forall l1 l2, ...@@ -89,12 +91,12 @@ Lemma set_of_list_app : forall l1 l2,
set_of_list (l1 ++ l2) = (set_of_list l1) \u (set_of_list l2). set_of_list (l1 ++ l2) = (set_of_list l1) \u (set_of_list l2).
Proof using. intros. unfold set_of_list. rewrite~ fold_app. Qed. Proof using. intros. unfold set_of_list. rewrite~ fold_app. Qed.
Lemma set_of_list_Mem : forall l x, Lemma set_of_list_mem : forall l x,
x \in set_of_list l -> Mem x l. x \in set_of_list l -> mem x l.
Proof using. Proof using.
introv. induction l; introv M. introv. induction l; introv M.
{ false. } { false. }
{ rewrite set_of_list_cons in M. set_in M; eauto. } { rewrite set_of_list_cons in M. rew_set in M. destruct* M. }
Qed. Qed.
End SetOfList. End SetOfList.
...@@ -137,7 +139,7 @@ Parameter edges_in_nodes : forall (G : graph) x y, ...@@ -137,7 +139,7 @@ Parameter edges_in_nodes : forall (G : graph) x y,
(** Derived definition for working with graphs *) (** Derived definition for working with graphs *)
Definition out_edges G i := Definition out_edges G i :=
set_st (fun j => (i,j) \in edges G). set_st (fun j => (i,j) \in edges G).
Definition has_edge (G:graph) x y := Definition has_edge (G:graph) x y :=
...@@ -146,7 +148,7 @@ Definition has_edge (G:graph) x y := ...@@ -146,7 +148,7 @@ Definition has_edge (G:graph) x y :=
Definition path := list (int*int). Definition path := list (int*int).
Inductive is_path (G:graph) : int -> int -> path -> Prop := Inductive is_path (G:graph) : int -> int -> path -> Prop :=
| is_path_nil : forall x, | is_path_nil : forall x,
x \in nodes G -> x \in nodes G ->
is_path G x x nil is_path G x x nil
| is_path_cons : forall x y z p, | is_path_cons : forall x y z p,
...@@ -162,10 +164,10 @@ Definition reachable (G:graph) (i j:int) := ...@@ -162,10 +164,10 @@ Definition reachable (G:graph) (i j:int) :=
(********************************************************************) (********************************************************************)
(* ** Basic well-formedness facts on graphs *) (* ** Basic well-formedness facts on graphs *)
Lemma out_edges_has_edge : forall G i j, Lemma out_edges_has_edge : forall G i j,
j \in out_edges G i <-> has_edge G i j. j \in out_edges G i <-> has_edge G i j.
Proof using. Proof using.
intros. unfold has_edge, out_edges. rewrite~ in_set_st_eq. intros. unfold has_edge, out_edges. rewrite* in_set_st_eq.
Qed. Qed.
Lemma has_edge_nodes : forall (G : graph) x y, Lemma has_edge_nodes : forall (G : graph) x y,
...@@ -185,26 +187,26 @@ Proof using. intros. forwards*: has_edge_nodes. Qed. ...@@ -185,26 +187,26 @@ Proof using. intros. forwards*: has_edge_nodes. Qed.
Lemma reachable_in_nodes_l : forall (G : graph) x y, Lemma reachable_in_nodes_l : forall (G : graph) x y,
reachable G x y -> x \in nodes G. reachable G x y -> x \in nodes G.
Proof using. Proof using.
=>> (p&M). destruct M. auto. applys* has_edge_in_nodes_l. =>> (p&M). destruct M. auto. applys* has_edge_in_nodes_l.
Qed. Qed.
Lemma reachable_in_nodes_r : forall (G : graph) x y, Lemma reachable_in_nodes_r : forall (G : graph) x y,
reachable G x y -> y \in nodes G. reachable G x y -> y \in nodes G.
Proof using. =>> (p&M). induction* M. Qed. Proof using. =>> (p&M). induction* M. Qed.
Lemma reachable_self : forall G i, Lemma reachable_self : forall G i,
i \in nodes G -> i \in nodes G ->
reachable G i i. reachable G i i.
Proof using. intros. exists (nil:path). constructor~. Qed. Proof using. intros. exists (nil:path). constructor~. Qed.
Lemma reachable_edge : forall G i j, Lemma reachable_edge : forall G i j,
has_edge G i j -> has_edge G i j ->
reachable G i j. reachable G i j.
Proof using. (* trivial *) Proof using. (* trivial *)
=>> M. exists ((i,j)::nil). constructor~. constructor~. =>> M. exists ((i,j)::nil). constructor~. constructor~.
applys* has_edge_in_nodes_r. applys* has_edge_in_nodes_r.
Qed. Qed.
Lemma reachable_trans : forall G i j k, Lemma reachable_trans : forall G i j k,
reachable G i j -> reachable G i j ->
reachable G j k -> reachable G j k ->
...@@ -213,42 +215,42 @@ Proof using. (* basic induction *) ...@@ -213,42 +215,42 @@ Proof using. (* basic induction *)
=>> (p1&M1) (p2&M2). exists (p1++p2). =>> (p1&M1) (p2&M2). exists (p1++p2).
induction M1; rew_list. induction M1; rew_list.
{ auto. } { auto. }
{ constructor~. } { constructor~. }
Qed. Qed.
Lemma reachable_trans_edge : forall G i j k, Lemma reachable_trans_edge : forall G i j k,
reachable G i j -> reachable G i j ->
has_edge G j k -> has_edge G j k ->
reachable G i k. reachable G i k.
Proof using. (* trivial *) Proof using. (* trivial *)
=>> M1 M2. applys* reachable_trans. applys* reachable_edge. =>> M1 M2. applys* reachable_trans. applys* reachable_edge.
Qed. Qed.
(********************************************************************) (********************************************************************)
(* ** Graph representation predicate in Separation Logic: [g ~> RGraph G]*) (* ** Graph representation predicate in Separation Logic: [g ~> RGraph G]*)
(** [nodes_index G n] asserts that the nodes in [G] are indexed (** [nodes_index G n] asserts that the nodes in [G] are indexed
from [0] inclusive to [n] exclusive. *) from [0] inclusive to [n] exclusive. *)
Definition nodes_index (G:graph) (n:int) := Definition nodes_index (G:graph) (n:int) :=
n >= 0 /\ (forall i, i \in nodes G <-> index n i). n >= 0 /\ (forall i, i \in nodes G <-> index n i).
(** [nodes_edges G N] asserts that [N] describes the adjacency (** [nodes_edges G N] asserts that [N] describes the adjacency
lists of [G], in the sense that [N[i]] gives the list of lists of [G], in the sense that [N[i]] gives the list of
neighbors of node [i] in [G]. *) neighbors of node [i] in [G]. *)
Definition nodes_edges (G:graph) (N:list(list int)) := Definition nodes_edges (G:graph) (N:list(list int)) :=
forall i, i \in nodes G -> forall i, i \in nodes G ->
set_of_list (N[i]) = out_edges G i set_of_list (N[i]) = out_edges G i
/\ No_duplicates (N[i]). /\ noduplicates (N[i]).
(** [g ~> RGraph G] asserts that at pointer [g] is an imperative (** [g ~> RGraph G] asserts that at pointer [g] is an imperative
array of pure lists that represents the adjacency lists of [G]. *) array of pure lists that represents the adjacency lists of [G]. *)
Definition RGraph (G:graph) (g:loc) := Definition RGraph (G:graph) (g:loc) :=
Hexists N, g ~> Array N Hexists N, g ~> Array N
\* \[ nodes_index G (LibListZ.length N) \* \[ nodes_index G (LibListZ.length N)
/\ nodes_edges G N]. /\ nodes_edges G N].
...@@ -256,9 +258,9 @@ Definition RGraph (G:graph) (g:loc) := ...@@ -256,9 +258,9 @@ Definition RGraph (G:graph) (g:loc) :=
(** Basic lemmas about [RGraph] -- TODO: will be generated *) (** Basic lemmas about [RGraph] -- TODO: will be generated *)
Lemma RGraph_open : forall (g:loc) (G:graph), Lemma RGraph_open : forall (g:loc) (G:graph),
g ~> RGraph G ==> g ~> RGraph G ==>
Hexists N, g ~> Array N Hexists N, g ~> Array N
\* \[nodes_index G (LibListZ.length N) \* \[nodes_index G (LibListZ.length N)
/\ nodes_edges G N]. /\ nodes_edges G N].
Proof using. intros. xunfolds~ RGraph. Qed. Proof using. intros. xunfolds~ RGraph. Qed.
...@@ -266,15 +268,15 @@ Lemma RGraph_close : forall (g:loc) (G:graph) N, ...@@ -266,15 +268,15 @@ Lemma RGraph_close : forall (g:loc) (G:graph) N,
nodes_index G (LibListZ.length N) -> nodes_index G (LibListZ.length N) ->
nodes_edges G N -> nodes_edges G N ->
g ~> Array N g ~> Array N
==> ==>
g ~> RGraph G. g ~> RGraph G.
Proof using. intros. xunfolds~ RGraph. Qed. Proof using. intros. xunfolds~ RGraph. Qed.
Implicit Arguments RGraph_close []. Arguments RGraph_close : clear implicits.
Hint Extern 1 (RegisterOpen (RGraph _)) => Hint Extern 1 (RegisterOpen (RGraph _)) =>
Provide RGraph_open. Provide RGraph_open.
Hint Extern 1 (RegisterClose (Array _)) => Hint Extern 1 (RegisterClose (Array _)) =>
Provide RGraph_close. Provide RGraph_close.
...@@ -304,8 +306,8 @@ Hint Resolve @index_array_length_eq @index_make @index_update. ...@@ -304,8 +306,8 @@ Hint Resolve @index_array_length_eq @index_make @index_update.
Hint Immediate has_edge_in_nodes_l has_edge_in_nodes_r. Hint Immediate has_edge_in_nodes_l has_edge_in_nodes_r.
Hint Extern 1 (nodes_index _ _) => congruence. Hint Extern 1 (nodes_index _ _) => congruence.
Hint Extern 1 (index ?n ?x) => Hint Extern 1 (index ?n ?x) =>
eapply nodes_index_index; eapply nodes_index_index;
[ try eassumption [ try eassumption
| instantiate; try eassumption | instantiate; try eassumption
| instantiate; try congruence ]. | instantiate; try congruence ].
*) *)
...@@ -317,9 +319,9 @@ Hint Extern 1 (index ?n ?x) => ...@@ -317,9 +319,9 @@ Hint Extern 1 (index ?n ?x) =>
Lemma nb_nodes_spec : forall (G:graph) g, Lemma nb_nodes_spec : forall (G:graph) g,
app Graph_ml.nb_nodes [g] app Graph_ml.nb_nodes [g]
PRE (g ~> RGraph G) PRE (g ~> RGraph G)
POST (fun n => g ~> RGraph G \* \[nodes_index G n]). POST (fun n => g ~> RGraph G \* \[nodes_index G n]).
Proof using. Proof using.
xcf. xunfold RGraph. xpull ;=> N (HN1&HN2). xcf. xunfold RGraph. xpull ;=> N (HN1&HN2).
xapp. xsimpl*. xapp. xsimpl*.
Qed. Qed.
...@@ -329,28 +331,28 @@ Hint Extern 1 (RegisterSpec Graph_ml.nb_nodes) => Provide nb_nodes_spec. ...@@ -329,28 +331,28 @@ Hint Extern 1 (RegisterSpec Graph_ml.nb_nodes) => Provide nb_nodes_spec.
Lemma iter_edges_spec : forall (I:set int->hprop) (G:graph) g f i, Lemma iter_edges_spec : forall (I:set int->hprop) (G:graph) g f i,
i \in nodes G -> i \in nodes G ->
(forall L, (g ~> RGraph G) \c (I L)) -> (forall L, (g ~> RGraph G) \c (I L)) ->
(forall j E, j \notin E -> has_edge G i j -> (forall j E, j \notin E -> has_edge G i j ->
(app f [j] (I E) (# I (\{j} \u E)))) -> (app f [j] (I E) (# I (\{j} \u E)))) ->
app Graph_ml.iter_edges [f g i] app Graph_ml.iter_edges [f g i]
PRE (I \{}) PRE (I \{})
POST (# I (out_edges G i)). POST (# I (out_edges G i)).
Proof. Proof.
introv Gi Ginc Sf. xcf. introv Gi Ginc Sf. xcf.
forwards (H&HO&HC): heap_contains_elim ((rm Ginc) \{}). forwards (H&HO&HC): heap_contains_elim ((rm Ginc) \{}).
xchange (rm HO). xopen g. xpull ;=> N (GI&GN). xchange (rm HO). xopen g. xpull ;=> N (GI&GN).
forwards (GNE&GND): GN Gi. xapps~. xclose* g. xchange (rm HC). forwards (GNE&GND): GN Gi. xapps~. xclose* g. xchange (rm HC).
xfun. xapp_no_simpl (fun (L:list int) => I (set_of_list L)). xfun. xapp_no_simpl (fun (L:list int) => I (set_of_list L)).
{ introv EN. rewrite set_of_list_last. xapp. xapp. { introv EN. rewrite set_of_list_last. xapp.
xapp_spec Sf. (* TODO: xapp *)
{ intros M. rewrite EN in GND. (* trivial *) { intros M. rewrite EN in GND. (* trivial *)
lets (_&_&N3): No_duplicates_app_inv GND. applys (rm N3). (* trivial *) lets (_&_&N3): noduplicates_app_inv GND. applys (rm N3). (* trivial *)
exists x. forwards*: set_of_list_Mem M. } (* trivial *) exists x. forwards*: set_of_list_mem M. } (* trivial *)
{ rewrite <- out_edges_has_edge. rewrite <- GNE. rewrite EN. (* trivial *) { rewrite <- out_edges_has_edge. rewrite <- GNE. rewrite EN. (* trivial *)
rew_set_of_list. eauto. } (* trivial *) rew_set_of_list. rew_set; eauto. } (* trivial *)
{ xsimpl. }
{ rewrite union_comm. xsimpl. } } { rewrite union_comm. xsimpl. } }
{ rew_set_of_list. xsimpl. } { rew_set_of_list. xsimpl. }
{ rewrite GNE. xsimpl. } { rewrite GNE. xsimpl. }
Qed. Qed.
Hint Extern 1 (RegisterSpec Graph_ml.iter_edges) => Provide iter_edges_spec. Hint Extern 1 (RegisterSpec Graph_ml.iter_edges) => Provide iter_edges_spec.