Skip to content

GitLab

C
cfml
Commit cfcd372f authored by Armaël Guéneau's avatar Armaël Guéneau
Browse files
Options

Credits are now a linear resource 

We can now have a negative number of credits (and this doesn't imply False), but
garbage-collection of resources has been restricted: only a positive number of
credits can be discarded.
parent 4a3579b2
Hide whitespace changes
Inline Side-by-side
Showing with 236 additions and 267 deletions
lib/coq/CFApp.v
View file @ cfcd372f
......@@ -210,7 +210,7 @@ Qed.
Lemma app_wgframe : forall B f xs H H1 H2 (Q1 Q:B->hprop),
app f xs H1 Q1 ->
H ==> (H1 \* H2) ->
(Q1 \*+ H2) ===> (Q \*+ (Hexists H', H')) ->
(Q1 \*+ H2) ===> (Q \*+ \GC) ->
app f xs H Q.
Proof using.
intros B f xs. gen f. induction xs as [|[A x] xs]; introv M WH WQ. false.
......@@ -223,10 +223,11 @@ Qed.
Lemma app_weaken : forall B f xs H (Q Q':B->hprop),
app f xs H Q ->
Q ===> Q' ->
app f xs H Q'.
Proof using.
introv M W. applys* app_wgframe. hsimpl. intros r. hsimpl~ \[].
Q ===> Q' ->
app f xs H Q'.
Proof using.
introv M W. applys* app_wgframe. hsimpl. intros r.
hchange W. hsimpl.
Qed.
(* DEPRECATED
......
lib/coq/CFHeaps.v
View file @ cfcd372f
......@@ -275,17 +275,25 @@ Tactic Notation "rew_disjoint" "*" :=
(** Representation of credits *)
Definition credits_type : Type := nat.
Definition credits_type : Type := int.
(** Zero and one credits *)
Definition credits_zero : credits_type := 0%nat.
Definition credits_one : credits_type := 1%nat.
Definition credits_zero : credits_type := 0.
Definition credits_one : credits_type := 1.
(** Representation of heaps *)
Definition heap : Type := (state * credits_type)%type.
(** Projections *)
Definition heap_state (h:heap) : state :=
match h with (m,_) => m end.
Definition heap_credits (h:heap) : credits_type :=
match h with (_,c) => c end.
(** Predicate over pairs *)
Definition prod_st A B (v:A*B) (P:A->Prop) (Q:B->Prop) := (* todo move to TLC *)
......@@ -312,7 +320,7 @@ Notation "\# h1 h2" := (heap_disjoint h1 h2)
(** Union of heaps *)
Definition heap_union (h1 h2 : heap) : heap :=
prod_func state_union (fun a b => (a + b)%nat) h1 h2.
prod_func state_union (fun a b => (a + b)) h1 h2.
Notation "h1 \+ h2" := (heap_union h1 h2)
(at level 51, right associativity).
......@@ -320,8 +328,12 @@ Notation "h1 \+ h2" := (heap_union h1 h2)
(** Empty heap *)
Definition heap_empty : heap :=
(state_empty, 0%nat).
(state_empty, 0).
(** Affine heaps *)
Definition heap_affine (h: heap) : Prop :=
0 <= heap_credits h.
(*------------------------------------------------------------------*)
(* ** Properties on heaps *)
......@@ -411,6 +423,31 @@ Proof using.
fequals. applys state_union_assoc. math.
Qed.
(** Affine *)
Lemma heap_affine_empty :
heap_affine heap_empty.
Proof.
unfold heap_affine, heap_empty. simpl.
math.
Qed.
Lemma heap_affine_union : forall h1 h2,
heap_affine h1 ->
heap_affine h2 ->
heap_affine (h1 \+ h2).
Proof.
intros (m1 & c1) (m2 & c2) HA1 HA2.
unfold heap_affine, heap_union, prod_func in *. simpl in *.
math.
Qed.
Lemma heap_affine_credits : forall c,
0 <= c ->
heap_affine (state_empty, c).
Proof. auto. Qed.
(** Hints and tactics *)
Hint Resolve heap_union_neutral_l heap_union_neutral_r.
......@@ -455,6 +492,11 @@ Definition heap_is_star (H1 H2 : hprop) : hprop :=
/\ heap_disjoint h1 h2
/\ h = heap_union h1 h2.
(** Affine heap predicates *)
Definition affine (H : hprop) : Prop :=
forall h, H h -> heap_affine h.
(** Lifting of existentials *)
Definition heap_is_pack A (Hof : A -> hprop) : hprop :=
......@@ -465,21 +507,18 @@ Definition heap_is_pack A (Hof : A -> hprop) : hprop :=
Definition heap_is_empty_st (H:Prop) : hprop :=
fun h => h = heap_empty /\ H.
(** Garbage collection predicate: [Hexists H, H]. *)
(** Garbage collection predicate: equivalent to [Hexists H, H \* \[affine H]]. *)
Definition heap_is_gc : hprop :=
heap_is_pack (fun H => H).
fun h => heap_affine h /\ exists H, H h.
(** Credits *)
Definition heap_is_credits_nat (n:nat) : hprop :=
fun h => let (m,n') := h in m = state_empty /\ n' = n.
Definition heap_is_credits_int (x:int) : hprop :=
heap_is_star (heap_is_credits_nat (abs x)) (heap_is_empty_st (x >= 0)%I).
Definition heap_is_credits (x:int) : hprop :=
fun h => let (m,x') := h in m = state_empty /\ x' = x.
Opaque heap_union state_single heap_is_star heap_is_pack
heap_is_credits_nat heap_is_credits_int.
heap_is_gc heap_is_credits heap_affine affine.
(** Hprop is inhabited *)
......@@ -505,10 +544,7 @@ Notation "H1 '\*' H2" := (heap_is_star H1 H2)
Notation "\GC" := (heap_is_gc) : heap_scope.
Notation "'\$_nat' n" := (heap_is_credits_nat n)
(at level 40, format "\$_nat n") : heap_scope.
Notation "'\$' x" := (heap_is_credits_int x)
Notation "'\$' x" := (heap_is_credits x)
(at level 40, format "\$ x") : heap_scope.
Notation "'Hexists' x1 , H" := (heap_is_pack (fun x1 => H))
......@@ -781,24 +817,24 @@ Tactic Notation "rew_heap" "*" "in" hyp(H) :=
(* ** Properties of heap credits *)
Section Credits.
Transparent heap_is_credits_nat heap_is_credits_int
Transparent heap_is_credits
heap_is_empty heap_is_empty_st heap_is_star heap_union heap_disjoint.
Definition pay_one H H' :=
H ==> \$ 1%I \* H'.
H ==> \$ 1 \* H'.
Lemma credits_nat_zero_eq : \$_nat 0 = \[].
Lemma credits_zero_eq : \$ 0 = \[].
Proof using.
unfold heap_is_credits_nat, heap_is_empty, heap_empty.
unfold heap_is_credits, heap_is_empty, heap_empty.
applys pred_ext_1. intros [m n]. iff [M1 M2] M. (* todo: extens should work *)
subst*.
inverts* M.
Qed.
Lemma credits_nat_split_eq : forall (n m : nat),
\$_nat (n+m) = \$_nat n \* \$_nat m.
Lemma credits_split_eq : forall (n m : int),
\$ (n+m) = \$ n \* \$ m.
Proof using.
intros c1 c2. unfold heap_is_credits_nat, heap_is_star, heap_union, heap_disjoint.
intros c1 c2. unfold heap_is_credits, heap_is_star, heap_union, heap_disjoint.
applys pred_ext_1. intros [m n]. (* todo: extens should work *)
iff [M1 M2] ([m1 n1]&[m2 n2]&(M1&E1)&(M2&E2)&M3&M4).
exists (state_empty,c1) (state_empty,c2). simpl. splits*.
......@@ -807,60 +843,39 @@ Proof using.
inverts M4. subst*.
Qed.
Lemma credits_nat_le : forall (n m : nat),
(n >= m)%nat -> \$_nat n ==> \$_nat m \* \$_nat (n-m).
Proof using.
introv M. rewrite <- credits_nat_split_eq.
math_rewrite (m + (n-m) = n)%nat. auto.
Qed.
Lemma credits_nat_le_rest : forall (n m : nat), (* todo: move later, inverse hyp *)
(n <= m)%nat -> exists H', \$_nat m ==> \$_nat n \* H'.
Proof using.
introv M. exists (\$_nat (m - n)). rewrite <- credits_nat_split_eq.
math_rewrite (n + (m-n) = m)%nat. auto.
Qed.
Lemma credits_int_zero_eq : \$ 0%I = \[].
Lemma credits_le_rest : forall (n m : int), (* todo: move later, inverse hyp *)
n <= m -> exists H', affine H' /\ \$ m ==> \$ n \* H'.
Proof using.
unfold heap_is_credits_int. change (abs 0) with (0%nat).
rewrite credits_nat_zero_eq. (* hsimpl would prove the goal here *)
unfold heap_is_star, heap_is_empty, heap_is_empty_st.
applys pred_ext_1. iff (h1&h2&H1&(H2&E)&D&U) E.
subst. autos* state_disjoint_empty_l.
subst. exists heap_empty heap_empty. splits~. splits~. math.
introv M. exists (\$ (m - n)). rewrite <- credits_split_eq.
math_rewrite (n + (m-n) = m).
splits~.
Local Transparent affine. unfold affine, heap_is_credits.
intros (? & ?) (? & ?); subst. apply heap_affine_credits.
math.
Qed.
Lemma credits_int_split_eq : forall (x y : int),
(x >= 0) -> (y >= 0) ->
\$(x+y) = \$ x \* \$ y.
Lemma credits_join_eq : forall x y,
\$ x \* \$ y = \$(x+y).
Proof using.
introv Px Py. unfold heap_is_credits_int. rew_heap.
rewrite (star_comm \[x >= 0]). rew_heap.
rewrite star_assoc. rewrite <- credits_nat_split_eq.
rewrite~ abs_plus. (* hsimpl would prove the goal here *)
unfold heap_is_star, heap_is_empty_st.
applys pred_ext_1. iff (h1&h2&H1&(H2&E)&D&U).
subst. exists h1 heap_empty. splits~. exists heap_empty heap_empty. splits~.
subst. destruct E as (h3&(E3&P3)&(E4&P4)&D'&U').
subst. exists h1 heap_empty. splits~. splits~. math. fequal.
autos* state_disjoint_empty_r.
Qed.
introv. unfold heap_is_credits.
applys pred_ext_1. intros h. splits.
{ intros ([m1 c1] & [m2 c2] & ([? ?] & [? ?] & [[? ?] ?])).
subst. unfold heap_union. simpl.
rewrite state_union_neutral_r. splits~. }
{ destruct h as [m c]. intros (? & ?). subst.
unfold heap_is_star.
exists (state_empty, x) (state_empty, y).
splits~.
{ unfold heap_disjoint. simpl.
splits~. apply state_disjoint_empty_l. }
{ unfold heap_union. simpl.
rewrite~ state_union_neutral_r. } }
Qed.
Lemma credits_int_le : forall (x y : int),
(x >= y)%I -> (y >= 0)%I -> \$ x ==> \$ y \* \$ (x-y).
Lemma credits_join_eq_rest : forall x y (H:hprop),
\$ x \* \$ y \* H = \$(x+y) \* H.
Proof using.
introv M N. unfold heap_is_credits_int. rew_heap.
unfold heap_is_star, heap_is_empty_st.
intros h (h1&h2&H1&(H2&E)&D&U). destruct h1 as [c1 n1].
destruct H1 as [C1 N1]. subst.
exists (state_empty,abs y). exists (state_empty,abs (x-y)).
splits~. constructors~. exists heap_empty.
exists (state_empty,abs (x-y)). splits~.
esplit. esplit. splits~. constructors~. splits~. math.
simpl. fequals. rewrite~ <- abs_plus. rewrite LibNat.plus_zero_r.
fequals. math.
math.
introv. rewrite star_assoc. rewrite~ credits_join_eq.
Qed.
End Credits.
......@@ -871,7 +886,7 @@ End Credits.
(** Tactic [credits_split] converts [\$(x+y) \* ...] into [\$x \* \$y \* ...] *)
Hint Rewrite credits_int_split_eq credits_nat_split_eq : credits_split_rew.
Hint Rewrite credits_split_eq : credits_split_rew.
Ltac credits_split :=
autorewrite with credits_split_rew.
......@@ -882,38 +897,11 @@ Lemma credits_swap : forall x (H:hprop),
H \* (\$ x) = (\$ x) \* H.
Proof using. intros. rewrite~ star_comm. Qed.
(* need additional nonnegativity hypotheses
Lemma credits_join_eq : forall x y,
\$ x \* \$ y = \$(x+y).
Proof using. .... Qed.
Lemma credits_join_eq_rest : forall x y (H:hprop),
\$ x \* \$ y \* H = \$(x+y) \* H.
Proof using. ..... Qed.
*)
(* TODO: above should be rewritten with pre-condition x>=0 and y>=0
which can be extracted from left-hand-side *)
Lemma credits_nat_join_eq : forall x y,
\$_nat x \* \$_nat y = \$_nat(x+y).
Proof using. intros. rewrite~ credits_nat_split_eq. Qed.
Lemma credits_nat_join_eq_rest : forall x y (H:hprop),
\$_nat x \* \$_nat y \* H = \$_nat(x+y) \* H.
Proof using. intros. rewrite~ credits_nat_split_eq. rewrite~ star_assoc. Qed.
Ltac credits_join_in H :=
match H with
| \$_nat ?x \* \$_nat ?y => rewrite (@credits_nat_join_eq x y)
| \$_nat ?x \* \$_nat ?y \* ?H' => rewrite (@credits_nat_join_eq_rest x y H')
(* TODO: activate these once lemmas are proved
| \$ ?x \* \$ ?y => rewrite (@credits_join_eq x y)
| \$ ?x \* \$ ?y \* ?H' => rewrite (@credits_join_eq_rest x y H')
*)
| _ \* ?H' => credits_join_in H'
end.
......@@ -1037,6 +1025,70 @@ Definition Group a A (G:htype A a) (M:map a A) :=
\* \[LibMap.finite M].
(*------------------------------------------------------------------*)
(* ** Properties of [affine] *)
Section Affine.
Transparent affine.
Lemma affine_empty :
affine \[].
Proof.
unfold affine, heap_is_empty. intros; subst.
apply heap_affine_empty.
Qed.
Lemma affine_star : forall H1 H2,
affine H1 ->
affine H2 ->
affine (H1 \* H2).
Proof.
Transparent heap_is_star.
introv HA1 HA2. unfold affine, heap_is_star in *.
intros h (? & ? & ? & ? & ? & ?). subst.
apply~ heap_affine_union.
Qed.
Lemma affine_credits : forall c,
0 <= c ->
affine (\$ c).
Proof.
Transparent heap_is_credits.
introv N. unfold affine, heap_is_credits.
intros (m & c'). intros (? & ?). subst.
apply~ heap_affine_credits.
Qed.
Lemma affine_empty_st : forall P,
affine \[P].
Proof.
Transparent heap_is_empty_st.
introv. unfold affine, heap_is_empty_st.
introv (? & ?); subst.
apply heap_affine_empty.
Qed.
Lemma affine_gc :
affine \GC.
Proof.
Transparent heap_is_gc.
unfold affine, heap_is_gc.
tauto.
Qed.
(* affine_hdata? *)
End Affine.
Hint Resolve
affine_empty affine_star affine_credits affine_empty_st
affine_gc
: affine.
Ltac affine :=
match goal with |- affine _ => eauto with affine zarith end.
(********************************************************************)
(* ** [xunfold] tactics *)
......@@ -1551,8 +1603,14 @@ Proof using.
Qed.
Lemma hsimpl_gc : forall H,
affine H ->
H ==> \GC.
Proof using. intros. unfold heap_is_gc. introv M. exists~ H. Qed.
Proof using.
Local Transparent affine heap_is_gc.
introv HA. unfold heap_is_gc, pred_incl.
intros h Hh. unfold affine in HA.
splits~. eauto.
Qed.
Lemma hsimpl_cancel_1 : forall H HA HR HT,
HT ==> HA \* HR -> H \* HT ==> HA \* (H \* HR).
......@@ -1603,128 +1661,61 @@ Lemma hsimpl_cancel_10 : forall H HA HR H1 H2 H3 H4 H5 H6 H7 H8 H9 HT,
Proof using. intros. rewrite (star_comm_assoc H9). apply~ hsimpl_cancel_9. Qed.
Lemma hsimpl_cancel_credits_nat_1 : forall (n m : nat) HA HR HT,
(n >= m)%nat ->
\$_nat (n - m) \* HT ==> HA \* HR ->
\$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Lemma hsimpl_cancel_credits_1 : forall (n m : int) HA HR HT,
\$ (n - m) \* HT ==> HA \* HR ->
\$ n \* HT ==> HA \* (\$ m \* HR).
Proof using.
introv L E. math_rewrite (n = (n - m) + m)%nat.
rewrite credits_nat_split_eq. rewrite <- star_assoc.
introv E. math_rewrite (n = (n - m) + m).
rewrite credits_split_eq. rewrite <- star_assoc.
applys~ hsimpl_cancel_2.
Qed.
Lemma hsimpl_cancel_credits_nat_2 : forall (n m : nat) HA HR H1 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* HT ==> HA \* HR ->
H1 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using.
intros. rewrite (star_comm_assoc H1). apply~ hsimpl_cancel_credits_nat_1.
Qed.
Lemma hsimpl_cancel_credits_nat_3 : forall (n m : nat) HA HR H1 H2 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* HT ==> HA \* HR ->
H1 \* H2 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H2). apply~ hsimpl_cancel_credits_nat_2. Qed.
Lemma hsimpl_cancel_credits_nat_4 : forall (n m : nat) HA HR H1 H2 H3 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H3). apply~ hsimpl_cancel_credits_nat_3. Qed.
Lemma hsimpl_cancel_credits_nat_5 : forall (n m : nat) HA HR H1 H2 H3 H4 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H4). apply~ hsimpl_cancel_credits_nat_4. Qed.
Lemma hsimpl_cancel_credits_nat_6 : forall (n m : nat) HA HR H1 H2 H3 H4 H5 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H5). apply~ hsimpl_cancel_credits_nat_5. Qed.
Lemma hsimpl_cancel_credits_nat_7 : forall (n m : nat) HA HR H1 H2 H3 H4 H5 H6 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H6). apply~ hsimpl_cancel_credits_nat_6. Qed.
Lemma hsimpl_cancel_credits_nat_8 : forall (n m : nat) HA HR H1 H2 H3 H4 H5 H6 H7 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H7). apply~ hsimpl_cancel_credits_nat_7. Qed.
Lemma hsimpl_cancel_credits_nat_9 : forall (n m : nat) HA HR H1 H2 H3 H4 H5 H6 H7 H8 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H8). apply~ hsimpl_cancel_credits_nat_8. Qed.
Lemma hsimpl_cancel_credits_nat_10 : forall (n m : nat) HA HR H1 H2 H3 H4 H5 H6 H7 H8 H9 HT,
(n >= m)%nat -> \$_nat (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* H9 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* H9 \* \$_nat n \* HT ==> HA \* (\$_nat m \* HR).
Proof using. intros. rewrite (star_comm_assoc H9). apply~ hsimpl_cancel_credits_nat_9. Qed.
Lemma hsimpl_cancel_credits_int_1 : forall n m HA HR HT,
n >= m -> m >= 0 ->
\$ (n - m) \* HT ==> HA \* HR -> \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using.
introv L R E. math_rewrite (n = (n - m) + m).
rewrite credits_int_split_eq. rewrite <- star_assoc.
applys~ hsimpl_cancel_2. math. math.
Qed.
Lemma hsimpl_cancel_credits_int_2 : forall n m HA HR H1 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_2 : forall (n m : int) HA HR H1 HT,
\$ (n - m) \* H1 \* HT ==> HA \* HR ->
H1 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using.
intros. rewrite (star_comm_assoc H1). apply~ hsimpl_cancel_credits_int_1.
intros. rewrite (star_comm_assoc H1). apply~ hsimpl_cancel_credits_1.
Qed.
Lemma hsimpl_cancel_credits_int_3 : forall n m HA HR H1 H2 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_3 : forall (n m : int) HA HR H1 H2 HT,
\$ (n - m) \* H1 \* H2 \* HT ==> HA \* HR ->
H1 \* H2 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H2). apply~ hsimpl_cancel_credits_int_2. Qed.
Proof using. intros. rewrite (star_comm_assoc H2). apply~ hsimpl_cancel_credits_2. Qed.
Lemma hsimpl_cancel_credits_int_4 : forall n m HA HR H1 H2 H3 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_4 : forall (n m : int) HA HR H1 H2 H3 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H3). apply~ hsimpl_cancel_credits_int_3. Qed.
Proof using. intros. rewrite (star_comm_assoc H3). apply~ hsimpl_cancel_credits_3. Qed.
Lemma hsimpl_cancel_credits_int_5 : forall n m HA HR H1 H2 H3 H4 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_5 : forall (n m : int) HA HR H1 H2 H3 H4 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H4). apply~ hsimpl_cancel_credits_int_4. Qed.
Proof using. intros. rewrite (star_comm_assoc H4). apply~ hsimpl_cancel_credits_4. Qed.
Lemma hsimpl_cancel_credits_int_6 : forall n m HA HR H1 H2 H3 H4 H5 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_6 : forall (n m : int) HA HR H1 H2 H3 H4 H5 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H5). apply~ hsimpl_cancel_credits_int_5. Qed.
Proof using. intros. rewrite (star_comm_assoc H5). apply~ hsimpl_cancel_credits_5. Qed.
Lemma hsimpl_cancel_credits_int_7 : forall n m HA HR H1 H2 H3 H4 H5 H6 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_7 : forall (n m : int) HA HR H1 H2 H3 H4 H5 H6 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H6). apply~ hsimpl_cancel_credits_int_6. Qed.
Proof using. intros. rewrite (star_comm_assoc H6). apply~ hsimpl_cancel_credits_6. Qed.
Lemma hsimpl_cancel_credits_int_8 : forall n m HA HR H1 H2 H3 H4 H5 H6 H7 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_8 : forall (n m : int) HA HR H1 H2 H3 H4 H5 H6 H7 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H7). apply~ hsimpl_cancel_credits_int_7. Qed.
Proof using. intros. rewrite (star_comm_assoc H7). apply~ hsimpl_cancel_credits_7. Qed.
Lemma hsimpl_cancel_credits_int_9 : forall n m HA HR H1 H2 H3 H4 H5 H6 H7 H8 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_9 : forall (n m : int) HA HR H1 H2 H3 H4 H5 H6 H7 H8 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H8). apply~ hsimpl_cancel_credits_int_8. Qed.
Proof using. intros. rewrite (star_comm_assoc H8). apply~ hsimpl_cancel_credits_8. Qed.
Lemma hsimpl_cancel_credits_int_10 : forall n m HA HR H1 H2 H3 H4 H5 H6 H7 H8 H9 HT,
n >= m -> m >= 0 ->
Lemma hsimpl_cancel_credits_10 : forall (n m : int) HA HR H1 H2 H3 H4 H5 H6 H7 H8 H9 HT,
\$ (n - m) \* H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* H9 \* HT ==> HA \* HR ->
H1 \* H2 \* H3 \* H4 \* H5 \* H6 \* H7 \* H8 \* H9 \* \$ n \* HT ==> HA \* (\$ m \* HR).
Proof using. intros. rewrite (star_comm_assoc H9). apply~ hsimpl_cancel_credits_int_9. Qed.
Proof using. intros. rewrite (star_comm_assoc H9). apply~ hsimpl_cancel_credits_9. Qed.
Lemma hsimpl_cancel_eq_1 : forall H H' HA HR HT,
......@@ -1874,7 +1865,8 @@ Ltac hsimpl_cleanup tt :=
try hsimpl_hint_remove tt;
try remove_empty_heaps_right tt;
try remove_empty_heaps_left tt;
try apply hsimpl_gc.
try apply hsimpl_gc;
try affine.
Ltac hsimpl_try_same tt :=
first
......@@ -1918,32 +1910,18 @@ Ltac hsimpl_find_data l HL cont :=
| _ \* _ \* _ \* _ \* _ \* _ \* _ \* _ \* _ \* hdata _ l \* _ => apply hsimpl_cancel_eq_10
end; [ cont tt | ].
Ltac hsimpl_find_credits_nat HL :=
match HL with
| \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_1
| _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_2
| _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_3
| _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_4
| _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_5
| _ \* _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_6
| _ \* _ \* _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_7
| _ \* _ \* _ \* _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_8
| _ \* _ \* _ \* _ \* _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_9
| _ \* _ \* _ \* _ \* _ \* _ \* _ \* _ \* _ \* \$_nat _ \* _ => apply hsimpl_cancel_credits_nat_10
end.