Skip to content

GitLab

C
cfml
Commit 9474d364 authored by charguer's avatar charguer
Browse files
Options

DFS proof fixed

parent bce17edb
Hide whitespace changes
Inline Side-by-side
Showing with 141 additions and 133 deletions
examples/ChunkedSequences/CircularArray.ml
View file @ 9474d364
(** Representation of fixed-size circular buffers. *)
module Make (Capa : CapacitySig.S) (Item : InhabType.S) =
module Make (Capa : CapacitySig.S) (Item : InhabType.S) =
struct
(*--------------------------------------------------------------------------*)
......@@ -24,7 +23,7 @@ type t = {
(** Builds a new queue *)
let create () =
let create () =
{ head = 0;
size = 0;
data = Array.make capacity Item.inhab; }
......@@ -59,15 +58,15 @@ let wrap_down i =
(** 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
q.head <- wrap_up (q.head + 1);
q.size <- q.size - 1;
x
(** Pop an element from the back (assumes non-empty queue) *)
let pop_back q =
let pop_back q =
q.size <- q.size - 1;
let i = wrap_up (q.head + q.size) in
Array.get q.data i
......@@ -92,12 +91,12 @@ let push_back x q =
let debug = false
(** 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. *)
let copy_data_wrap_src t1 i1 t2 i2 n =
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
if j1 <= capacity then begin
Array.blit 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 0 t2 i2' (n - na);
end
(** Internal: copy n elements from an array t1 starting at index i1
and not wrapping around, into an array t2 of size capacity,
starting at index i2 and possibly wrapping around. *)
......@@ -126,7 +125,7 @@ let copy_data_wrap_dst t1 i1 t2 i2 n =
end
(** 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
of size capacity. *)
......@@ -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 *)
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";
let h1 = wrap_down (wrap_up (q1.head + q1.size) - n) in
let h2 = wrap_down (q2.head - n) in
......@@ -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 *)
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";
let h1 = q1.head in
let h2 = wrap_up (q2.head + q2.size) in
......@@ -187,8 +186,8 @@ let transfer_all_to_back q1 q2 =
(** Pop N elements from the front into an array *)
let popn_front_to_array n q =
if n < 0 || n > q.size
let popn_front_to_array n q =
if n < 0 || n > q.size
then invalid_arg "CircularArray.popn_front_to_array";
if n = 0 then [||] else begin
let h = q.head in
......@@ -201,7 +200,7 @@ let popn_front_to_array n q =
(** 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 then [||] else begin
let h = wrap_down (wrap_up (q.head + q.size) - n) in
......@@ -281,7 +280,7 @@ let to_list q =
let cell_at q i =
wrap_up (q.head + i)
let get q i =
let get q i =
q.data.(cell_at q i)
let set q i v =
......
examples/DFS/DFS_proof.v
View file @ 9474d364
Set Implicit Arguments.
Require Import CFLib.
Require Import CFML.CFLib.
Require Import DFS_ml.
Require Import Stdlib.
Require Import LibListZ.
Require Import TLC.LibListZ.
Require Import Array_proof.
Require Import List_proof.
Open Scope tag_scope.
Ltac auto_star ::=
Ltac auto_star ::=
try solve [ subst; intuition eauto with maths ].
......@@ -21,49 +21,51 @@ Definition heap_contains H1 H2 :=
Global Instance incl_inst : BagIncl hprop.
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) ->
(H1 \* H ==> 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,
(H2 ==> H1 \* H)
(H2 ==> H1 \* H)
/\ (H1 \* H ==> H2).
Proof using. introv (H&M). exists H. split*. Qed.
Global Opaque heap_contains.
Lemma No_duplicates_app_inv : forall A (L1 L2 : list A),
No_duplicates (L1 ++ L2) ->
No_duplicates L1
/\ No_duplicates L2
/\ (~ exists x, Mem x L1 /\ Mem x L2).
(*
Search noduplicates.
Lemma noduplicates_app_inv : forall A (L1 L2 : list A),
noduplicates (L1 ++ L2) ->
noduplicates L1
/\ noduplicates L2
/\ (~ exists x, mem x L1 /\ mem x L2).
Proof using.
introv ND. splits.
induction L1.
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.
rew_list~ in ND.
rew_list in ND. inverts~ 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.
Qed.
*)
(*************************************************************************)
(** Set of list predicate : TODO: move *)
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) :=
LibList.fold (@set_of_list_monoid A) (fun x => \{x}) L.
Section SetOfList.
Variables (A:Type).
Implicit Types l : list A.
......@@ -76,7 +78,7 @@ Proof using.
apply union_empty_r.
Qed.
Local Hint Resolve set_of_list_monoid_Monoid.
Lemma set_of_list_nil :
Lemma set_of_list_nil :
set_of_list (@nil A) = \{}.
Proof using. auto. Qed.
Lemma set_of_list_cons : forall x l,
......@@ -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).
Proof using. intros. unfold set_of_list. rewrite~ fold_app. Qed.
Lemma set_of_list_Mem : forall l x,
x \in set_of_list l -> Mem x l.
Lemma set_of_list_mem : forall l x,
x \in set_of_list l -> mem x l.
Proof using.
introv. induction l; introv M.
{ 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.
End SetOfList.
......@@ -137,7 +139,7 @@ Parameter edges_in_nodes : forall (G : graph) x y,
(** 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).
Definition has_edge (G:graph) x y :=
......@@ -146,7 +148,7 @@ Definition has_edge (G:graph) x y :=
Definition path := list (int*int).
Inductive is_path (G:graph) : int -> int -> path -> Prop :=
| is_path_nil : forall x,
| is_path_nil : forall x,
x \in nodes G ->
is_path G x x nil
| is_path_cons : forall x y z p,
......@@ -162,10 +164,10 @@ Definition reachable (G:graph) (i j:int) :=
(********************************************************************)
(* ** 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.
Proof using.
intros. unfold has_edge, out_edges. rewrite~ in_set_st_eq.
Proof using.
intros. unfold has_edge, out_edges. rewrite* in_set_st_eq.
Qed.
Lemma has_edge_nodes : forall (G : graph) x y,
......@@ -185,26 +187,26 @@ Proof using. intros. forwards*: has_edge_nodes. Qed.
Lemma reachable_in_nodes_l : forall (G : graph) x y,
reachable G x y -> x \in nodes G.
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.
Lemma reachable_in_nodes_r : forall (G : graph) x y,
reachable G x y -> y \in nodes G.
Proof using. =>> (p&M). induction* M. Qed.
Lemma reachable_self : forall G i,
Lemma reachable_self : forall G i,
i \in nodes G ->
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,
has_edge G i j ->
has_edge G i j ->
reachable G i j.
Proof using. (* trivial *)
=>> M. exists ((i,j)::nil). constructor~. constructor~.
applys* has_edge_in_nodes_r.
Qed.
Lemma reachable_trans : forall G i j k,
reachable G i j ->
reachable G j k ->
......@@ -213,42 +215,42 @@ Proof using. (* basic induction *)
=>> (p1&M1) (p2&M2). exists (p1++p2).
induction M1; rew_list.
{ auto. }
{ constructor~. }
{ constructor~. }
Qed.
Lemma reachable_trans_edge : forall G i j k,
reachable G i j ->
has_edge G j k ->
has_edge G j k ->
reachable G i k.
Proof using. (* trivial *)
=>> M1 M2. applys* reachable_trans. applys* reachable_edge.
=>> M1 M2. applys* reachable_trans. applys* reachable_edge.
Qed.
(********************************************************************)
(* ** 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. *)
Definition nodes_index (G:graph) (n:int) :=
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
neighbors of node [i] in [G]. *)
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
/\ No_duplicates (N[i]).
/\ noduplicates (N[i]).
(** [g ~> RGraph G] asserts that at pointer [g] is an imperative
array of pure lists that represents the adjacency lists of [G]. *)
Definition RGraph (G:graph) (g:loc) :=
Hexists N, g ~> Array N
\* \[ nodes_index G (LibListZ.length N)
\* \[ nodes_index G (LibListZ.length N)
/\ nodes_edges G N].
......@@ -256,9 +258,9 @@ Definition RGraph (G:graph) (g:loc) :=
(** Basic lemmas about [RGraph] -- TODO: will be generated *)
Lemma RGraph_open : forall (g:loc) (G:graph),
g ~> RGraph G ==>
g ~> RGraph G ==>
Hexists N, g ~> Array N
\* \[nodes_index G (LibListZ.length N)
\* \[nodes_index G (LibListZ.length N)
/\ nodes_edges G N].
Proof using. intros. xunfolds~ RGraph. Qed.
......@@ -266,15 +268,15 @@ Lemma RGraph_close : forall (g:loc) (G:graph) N,
nodes_index G (LibListZ.length N) ->
nodes_edges G N ->
g ~> Array N
==>
==>
g ~> RGraph G.
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.
Hint Extern 1 (RegisterClose (Array _)) =>
Hint Extern 1 (RegisterClose (Array _)) =>
Provide RGraph_close.
......@@ -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 Extern 1 (nodes_index _ _) => congruence.
Hint Extern 1 (index ?n ?x) =>
eapply nodes_index_index;
[ try eassumption
eapply nodes_index_index;
[ try eassumption
| instantiate; try eassumption
| instantiate; try congruence ].
*)
......@@ -317,9 +319,9 @@ Hint Extern 1 (index ?n ?x) =>
Lemma nb_nodes_spec : forall (G:graph) 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]).
Proof using.
Proof using.
xcf. xunfold RGraph. xpull ;=> N (HN1&HN2).
xapp. xsimpl*.
Qed.
......@@ -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,
i \in nodes G ->
(forall L, (g ~> RGraph G) \c (I L)) ->
(forall j E, j \notin E -> has_edge G i j ->
(app f [j] (I E) (# I (\{j} \u E)))) ->
(forall j E, j \notin E -> has_edge G i j ->
(app f [j] (I E) (# I (\{j} \u E)))) ->
app Graph_ml.iter_edges [f g i]
PRE (I \{})
PRE (I \{})
POST (# I (out_edges G i)).
Proof.
introv Gi Ginc Sf. xcf.
forwards (H&HO&HC): heap_contains_elim ((rm Ginc) \{}).
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)).
{ 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 *)
lets (_&_&N3): No_duplicates_app_inv GND. applys (rm N3). (* trivial *)
exists x. forwards*: set_of_list_Mem M. } (* trivial *)
lets (_&_&N3): noduplicates_app_inv GND. applys (rm N3). (* trivial *)
exists x. forwards*: set_of_list_mem M. } (* trivial *)
{ rewrite <- out_edges_has_edge. rewrite <- GNE. rewrite EN. (* trivial *)
rew_set_of_list. eauto. } (* trivial *)
{ xsimpl. }
rew_set_of_list. rew_set; eauto. } (* trivial *)
{ rewrite union_comm. xsimpl. } }
{ rew_set_of_list. xsimpl. }
{ rewrite GNE. xsimpl. }
Qed.
Qed.
Hint Extern 1 (RegisterSpec Graph_ml.iter_edges) => Provide iter_edges_spec.
......@@ -372,9 +374,9 @@ Definition all_black_in E C :=
Definition no_gray C :=
forall i, index C i -> C[i] <> Gray.
Definition no_black_to_white G C :=
forall i j,
has_edge G i j ->
Definition no_black_to_white G C :=
forall i j,
has_edge G i j ->
C[i] = Black ->
C[j] <> White.
......@@ -385,12 +387,12 @@ Definition inv G R C :=
(nodes_index G (length C))
/\ (no_black_to_white G C)
/\ (forall j, j \in nodes G -> C[j] = Black -> reachable_from G R j).
(* TODO: above, might need to maintain that [R \c nodes G]
in order to prove facts of the form [r \in nodes G] *)
(* TODO: above, might need to maintain that [R \c nodes G]
in order to prove facts of the form [r \in nodes G] *)
Definition hinv G R C g c :=
g ~> RGraph G
g ~> RGraph G
\* c ~> Array C
\* \[ inv G R C ].
......@@ -400,8 +402,8 @@ Definition hinv G R C g c :=
Lemma evolution_refl : refl evolution.
Proof using. (* trivial *)
=> C. splits*.
Qed.
=> C. splits*.
Qed.
Lemma evolution_trans : trans evolution.
Proof using. (* trivial *)
......@@ -419,17 +421,17 @@ Proof using. (* trivial *)
=>> (E1&E2) Ci HN. split.
{ => j Hj Ej. rew_array~. case_if~.
{ apply~ E1. rew_array~. case_if~. } }
{ => j Hj. rew_array~. case_if.
{ rename j into i. iff; auto_false. }
{ => j Hj. rew_array~. case_if.
{ subst. rename j into i. iff; auto_false. }
{ rewrite~ <- E2. rew_array~. case_if*. } }
Qed.
Qed.
Lemma no_white_in_evolution : forall C C' E,
no_white_in E C ->
evolution C C' ->
no_white_in E C'.
Proof using. (* trivial *)
=>> N (H1&H2) i Hi. cases (C[i]) as Ci.
=>> N (H1&H2) i Hi. cases (C[i]) as Ci.
{ false* N. }
{ forwards~ (H2a&_): H2 i. rewrite~ H2a. auto_false. }
rewrite~ H1. auto_false.
......@@ -440,8 +442,8 @@ Lemma no_gray_evolution : forall C C',
evolution C C' ->
no_gray C'.
Proof using. (* trivial *)
=>> N (H1&H2) i Hi Ci. forwards~ (_&HR): H2 i. applys~ N i.
Qed.
=>> N (H1&H2) i Hi Ci. forwards~ (_&HR): H2 i. applys~ N i.
Qed.
Lemma no_black_to_white_no_gray_elim : forall G C i j,
no_black_to_white G C ->
......@@ -449,8 +451,8 @@ Lemma no_black_to_white_no_gray_elim : forall G C i j,
reachable G i j ->
C[i] = Black ->
C[j] = Black.
Proof using.
=>> HW HG (p&HP). induction HP; => Ci.
Proof using.
=>> HW HG (p&HP). induction HP; => Ci.
(* trivial after induction *)
{ auto. }
{ applys IHHP. cases (C[y]).
......@@ -464,9 +466,9 @@ Lemma inv_empty : forall G n,
inv G \{} (make n White).
Proof using. (* trivial *)
=>> Hn. splits.
{ hnf in Hn. rew_arr*. }
{ =>> Hi Ci. false. rew_arr~ in Ci. false. }
{ => i Hi Ci. false. rew_arr~ in Ci. false. }
{ hnf in Hn. rew_array*. auto. (* TODO: fix tactic *) }
{ =>> Hi Ci. false. rew_array~ in Ci. false. }
{ => i Hi Ci. false. rew_array~ in Ci. false. }
Qed.
Lemma inv_add_root : forall G L C i,
......@@ -476,7 +478,8 @@ Proof using. (* trivial *)
=>> (I1&I2&I3). splits.
{ auto. }
{ auto. }
{ => j Hj Cj. forwards~ (r&Hr&Pr): I3 j. exists* r. }
{ => j Hj Cj. forwards~ (r&Hr&Pr): I3 j.
exists* r. splits*. rew_set. eauto. (* TODO: tactic *) }
Qed.
Lemma inv_gray_root : forall G R C i,
......@@ -486,10 +489,10 @@ Lemma inv_gray_root : forall G R C i,
inv G R (C[i := Gray]).
Proof using. (* trivial *)
=>> Ci Hi (I1&I2&I3). splits.
{ rew_arr~. }
{ rew_array~. }
{ => j k Hjk. rew_array~. => Cjk. case_if; auto_false.
case_if. applys* I2. }
{ => j Hj. rew_array~. case_if; auto_false. }
case_if. applys* I2. }
{ => j Hj. rew_array~. case_if; auto_false. }
Qed.
Lemma inv_evolution_black : forall G R C' i,
......@@ -499,12 +502,12 @@ Lemma inv_evolution_black : forall G R C' i,
inv G R (C'[i := Black]).
Proof using. (* trivial *)
=>> (I1&I2&I3) Ri Wi. splits.
{ rew_arr~. }
{ => j k Hjk. rew_array~. => M. case_if; auto_false. case_if.
{ applys Wi. rewrite~ out_edges_has_edge. }
{ rew_array~. }
{ => j k Hjk. rew_array~. => M. case_if; auto_false. case_if.
{ subst. applys Wi. rewrite~ out_edges_has_edge. }
{ applys* I2. } }
{ => j Hj. rew_array~. case_if; [|auto].
=> _. rename j into i. eauto. }
{ => j Hj. rew_array~. case_if; [subst|auto].
=> _. rename j into i. eauto. }
Qed.
......@@ -515,7 +518,7 @@ Lemma dfs_from_spec : forall G R C g c i,
reachable_from G R i ->
C[i] = White ->
app dfs_from [g c i]
PRE (hinv G R C g c)
PRE (hinv G R C g c)
POST (# Hexists C', hinv G R C' g c
\* \[ evolution C C' /\ C'[i] = Black ]).
Proof using.
......@@ -524,34 +527,34 @@ Proof using.
asserts Hi: (i \in nodes G).
{ destruct Ri as (r&Hr&Mr). applys* reachable_in_nodes_r. } (* trivial *)
xcf. unfold hinv. xpull ;=> HI. xapps~. sets_eq C1: (C0[i:=Gray]).
xfun as f. set (loop_inv := fun L C => hinv G R C g c
xfun as f. set (loop_inv := fun L C => hinv G R C g c
\* \[ evolution C1 C /\ no_white_in L C ]).
xseq. xapp_no_simpl (>> (fun L => Hexists C, loop_inv L C) G).
{ auto. }
{ => L. unfold loop_inv, hinv. applys heap_contains_intro
(Hexists C, c ~> Array C \* \[ inv G R C] \* (* ideally, should be computed *)
\[ evolution C1 C /\ no_white_in L C]); xsimpl~. }
{ => j js Hj Eij. unfold loop_inv, hinv.
{ => j js Hj Eij. unfold loop_inv, hinv.
xpull ;=> C I0 (H1&H2). xapp. clears f.
xapps~. xapps~. xpolymorphic_eq.
xapps~. xapps~. xpolymorphic_eq.
xpost (Hexists C', hinv G R C' g c
\* \[ evolution C1 C' /\ no_white_in js C' /\ C'[j] <> White ]).
{ xif.
{ show IH. xapply (>> IH G R C).
{ show IH. xapply (>> IH G R C).
{ destruct Ri as (r&Pr&Mr). exists r. split~. (* trivial *)
applys* reachable_trans_edge. } (* trivial *)
{ auto. } (* trivial *)
{ auto. } (* trivial *)
{ unfold hinv. xsimpl~. }
unfold hinv. xpull ;=> C' I1 (F1&F2). xsimpl. splits.
unfold hinv. xpull ;=> C' I1 (F1&F2). xsimpl. splits.
{ applys* evolution_trans. }
{ applys* no_white_in_evolution. } (* trivial *)
{ auto_false. } (* trivial *)
{ auto. } } (* trivial *)
{ applys* no_white_in_evolution. } (* trivial *)
{ auto_false. } (* trivial *)
{ auto. } } (* trivial *)
{ xret. unfold hinv. xsimpl~. } }
{ unfold hinv. xpull ;=> C' I1 (F1&F2&F3). xsimpl. splits.
{ auto. } (* trivial *)
{ => k Hk. set_in Hk; auto. } (* trivial *)
{ auto. } } } (* trivial *)
{ auto. } (* trivial *)
{ => k Hk. rew_set in Hk. destruct~ Hk. subst~. } (* trivial *)
{ auto. } } } (* trivial *)
{ clears f. unfold loop_inv, hinv. xsimpl. split.
{ applys evolution_refl. }
{ => j Hj. rew_array~. } (* trivial *)
......@@ -559,25 +562,25 @@ Proof using.
{ unfold loop_inv, hinv. xpull ;=> C' I1 (F1&F2).
xapps~. xsimpl. split.
{ subst C1. applys* evolution_write_black. }
{ rew_arr~. } (* trivial *)