Commit cfcd372f authored by Armaël Guéneau's avatar Armaël Guéneau

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
...@@ -210,7 +210,7 @@ Qed. ...@@ -210,7 +210,7 @@ Qed.
Lemma app_wgframe : forall B f xs H H1 H2 (Q1 Q:B->hprop), Lemma app_wgframe : forall B f xs H H1 H2 (Q1 Q:B->hprop),
app f xs H1 Q1 -> app f xs H1 Q1 ->
H ==> (H1 \* H2) -> H ==> (H1 \* H2) ->
(Q1 \*+ H2) ===> (Q \*+ (Hexists H', H')) -> (Q1 \*+ H2) ===> (Q \*+ \GC) ->
app f xs H Q. app f xs H Q.
Proof using. Proof using.
intros B f xs. gen f. induction xs as [|[A x] xs]; introv M WH WQ. false. intros B f xs. gen f. induction xs as [|[A x] xs]; introv M WH WQ. false.
...@@ -223,10 +223,11 @@ Qed. ...@@ -223,10 +223,11 @@ Qed.
Lemma app_weaken : forall B f xs H (Q Q':B->hprop), Lemma app_weaken : forall B f xs H (Q Q':B->hprop),
app f xs H Q -> app f xs H Q ->
Q ===> Q' -> Q ===> Q' ->
app f xs H Q'. app f xs H Q'.
Proof using. Proof using.
introv M W. applys* app_wgframe. hsimpl. intros r. hsimpl~ \[]. introv M W. applys* app_wgframe. hsimpl. intros r.
hchange W. hsimpl.
Qed. Qed.
(* DEPRECATED (* DEPRECATED
......
This diff is collapsed.
...@@ -28,17 +28,14 @@ Implicit Types x y z : int. ...@@ -28,17 +28,14 @@ Implicit Types x y z : int.
(********************************************************************) (********************************************************************)
(** Additional lemmas on credits *) (** Additional lemmas on credits *)
Definition credits_nat_eq := Lemma credits_eq : forall x y,
args_eq_1 heap_is_credits_nat. x = y ->
(* todo: state as a lemma instead *) \$ x = \$ y.
Proof. apply (args_eq_1 heap_is_credits). Qed.
Lemma credits_nat_zero_eq_prove : forall (n:nat),
n = 0%nat -> \$_nat n = \[].
Proof. intros. subst. apply credits_nat_zero_eq. Qed.
Lemma credits_int_zero_eq_prove : forall (x:int), Lemma credits_int_zero_eq_prove : forall (x:int),
x = 0 -> \$ x = \[]. x = 0 -> \$ x = \[].
Proof. intros. subst. apply credits_int_zero_eq. Qed. Proof. intros. subst. apply credits_zero_eq. Qed.
......
...@@ -505,6 +505,7 @@ Tactic Notation "xpull" "as" simple_intropattern(I1) simple_intropattern(I2) ...@@ -505,6 +505,7 @@ Tactic Notation "xpull" "as" simple_intropattern(I1) simple_intropattern(I2)
Ltac xgc_remove_hprop H := Ltac xgc_remove_hprop H :=
eapply (@local_gc_pre_on H); eapply (@local_gc_pre_on H);
[ try xlocal [ try xlocal
| try affine
| hsimpl | hsimpl
| xtag_pre_post ]. | xtag_pre_post ].
...@@ -557,6 +558,7 @@ Ltac xgc_post_if_not_evar_then cont := ...@@ -557,6 +558,7 @@ Ltac xgc_post_if_not_evar_then cont :=
Lemma local_gc_pre_all : forall B Q (F:~~B) H, Lemma local_gc_pre_all : forall B Q (F:~~B) H,
is_local F -> is_local F ->
affine H ->
F \[] Q -> F \[] Q ->
F H Q. F H Q.
Proof using. intros. apply* (@local_gc_pre_on H). hsimpl. Qed. Proof using. intros. apply* (@local_gc_pre_on H). hsimpl. Qed.
...@@ -1618,7 +1620,7 @@ Lemma xret_lemma : forall B (v:B) H (Q:B->hprop), ...@@ -1618,7 +1620,7 @@ Lemma xret_lemma : forall B (v:B) H (Q:B->hprop),
local (fun H' Q' => H' ==> Q' v) H Q. local (fun H' Q' => H' ==> Q' v) H Q.
Proof using. Proof using.
introv W. eapply (@local_gc_pre_on (\GC)). introv W. eapply (@local_gc_pre_on (\GC)).
auto. hchanges W. apply~ local_erase. hsimpl. auto. affine. hchanges W. apply~ local_erase. hsimpl.
Qed. Qed.
(* Lemma used by [xret] and [xret_no_gc] (* Lemma used by [xret] and [xret_no_gc]
...@@ -3832,15 +3834,11 @@ Tactic Notation "xname_post" ident(X) := ...@@ -3832,15 +3834,11 @@ Tactic Notation "xname_post" ident(X) :=
used before a credit split operation, e.g. to replace used before a credit split operation, e.g. to replace
[$n] with [$a \* $b], when [n = a + b]. [$n] with [$a \* $b], when [n = a + b].
LATER: add demos for this tactic. LATER: add demos for this tactic.
*) *)
Ltac xcredit goal := Ltac xcredit goal :=
match goal with match goal with
| |- context[\$_nat goal] =>
idtac (* no need to rewrite *)
| |- context[\$_nat ?n] =>
math_rewrite (n = goal :> nat)
| |- context[\$ goal] => | |- context[\$ goal] =>
idtac (* no need to rewrite *) idtac (* no need to rewrite *)
| |- context[\$ ?n] => | |- context[\$ ?n] =>
...@@ -3867,15 +3865,11 @@ Ltac xpay_start tt := ...@@ -3867,15 +3865,11 @@ Ltac xpay_start tt :=
Ltac xpay_core tt := Ltac xpay_core tt :=
xpay_start tt; [ unfold pay_one; hsimpl | ]. xpay_start tt; [ unfold pay_one; hsimpl | ].
Ltac xpay_nat_core tt :=
xpay_start tt; [ rewrite pay_one_nat; hsimpl | ].
Tactic Notation "xpay" := xpay_core tt. Tactic Notation "xpay" := xpay_core tt.
Ltac xpay_on_impl goal := Ltac xpay_on_impl goal :=
xcredit goal; xcredit goal;
first [ rewrite credits_int_split_eq first [ rewrite credits_split_eq ];
| rewrite credits_nat_split_eq ];
xpay. xpay.
Tactic Notation "xpay" constr(goal) := Tactic Notation "xpay" constr(goal) :=
...@@ -3913,12 +3907,22 @@ Tactic Notation "xpay_skip" := xpay_fake tt. ...@@ -3913,12 +3907,22 @@ Tactic Notation "xpay_skip" := xpay_fake tt.
Ltac xgc_credit_core HP := Ltac xgc_credit_core HP :=
let H := fresh in let H := fresh in
let E := fresh in let E := fresh in
destruct (credits_nat_le_rest HP) as (H&E); destruct (credits_le_rest HP) as (H&HA&E);
xchange E; [ chsimpl | xgc H; clear H E ]. xchange E; [ xgc H; clear H HA E; hclean ].
Tactic Notation "xgc_credit" constr(HP) := Tactic Notation "xgc_credit" constr(HP) :=
xgc_credit_core HP. xgc_credit_core HP.
Goal forall m n B (F : ~~B) Q,
m <= n ->
is_local F ->
F (\$m) Q ->
F (\$n) Q.
Proof.
introv H L HH.
xgc_credit_core H.
assumption.
Qed.
(*--------------------------------------------------------*) (*--------------------------------------------------------*)
(* ** [xskip_credits] *) (* ** [xskip_credits] *)
......
...@@ -32,6 +32,10 @@ Parameter Array : forall A, list A -> loc -> hprop. ...@@ -32,6 +32,10 @@ Parameter Array : forall A, list A -> loc -> hprop.
the ownership of single cells, each of which being the ownership of single cells, each of which being
described using heap_is_single. *) described using heap_is_single. *)
Parameter Array_affine : forall A t (L: list A), affine (t ~> Array L).
(* TODO: prove this *)
Hint Resolve Array_affine : affine.
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* The length of an array is at most [Sys.max_array_length]. This could be (* The length of an array is at most [Sys.max_array_length]. This could be
......
...@@ -260,6 +260,10 @@ Qed. ...@@ -260,6 +260,10 @@ Qed.
Notation "r '~~>' v" := (hdata (Ref v) r) Notation "r '~~>' v" := (hdata (Ref v) r)
(at level 32, no associativity) : heap_scope. (at level 32, no associativity) : heap_scope.
(* TODO: prove it and/or generalize wrt Heapdata *)
Parameter Ref_affine : forall A r (v: A), affine (r ~~> v).
Hint Resolve Ref_affine : affine.
Lemma ref_spec : forall A (v:A), Lemma ref_spec : forall A (v:A),
app ref [v] app ref [v]
PRE \[] PRE \[]
......
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