heap contains

examples/DFS/DFS_proof.v

@@ -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.
+
 
 
 (********************************************************************)

examples/DFS/StackDFS_proof.v

@@ -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.