Commit 87e1c36f authored by charguer's avatar charguer

xwhile

parent 5546d871
xwhile: error reporting when arguments don't have the right types.
notation "# H" uniquement lorsque H est au type hprop.
rename xextract to xpull; and xgen to xpush.
todo: model K/E -> list V
comparable_type A || comparable_value x || comparable_value y
x = y : A
comparable_value x || comparable_value y
x = y : A
forall x : int, comparable_value x
mettre trop de let pour les fonctions builtin;
xuntag_goal. => dans xcf.
CFPrint.tag
app_def
infix_eq_
assume
......@@ -7,6 +38,8 @@ MAJOR TODAY
- loops
- for downto
MAJOR NEXT
- record with
......
......@@ -2546,13 +2546,13 @@ Tactic Notation "xfor_inv" constr(I) :=
(************************************************************)
(* ** [xfocus] *)
(* ** [xopen] *)
(* e.g.
Hint Extern 1 (Register focus (Tree _)) =>
Provide tree_focus_contents.
then [xfocus t] or [xfocus t as I1 I2]
then [xopen t] or [xopen t as I1 I2]
*)
......@@ -2567,79 +2567,79 @@ Ltac get_refocus_args tt :=
Ltac get_refocus_constr_in H t :=
match H with context [ t ~> ?T ] => constr:(T) end.
Ltac xfocus_constr t :=
Ltac xopen_constr t :=
match get_refocus_args tt with (?H1,?H2) =>
get_refocus_constr_in H1 t end.
Ltac xfocus_core t :=
let C1 := xfocus_constr t in
Ltac xopen_core t :=
let C1 := xopen_constr t in
ltac_database_get database_spec_focus C1;
let K := fresh "TEMP" in
intros K; xchange (K t); clear K.
Ltac xfocus_show t :=
let C1 := xfocus_constr t in
Ltac xopen_show t :=
let C1 := xopen_constr t in
pose C1; try ltac_database_get database_spec_focus C1; intros.
Tactic Notation "xfocus" constr(t) :=
xfocus_core t.
Tactic Notation "xfocus" "~" constr(t) :=
xfocus t; auto_tilde.
Tactic Notation "xfocus" "*" constr(t) :=
xfocus t; auto_star.
Tactic Notation "xfocus" constr(t) "as" simple_intropattern(I1) :=
xfocus t; xextract as I1.
Tactic Notation "xfocus" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2) :=
xfocus t; xextract as I1 I2.
Tactic Notation "xfocus" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
Tactic Notation "xopen" constr(t) :=
xopen_core t.
Tactic Notation "xopen" "~" constr(t) :=
xopen t; auto_tilde.
Tactic Notation "xopen" "*" constr(t) :=
xopen t; auto_star.
Tactic Notation "xopen" constr(t) "as" simple_intropattern(I1) :=
xopen t; xextract as I1.
Tactic Notation "xopen" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2) :=
xopen t; xextract as I1 I2.
Tactic Notation "xopen" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) :=
xfocus t; xextract as I1 I2 I3.
Tactic Notation "xfocus" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
xopen t; xextract as I1 I2 I3.
Tactic Notation "xopen" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) :=
xfocus t; xextract as I1 I2 I3 I4.
Tactic Notation "xfocus" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
xopen t; xextract as I1 I2 I3 I4.
Tactic Notation "xopen" constr(t) "as" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) :=
xfocus t; xextract as I1 I2 I3 I4 I5.
xopen t; xextract as I1 I2 I3 I4 I5.
(************************************************************)
(* ** [xunfocus] *)
(* ** [xclose] *)
(** e.g.
Hint Extern 1 (Register unfocus (Ref Id (MNode _ _ _))) =>
Provide tree_node_unfocus.
then [xunfocus t] or [xunfocus t1 t2 t3]
then [xclose t] or [xclose t1 t2 t3]
*)
Ltac xunfocus_constr t :=
Ltac xclose_constr t :=
match get_refocus_args tt with (?H1,?H2) =>
get_refocus_constr_in H1 t end.
Ltac xunfocus_core t :=
let C1 := xunfocus_constr t in
Ltac xclose_core t :=
let C1 := xclose_constr t in
ltac_database_get database_spec_unfocus C1;
let K := fresh "TEMP" in
intros K; xchange (K t); clear K.
Ltac xunfocus_show t :=
let C1 := xunfocus_constr t in
Ltac xclose_show t :=
let C1 := xclose_constr t in
pose C1; try ltac_database_get database_spec_unfocus C1; intros.
Tactic Notation "xunfocus" constr(t) :=
xunfocus_core t.
Tactic Notation "xunfocus" "~" constr(t) :=
xunfocus t; auto_tilde.
Tactic Notation "xunfocus" "*" constr(t) :=
xunfocus t; auto_star.
Tactic Notation "xunfocus" constr(t1) constr(t2) :=
xunfocus t1; xunfocus t2.
Tactic Notation "xunfocus" constr(t1) constr(t2) constr(t3) :=
xunfocus t1; xunfocus t2 t3.
Tactic Notation "xunfocus" constr(t1) constr(t2) constr(t3) constr(t4) :=
xunfocus t1; xunfocus t2 t3 t4.
Tactic Notation "xclose" constr(t) :=
xclose_core t.
Tactic Notation "xclose" "~" constr(t) :=
xclose t; auto_tilde.
Tactic Notation "xclose" "*" constr(t) :=
xclose t; auto_star.
Tactic Notation "xclose" constr(t1) constr(t2) :=
xclose t1; xclose t2.
Tactic Notation "xclose" constr(t1) constr(t2) constr(t3) :=
xclose t1; xclose t2 t3.
Tactic Notation "xclose" constr(t1) constr(t2) constr(t3) constr(t4) :=
xclose t1; xclose t2 t3 t4.
......
......@@ -131,12 +131,12 @@ Hint Resolve tree_sub_wf : wf.
(***--------------------------------------------------------***)
Hint Extern 1 (Register focus (Tree _)) => Provide tree_focus.
Hint Extern 1 (Register unfocus (Ref Id (MNode _ _ _))) => Provide tree_node_unfocus.
Hint Extern 1 (Register unfocus (Ref Id MLeaf)) => Provide tree_leaf_unfocus.
Hint Extern 1 (Register xopen (Tree _)) => Provide tree_focus.
Hint Extern 1 (Register xclose (Ref Id (MNode _ _ _))) => Provide tree_node_unfocus.
Hint Extern 1 (Register xclose (Ref Id MLeaf)) => Provide tree_leaf_unfocus.
Hint Extern 1 (Register focus (Stree _)) => Provide Stree_focus.
Hint Extern 1 (Register unfocus (Tree _)) => Provide Stree_unfocus.
Hint Extern 1 (Register xopen (Stree _)) => Provide Stree_focus.
Hint Extern 1 (Register xclose (Tree _)) => Provide Stree_unfocus.
Hint Constructors stree.
......@@ -154,12 +154,12 @@ Lemma fill_root_spec :
(fun (_:unit) => Hexists T', \[stree T' (E \- \{x})] \* t ~> Tree T').
Proof using.
xinduction_heap tree_sub. xcf. intros t T IH T1 x T2 E IE ET.
xfocus t as v. xapps. xmatch.
xopen t as v. xapps. xmatch.
xextract as ET'. xfail. false.
xextract as T1' T2' EQ. inverts EQ. xfocus t2 as v2.
xextract as T1' T2' EQ. inverts EQ. xopen t2 as v2.
xapps. xmatch.
xextract as ET2'. subst. xfocus t1 as v1. xapps. xapps.
intros _. xextract. xunfocus t1. xsimpl.
xextract as ET2'. subst. xopen t1 as v1. xapps. xapps.
intros _. xextract. xclose t1. xsimpl.
Qed.
......@@ -171,15 +171,15 @@ Lemma delete_spec_ind :
(fun (_:unit) => Hexists T', \[stree T' (E \- \{x})] \* t ~> Tree T').
Proof using.
xinduction_heap tree_sub. xcf. intros x t T IH E IE.
xfocus t. xextract as v. xapps. xmatch.
xextract as HT. subst. inverts IE. xret. xunfocus t. xsimpl*. skip. (* todo *)
xopen t. xextract as v. xapps. xmatch.
xextract as HT. subst. inverts IE. xret. xclose t. xsimpl*. skip. (* todo *)
xextract as T1 T2 HT. subst T. inverts IE as IE1 IE2 F1 F2 EQ.
xif. xapps*. xextract as T' HT'. xunfocus t. xsimpl*.
xif. xapps*. xextract as T' HT'. xclose t. xsimpl*.
constructors~. skip. subst E. skip. (* mk no x in E2,y *)
xif. xapps*. xextract as T' HT'. xunfocus t. xsimpl*.
xif. xapps*. xextract as T' HT'. xclose t. xsimpl*.
constructors~. skip. subst E. skip. (* mk no x in E1,y *)
asserts Exy: (x = y). math.
xapps. xunfocus t.
xapps. xclose t.
xsimpl*.
Qed.
......@@ -190,12 +190,12 @@ Lemma delete_spec :
(fun (_:unit) => t ~> Stree (E \- \{x})).
Proof using.
xcf. intros.
xfocus t. xextract as T HT1. xfocus t as v. xapps. xmatch.
{ xret. xextracts. xunfocus t. xunfocus* t. xsimpl. inverts~ HT1. skip. (* todo *) }
xopen t. xextract as T HT1. xopen t as v. xapps. xmatch.
{ xret. xextracts. xclose t. xclose* t. xsimpl. inverts~ HT1. skip. (* todo *) }
{ xextract as T1 T2 ET. xif.
{ xapps.
xret. xextract as T1 T2 ET. subst T. xunfocus t. xunfocus* t. xsimpl.
xret. xextract as T1 T2 ET. subst T. xclose t. xclose* t. xsimpl.
inverts HT1. subst. skip. (* todo *) }
Qed.
......@@ -232,9 +232,9 @@ Lemma is_empty_spec :
(fun (b:bool) => t ~> Stree E \* \[b = isTrue(E = \{})]).
Proof using.
xcf. intros.
xfocus t. xextract as T HT1. xfocus t as v. xapps. xmatch.
{ xret. xextracts. xunfocus t. xunfocus* t. xsimpl. inverts~ HT1. }
{ xret. xextract as T1 T2 ET. subst T. xunfocus t. xunfocus* t. xsimpl.
xopen t. xextract as T HT1. xopen t as v. xapps. xmatch.
{ xret. xextracts. xclose t. xclose* t. xsimpl. inverts~ HT1. }
{ xret. xextract as T1 T2 ET. subst T. xclose t. xclose* t. xsimpl.
inverts HT1. subst. skip. (* todo *) }
Qed.
......@@ -251,13 +251,13 @@ Lemma add_spec_ind :
(fun (_:unit) => Hexists T', \[stree T' (E \u \{x})] \* t ~> Tree T').
Proof using.
xinduction_heap (tree_sub). xcf. intros x t T IH E IE.
xfocus t. xextract as v. xapps. xmatch.
xopen t. xextract as v. xapps. xmatch.
xextract as HT. subst. inverts IE. xapp as t1. xapp as t2. xapps.
intros _. xunfocus t1 t2 t. xsimpl*.
intros _. xclose t1 t2 t. xsimpl*.
xextract as T1 T2 HT. subst T. inverts IE as IE1 IE2 F1 F2 EQ.
xif. xapps*. xextract as T' HT'. xunfocus t. xsimpl*.
xif. xapps*. xextract as T' HT'. xunfocus t. xsimpl*.
xret. xunfocus t. asserts_rewrite (x = y). math. xsimpl*.
xif. xapps*. xextract as T' HT'. xclose t. xsimpl*.
xif. xapps*. xextract as T' HT'. xclose t. xsimpl*.
xret. xclose t. asserts_rewrite (x = y). math. xsimpl*.
Qed.
Lemma add_spec :
......@@ -267,8 +267,8 @@ Lemma add_spec :
(fun (_:unit) => t ~> Stree (E \u \{x})).
Proof using.
xweaken add_spec_ind. simpl. intros x t R HR S1 E.
xfocus t as T1 HT1. xapply* S1. xsimpl. xextract as T' HT'.
xunfocus* t. xsimpl*.
xopen t as T1 HT1. xapply* S1. xsimpl. xextract as T' HT'.
xclose* t. xsimpl*.
Qed.
......@@ -282,22 +282,22 @@ Lemma search_spec_ind :
(fun b => \[b = isTrue (x \in E)] \* t ~> Tree T).
Proof using.
xinduction_heap (tree_sub). xcf. intros x t T IH E IE.
xfocus t. xextract as v. xapps. xmatch.
xextract as HT. subst. inverts IE. xret. xunfocus t.
xopen t. xextract as v. xapps. xmatch.
xextract as HT. subst. inverts IE. xret. xclose t.
xsimpl. applys* @notin_empty. typeclass.
xextract as T1 T2 HT. subst. inverts IE as IE1 IE2 F1 F2 EQ.
xif. xapps*. intros b.
xextracts. xunfocus t. xsimpl. subst E. iff M.
xextracts. xclose t. xsimpl. subst E. iff M.
eauto.
set_in M. math. auto. false* foreach_gt_notin F2.
xif. xapps*. intros b.
xextracts. xunfocus t. xsimpl. subst E. iff M.
xextracts. xclose t. xsimpl. subst E. iff M.
(* too slow: auto / in_union_get. *)
rewrite <- for_set_union_empty_r.
repeat rewrite <- for_set_union_assoc.
apply in_union_get_3. assumption.
set_in M. math. false* foreach_lt_notin F1. math. auto.
xret. xunfocus t. xsimpl. asserts_rewrite (x = y). math. subst E. auto.
xret. xclose t. xsimpl. asserts_rewrite (x = y). math. subst E. auto.
Qed.
......@@ -308,9 +308,9 @@ Lemma search_spec :
(fun b => \[b = isTrue (x \in E)] \* t ~> Stree E).
Proof using.
xweaken search_spec_ind. simpl. intros x t R HR S1 E.
xfocus t. xextract as T1 HT1.
xopen t. xextract as T1 HT1.
xapply* S1. hsimpl. intros b. xextract as Hb.
xunfocus* t. xsimpl*.
xclose* t. xsimpl*.
Qed.
......
......@@ -8,6 +8,23 @@ open Pervasives
*)
(*--TODO
let f () =
let r : '_a ref = ref [] in
!r
let f () =
let r : int ref = ref [] in
!r
let f () : 'a list =
let r : 'a ref = ref [] in
!r
*)
(********************************************************************)
(* ** Return *)
......@@ -255,6 +272,7 @@ let let_poly_nil_pair_heterogeneous () =
let x : ('a list * int list) = ([], []) in x
(********************************************************************)
(* ** Type annotations *)
......@@ -484,15 +502,22 @@ let while_false () =
(********************************************************************)
(* ** For loops *)
let for_incr () =
let for_to_incr r =
let n = ref 0 in
for i = 1 to 10 do
for i = 0 to pred r do
incr n;
done;
!n
(* "for .. down to" not yet supported *)
(*
let for_downto r =
let n = ref 0 in
for i = pred r downto 0 do
incr n;
done;
!n
*)
(********************************************************************)
(* ** Recursive function *)
......@@ -592,7 +617,7 @@ type typerecb1 = | Typerecb_1 of typerecb2
--> the work around is to break circularity using polymorphism, e.g.:
*)
type 'a typerecb2 = { typerecb_2 : 'a }
type 'a typerecb2 = { mutable typerecb_2 : 'a }
type typerecb1 = | Typerecb_1 of typerecb1 typerecb2
(*----*)
......@@ -600,12 +625,12 @@ type typerecb1 = | Typerecb_1 of typerecb1 typerecb2
(* Circularity between mutable records and inductive is broken
through the indirection at type loc *)
type 'a typerecd1 = { typerecd1_f : 'a typerecd2 }
type 'a typerecd1 = { mutable typerecd1_f : 'a typerecd2 }
and 'a typerecd2 =
| Typerecd_2a
| Typerecd_2b of 'a typerecd1
| Typerecd_2c of 'a typerecd3
and 'a typerecd3 = { typerecd3_f : 'a typerecd2 }
and 'a typerecd3 = { mutable typerecd3_f : 'a typerecd2 }
......
This diff is collapsed.
......@@ -211,16 +211,16 @@ Proof using. intros. hunfold Heap. hsimpl*. Qed.
Opaque Tree Heap.
Hint Extern 1 (Register focus (Tree _)) => Provide Tree_focus.
Hint Extern 1 (Register unfocus (Ref Id _)) => Provide Tree_unfocus.
Hint Extern 1 (Register unfocus (Ref Id (MNode _ _ _))) => Provide Tree_node_unfocus.
Hint Extern 1 (Register unfocus (Ref Id MEmpty)) => Provide Tree_empty_unfocus.
Hint Extern 1 (Register xopen (Tree _)) => Provide Tree_focus.
Hint Extern 1 (Register xclose (Ref Id _)) => Provide Tree_unfocus.
Hint Extern 1 (Register xclose (Ref Id (MNode _ _ _))) => Provide Tree_node_unfocus.
Hint Extern 1 (Register xclose (Ref Id MEmpty)) => Provide Tree_empty_unfocus.
Hint Extern 1 (Register focus (Heap _)) => Provide Heap_focus.
Hint Extern 1 (Register unfocus (Tree _)) => Provide Heap_unfocus.
Hint Extern 1 (Register xopen (Heap _)) => Provide Heap_focus.
Hint Extern 1 (Register xclose (Tree _)) => Provide Heap_unfocus.
Hint Extern 1 (Register focus (Contents _)) => Provide Contents_focus.
Hint Extern 1 (Register unfocus (Contents _)) => Provide Contents_unfocus.
Hint Extern 1 (Register xopen (Contents _)) => Provide Contents_focus.
Hint Extern 1 (Register xclose (Contents _)) => Provide Contents_unfocus.
(** useful facts *)
......@@ -245,7 +245,7 @@ Qed.
Lemma empty_spec : Spec empty () |R>>
R \[] (fun h => h ~> Heap \{}).
Proof using. xcf. xapp. intros h. xunfocus2~ h. Qed.
Proof using. xcf. xapp. intros h. xclose2~ h. Qed.
Hint Extern 1 (RegisterSpec empty) => Provide empty_spec.
......@@ -253,9 +253,9 @@ Lemma is_empty_spec : Spec is_empty h |R>>
forall E,
keep R (h ~> Heap E) (fun b => \[b = isTrue (E = \{})]).
Proof using.
xcf. intros. xfocus h as T IT. xfocus h as v. xapps~. xmatch; xret.
xunfocus MEmpty. xextracts. inverts IT. xunfocus2~ h. xsimpl~.
xunfocus v. destruct v; tryfalse. xextract. intros. subst. xunfocus2~ h.
xcf. intros. xopen h as T IT. xopen h as v. xapps~. xmatch; xret.
xclose MEmpty. xextracts. inverts IT. xclose2~ h. xsimpl~.
xclose v. destruct v; tryfalse. xextract. intros. subst. xclose2~ h.
xsimpl*. inverts IT.
{ (* todo automate*)
introv EQ. asserts~ M:(t0 \in \{t0:t} \u El \u Er).
......@@ -271,30 +271,30 @@ Lemma merge_spec_ind : Spec merge h1 h2 |R>>
h1 ~> Tree T \* h2 ~~> v \* \[inv T (E1 \u E2)]).
Proof using.
xinduction_skip.
xcf. introv I1 I2. xfocus h1 as v1. xfocus h2 as v2. xapps~. xapps~. xmatch.
{ xret. xunfocus h1. xunfocus MEmpty. xextracts. inverts I2.
xcf. introv I1 I2. xopen h1 as v1. xopen h2 as v2. xapps~. xapps~. xmatch.
{ xret. xclose h1. xclose MEmpty. xextracts. inverts I2.
xsimpl. rewrite~ union_empty_r. }
{ xapps. xapps. xunfocus h1. xunfocus MEmpty. xextracts. inverts I1.
{ xapps. xapps. xclose h1. xclose MEmpty. xextracts. inverts I1.
xsimpl. rewrite~ union_empty_l. }
{ xapp as n. introv HC. xif; case_if*.
{ (* todo : simplify by going directly to decomposition *)
xunfocus (MNode l1 x1 r1). xextract as T1l T1r EQ1. subst T1.
xclose (MNode l1 x1 r1). xextract as T1l T1r EQ1. subst T1.
inverts I1 as I1l I1r I1h.
xunfocus (MNode l2 x2 r2). xextract as T2l T2r EQ2. subst T2.
xclose (MNode l2 x2 r2). xextract as T2l T2r EQ2. subst T2.
asserts M: (foreach (is_ge x1) E2).
inverts I2 as I2l I2r I2h. rew_foreach in *. repeat splits; autos*.
xunfocus h2.
xapp~. xextract as T3 v I3. xunfocus h1. xsimpl. constructors~.
xclose h2.
xapp~. xextract as T3 v I3. xclose h1. xsimpl. constructors~.
rew_foreach in *. destruct I1h. repeat split; autos*.
permut_simpl. }
{ applys_to HC gt_to_ge. rewrite ge_as_sle in HC.
xunfocus (MNode l2 x2 r2). xextract as T2l T2r EQ2. subst T2.
xclose (MNode l2 x2 r2). xextract as T2l T2r EQ2. subst T2.
inverts I2 as I2l I2r I2h.
xunfocus (MNode l1 x1 r1). xextract as T1l T1r EQ1. subst T1.
xclose (MNode l1 x1 r1). xextract as T1l T1r EQ1. subst T1.
asserts M: (foreach (is_ge x2) E1).
inverts I1 as I1l I1r I1h. rew_foreach in *. repeat splits; autos*.
xunfocus h1.
xapp~. intros T3 v I3. xapps. xapps. xunfocus h1. xsimpl. constructors~.
xclose h1.
xapp~. intros T3 v I3. xapps. xapps. xclose h1. xsimpl. constructors~.
rew_foreach in *. destruct I2h. repeat split; autos*.
permut_simpl. }
}
......@@ -305,9 +305,9 @@ Lemma merge_spec : Spec merge h1 h2 |R>>
R (h1 ~> Heap E1 \* h2 ~> Heap E2) (fun (_:unit) => h1 ~> Heap (E1 \u E2)).
Proof using.
xweaken merge_spec_ind. simpl. intros h1 h2. introv LR HR. intros.
xfocus h1 as T1 I1. xfocus h2 as T2 I2.
xopen h1 as T1 I1. xopen h2 as T2 I2.
forwards~ M: (HR T1 T2). xgc. xapply* (>> HR T1 T2).
xsimpl. xextract. intros. xunfocus~ h1. xsimpl~.
xsimpl. xextract. intros. xclose~ h1. xsimpl~.
Qed.
Hint Extern 1 (RegisterSpec merge) => Provide merge_spec.
......@@ -317,7 +317,7 @@ Lemma Tree_node_Heaps_unfocus : forall (t:loc) x t1 t2 E1 E2,
(t ~~> MNode t1 x t2) \* (t1 ~> Heap E1) \* (t2 ~> Heap E2) ==>
(t ~> Heap (\{x} \u E1 \u E2)).
Proof using.
introv Hx. xfocus t1 as T1 I1. xfocus t2 as T2 I2. xunfocus2~ t0. xsimpl~.
introv Hx. xopen t1 as T1 I1. xopen t2 as T2 I2. xclose2~ t0. xsimpl~.
Qed.
Lemma insert_spec : Spec insert (x:t) (h:heap) |R>>
......@@ -338,12 +338,12 @@ Lemma pop_min_spec : Spec pop_min h |R>>
\* \[min_of E x /\ removed_min E E']).
Proof using.
hint min_of_prove.
xcf. introv N. xfocus h as T IT. xfocus h as v. xapps. xmatch.
xunfocus MEmpty. xextracts. xfail. inverts* IT.
xunfocus (MNode a x b). xextract as T1 T2 EQ. subst.
xcf. introv N. xopen h as T IT. xopen h as v. xapps. xmatch.
xclose MEmpty. xextracts. xfail. inverts* IT.
xclose (MNode a x b). xextract as T1 T2 EQ. subst.
inverts IT as ITa ITb ITc. xapp_spec~ merge_spec_ind.
intros t3 T3 I3. xfocus a as v. xapps. xapps. xret.
xunfocus2~ h. xsimpl. splits~. esplit. splits*.
intros t3 T3 I3. xopen a as v. xapps. xapps. xret.
xclose2~ h. xsimpl. splits~. esplit. splits*.
Qed.
Hint Extern 1 (RegisterSpec pop_min) => Provide pop_min_spec.
......
......@@ -174,17 +174,17 @@ Opaque Tree Mset.
(*--------------------------------------------------------*)
Hint Extern 1 (Register focus (Tree _)) =>
Hint Extern 1 (Register xopen (Tree _)) =>
Provide Tree_focus.
Hint Extern 1 (Register unfocus (Ref Id (MNode _ _ _))) =>
Hint Extern 1 (Register xclose (Ref Id (MNode _ _ _))) =>
Provide Tree_mnode_unfocus.
Hint Extern 1 (Register unfocus (Ref Id MLeaf)) =>
Hint Extern 1 (Register xclose (Ref Id MLeaf)) =>
Provide Tree_mleaf_unfocus.
Hint Extern 1 (Register focus (Contents _)) =>
Hint Extern 1 (Register xopen (Contents _)) =>
Provide Contents_value_focus.
Hint Extern 1 (Register unfocus (Tree _)) =>
Hint Extern 1 (Register xclose (Tree _)) =>
Provide Mset_unfocus.
Hint Extern 1 (Register focus (Mset _)) =>
Hint Extern 1 (Register xopen (Mset _)) =>
Provide Mset_focus.
Hint Constructors stree.
......@@ -214,8 +214,8 @@ Hint Resolve tree_sub_wf : wf.
- [xapp], [xapps], [xif], [xret], [xsimpl]
- [math], [inverts as H1 .. HN], [subst], [assert (H)]
- [xextract], or [xextract as x1 .. xN], to do the intros
- [xfocus t], or [xfocus t as v], to do the intros
- [xunfocus t]
- [xopen t], or [xopen t as v], to do the intros
- [xclose t]
- add [~] to the tactic for [eauto]
- add [*] to the tactic for [intuition eauto with sets]
*)
......@@ -229,10 +229,10 @@ Lemma insert_spec_ind_exercise :
Proof using.
(* xcf. intros x t T E IE. *)
xinduction_heap (tree_sub). xcf. intros x t T IH E IE.
xfocus t as v. xfocus v. xapps. xmatch_clean.
xopen t as v. xopen v. xapps. xmatch_clean.
{ xextract as HT. subst. inverts IE.
xapp as t1. xapp as t2. xapps.
intros _. xunfocus t1 t2 t. xsimpl*.
intros _. xclose t1 t2 t. xsimpl*.
(* details:
constructors. eauto. eauto. eauto. eauto.
intuition eauto with set. (* auto_star. *)
......@@ -254,18 +254,18 @@ Lemma search_spec_ind :
Proof using.
xinduction_heap (tree_sub). xcf.
intros x t T IH E IE.
xfocus t as v. xfocus v. xapps. xmatch_clean.
{ xextract as HT. subst. inverts IE. xret. xunfocus t.
xopen t as v. xopen v. xapps. xmatch_clean.
{ xextract as HT. subst. inverts IE. xret. xclose t.
xsimpl. applys* @notin_empty. typeclass. }
{ xextract as T1 T2 HT. subst. inverts IE as IE1 IE2 F1 F2 EQ. xif.
{ xapps*. intros b. xextracts. xunfocus t. xsimpl. subst E. iff M.
{ xapps*. intros b. xextracts. xclose t. xsimpl. subst E. iff M.
{ autos. }
{ set_in M. math. auto. false* foreach_gt_notin F2. } }
{ xif.
{ xapps*. intros b. xextracts. xunfocus t. xsimpl. subst E. iff M.
{ xapps*. intros b. xextracts. xclose t. xsimpl. subst E. iff M.
{ applys~ in_union_3. }
{ set_in M. math. false* foreach_lt_notin F1. math. auto. } }
{ xret. xunfocus t. xsimpl.
{ xret. xclose t. xsimpl.
asserts_rewrite (x = y). math. subst E. auto. } } }
Qed.
......@@ -276,9 +276,9 @@ Lemma search_spec :
(fun b => \[b = isTrue (x \in E)] \* t ~> Mset E).
Proof using.
xweaken search_spec_ind. simpl. intros x t R HR S1 E.
xfocus t. xextract as T1 HT1.
xopen t. xextract as T1 HT1.
xapply* S1. xsimpl. intros b.
xextract as Hb. xunfocus* t. xsimpl*.
xextract as Hb. xclose* t. xsimpl*.
Qed.
(*--------------------------------------------------------*)
......@@ -292,11 +292,11 @@ Lemma extract_max_spec_ind :
\[m \in E /\ foreach (is_lt m) (E \- \{m}) /\ stree T' (E \- \{m})] ).
Proof using.
xinduction_heap tree_sub. xcf. intros t T. introv IH IE NE.
xfocus t as v. xfocus v. xapps. xmatch_clean.
xopen t as v. xopen v. xapps. xmatch_clean.
{ xextracts. xfail. false. }
{ xextract as T1 T2 EQ. subst T. inverts IE as IE1 IE2 F1 F2 EQE.
xfocus t2 as v2. xfocus v2. xapps. xmatch.
{ xextracts. inverts IE2. xfocus t1 as v1. xapps. xapps. xret.
xopen t2 as v2. xopen v2. xapps. xmatch.
{ xextracts. inverts IE2. xopen t1 as v1. xapps. xapps. xret.
xchange (Tree_unfocus t). xsimpl. subst E. splits.
{ autos*. }
{ rewrite remove_union. rewrite remove_self.
......@@ -307,8 +307,8 @@ Proof using.
rewrite union_empty_l. rewrite~ remove_notin.
applys foreach_notin_prove F1. math. } }
{ destruct v2; tryfalse. xextract as T21 T22 EQ2.
xunfocus t2. xapps~ IE2; clear IH. subst; auto_false*.
intros m. xextract as T2' (P1&P2&P3). xunfocus t. xsimpl.
xclose t2. xapps~ IE2; clear IH. subst; auto_false*.
intros m. xextract as T2' (P1&P2&P3). xclose t. xsimpl.
subst E.
asserts G: (m > x). { forwards~: F2 m. }
asserts M: (m \notin E1). { intros I. forwards~: F1 m. math. }
......@@ -334,37 +334,37 @@ Lemma delete_spec_ind :
(fun (_:unit) => Hexists T', \[stree T' (E \- \{x})] \* t ~> Tree T').
Proof using.
xinduction_heap tree_sub. xcf. intros x t T IH E IE.
xfocus t as v. xfocus v. xapps. xmatch_clean.
{ xextract as HT. subst. inverts IE. xret. xunfocus t. xsimpl*.
xopen t as v. xopen v. xapps. xmatch_clean.
{ xextract as HT. subst. inverts IE. xret. xclose t. xsimpl*.
rewrite remove_empty. constructors~. }
{ xextract as T1 T2 EHT. subst T. inverts IE as IE1 IE2 F1 F2 EQ.
(* todo: check notation *)
xif.
{ xapps*. xextract as T' HT'. xunfocus t. xsimpl*.
{ xapps*. xextract as T' HT'. xclose t. xsimpl*.
constructors~. applys foreach_remove_simple F1.
subst E. repeat rewrite remove_union.
sets_eq E1': (E1 \- \{x}). repeat rewrite~ remove_notin.
intros N. forwards~: F2 N. math.
rewrite notin_single_eq. math. }
{ xif.
{ xapps*. xextract as T' HT'. xunfocus t. xsimpl*.