Commit 245cfb14 authored by charguer's avatar charguer

heap contains

parent a2fdd18a
......@@ -8,6 +8,22 @@ Require Import List_proof.
Open Scope tag_scope.
(*************************************************************************)
(* TLC BUFFER *)
Lemma remove_empty : forall A (E: set A),
E \- \{} = E.
Proof. intros. rew_set. intros. rew_set. tauto. Qed.
Lemma remove_all : forall A (E: set A),
E \- E = \{}.
Proof. intros. rew_set. intros. rew_set. tauto. Qed.
(* TODO: "rew_set*" *)
(*************************************************************************)
(** Automation *)
Ltac auto_star ::=
try solve [ subst; intuition eauto with maths ].
......@@ -27,6 +43,7 @@ Lemma heap_contains_intro : forall (H H1 H2 : hprop),
(H1 \c H2).
Proof using. introv M1 M2. hnf. exists H. apply* antisym_pred_incl. Qed.
Lemma heap_contains_elim : forall (H1 H2 : hprop),
(H1 \c H2) -> exists H,
(H2 ==> H1 \* H)
......@@ -35,6 +52,43 @@ Proof using. introv (H&M). exists H. split*. Qed.
Global Opaque heap_contains.
(* Future work:
Lemma heap_contains_intro_hexists_1 : forall A (J:A->hprop) H,
H \c (Hexists x, H \* J x).
Proof using.
intros. applys heap_contains_intro (Hexists x, J x); hsimpl.
Qed.
Lemma heap_contains_intro_hexists_2 : forall A1 A2 (J:A1->A2->hprop) H,
H \c (Hexists x y, H \* J x y).
Proof using.
intros. applys heap_contains_intro (Hexists x1 x2, J x1 x2); hsimpl.
Qed.
Lemma heap_contains_hexists : forall (H1 : hprop) A (J J2:A->hprop),
(forall x, (J x ==> H1 \* J2 x)) ->
(forall x, (H1 \* J2 x ==> J x)) -> (* or just, [forall x, J x = H1 \* J2 x] *)
(H1 \c (Hexists x, J x)).
Proof using.
introv M1 M2. hnf. exists (Hexists x, J2 x). applys antisym_pred_incl.
{ hpull ;=> x. hchanges (M1 x). }
{ hpull ;=> x. hchanges (M2 x). }
Qed.
Lemma heap_contains_hexists2 : forall (H1 : hprop) A1 A2 (J J2:A1->A2->hprop),
(forall x1 x2, (J x1 x2 ==> H1 \* J2 x1 x2)) ->
(forall x1 x2, (H1 \* J2 x1 x2 ==> J x1 x2)) -> (* or just, [forall x, J x = H1 \* J2 x] *)
(H1 \c (Hexists x1 x2, J x1 x2)).
Proof using.
introv M1 M2. hnf. exists (Hexists x1 x2, J2 x1 x2). applys antisym_pred_incl.
{ hpull ;=> x1 x2. hchanges (M1 x1 x2). }
{ hpull ;=> x1 x2. hchanges (M2 x1 x2). }
Qed.
*)
(*
Search noduplicates.
Lemma noduplicates_app_inv : forall A (L1 L2 : list A),
......@@ -356,6 +410,27 @@ Qed.
Hint Extern 1 (RegisterSpec Graph_ml.iter_edges) => Provide iter_edges_spec.
Lemma iter_edges_remaining_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 \u \{j})) (# I E))) ->
app Graph_ml.iter_edges [g i f]
PRE (I (out_edges G i))
POST (# I \{}).
Proof.
intros. xapp_spec~ iter_edges_spec (>> (fun E => I (out_edges G i \- E)) G).
{ introv Hj Hij. xapp~.
{ intro HH. rew_set in HH. tauto. }
{ hsimpl. match goal with |- I ?x ==> I ?y \* _ => asserts_rewrite (x = y) end.
{ rew_set. intro x. rew_set. rew_logic. iff; unpack.
{ tests~: (x = j). }
{ tests~: (x = j). branches; [| now false]. tauto. } }
hsimpl. } }
{ rewrite remove_empty. hsimpl. }
{ rewrite remove_all. hsimpl. }
Qed.
(********************************************************************)
......
......@@ -162,37 +162,9 @@ Proof.
intros i' j ? ?.
forwards~ [M|[M|M]]: inv_true_edges0 i' j.
rew_listx in M. branches; try tauto. subst i'.
right. right. Search out_edges. rewrite~ out_edges_has_edge.
right. right. rewrite~ out_edges_has_edge.
Qed.
Lemma remove_empty : forall A (E: set A),
E \- \{} = E.
Proof. intros. rew_set. intros. rew_set. tauto. Qed.
Lemma remove_all : forall A (E: set A),
E \- E = \{}.
Proof. intros. rew_set. intros. rew_set. tauto. Qed.
Lemma iter_edges_remaining_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 \u \{j})) (# I E))) ->
app Graph_ml.iter_edges [g i f]
PRE (I (out_edges G i))
POST (# I \{}).
Proof.
intros. xapp_spec~ iter_edges_spec (>> (fun E => I (out_edges G i \- E)) G).
{ introv Hj Hij. xapp~.
{ intro HH. rew_set in HH. tauto. }
{ hsimpl. match goal with |- I ?x ==> I ?y \* _ => asserts_rewrite (x = y) end.
{ rew_set. intro x. rew_set. rew_logic. iff; unpack.
{ tests~: (x = j). }
{ tests~: (x = j). branches; [| now false]. tauto. } }
hsimpl. } }
{ rewrite remove_empty. hsimpl. }
{ rewrite remove_all. hsimpl. }
Qed.
Lemma reachable_imperative_spec : forall g G a b,
a \in nodes G ->
......@@ -230,8 +202,9 @@ Proof.
xapp_spec iter_edges_remaining_spec
(>> (fun E => Hexists C2 L2, hinv E C2 L2 \* \[ C2[i] = true ]) G).
{ auto. }
{ unfold hinv. intros. skip.
(* eapply heap_contains_intro. (* evar context issues? *) skip. skip. *) }
{ intros L. unfold hinv. applys heap_contains_intro (Hexists C2 L2,
c ~> Array C2 \* s ~> Stack L2 \*
\[ inv G n a C2 L2 L] \* \[ C2[i] = true]); hsimpl*. }
{ introv N Hij. xpull. intros C2 L2 ?. xapp_spec Sf.
unfold hinv at 1. xpull. intros I'.
xapps. skip.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment