Skip to content
Snippets Groups Projects
Commit 6d43651e authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Better errors messages for wp heap tactics.

parent 81c0aaee
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 78 additions and 61 deletions
heap_lang/proofmode.v
+ 78
− 61
View file @ 6d43651e
...@@ -94,88 +94,105 @@ Tactic Notation "wp_apply" open_constr(lem) := ...@@ -94,88 +94,105 @@ Tactic Notation "wp_apply" open_constr(lem) :=
Tactic Notation "wp_alloc" ident(l) "as" constr(H) := Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
lazymatch goal with lazymatch goal with
| |- _ ⊢ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ ⊢ wp ?E ?e ?Q =>
match eval hnf in e' with first
| Alloc ?e => [reshape_expr e ltac:(fun K e' =>
wp_bind K; eapply tac_wp_alloc with _ _ H _; match eval hnf in e' with Alloc _ => wp_bind K end)
[wp_done || fail 2 "wp_alloc:" e "not a value" |fail 1 "wp_alloc: cannot find 'Alloc' in" e];
|iAssumption || fail 2 "wp_alloc: cannot find heap_ctx" eapply tac_wp_alloc with _ _ H _;
|done || eauto with ndisj [let e' := match goal with |- to_val ?e' = _ => e' end in
|apply _ wp_done || fail "wp_alloc:" e' "not a value"
|intros l; eexists; split; |iAssumption || fail "wp_alloc: cannot find heap_ctx"
[env_cbv; reflexivity || fail 2 "wp_alloc:" H "not fresh" |done || eauto with ndisj
|wp_finish]] |apply _
end) || fail "wp_alloc: cannot find 'Alloc' in" e |first [intros l | fail 1 "wp_alloc:" l "not fresh"];
eexists; split;
[env_cbv; reflexivity || fail "wp_alloc:" H "not fresh"
|wp_finish]]
| _ => fail "wp_alloc: not a 'wp'" | _ => fail "wp_alloc: not a 'wp'"
end. end.
Tactic Notation "wp_alloc" ident(l) := Tactic Notation "wp_alloc" ident(l) :=
let H := iFresh in wp_alloc l as H. let H := iFresh in wp_alloc l as H.
Tactic Notation "wp_load" := Tactic Notation "wp_load" :=
lazymatch goal with lazymatch goal with
| |- _ ⊢ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ ⊢ wp ?E ?e ?Q =>
match eval hnf in e' with first
| Load ?l => [reshape_expr e ltac:(fun K e' =>
wp_bind K; eapply tac_wp_load; match eval hnf in e' with Load _ => wp_bind K end)
[iAssumption || fail 2 "wp_load: cannot find heap_ctx" |fail 1 "wp_load: cannot find 'Load' in" e];
|done || eauto with ndisj eapply tac_wp_load;
|apply _ [iAssumption || fail "wp_load: cannot find heap_ctx"
|iAssumptionCore || fail 2 "wp_cas_fail: cannot find" l "↦ ?" |done || eauto with ndisj
|wp_finish] |apply _
end) || fail "wp_load: cannot find 'Load' in" e |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?"
|wp_finish]
| _ => fail "wp_load: not a 'wp'" | _ => fail "wp_load: not a 'wp'"
end. end.
Tactic Notation "wp_store" := Tactic Notation "wp_store" :=
lazymatch goal with lazymatch goal with
| |- _ ⊢ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ ⊢ wp ?E ?e ?Q =>
match eval hnf in e' with first
| Store ?l ?e => [reshape_expr e ltac:(fun K e' =>
wp_bind K; eapply tac_wp_store; match eval hnf in e' with Store _ _ => wp_bind K end)
[wp_done || fail 2 "wp_store:" e "not a value" |fail 1 "wp_store: cannot find 'Store' in" e];
|iAssumption || fail 2 "wp_store: cannot find heap_ctx" eapply tac_wp_store;
|done || eauto with ndisj [let e' := match goal with |- to_val ?e' = _ => e' end in
|apply _ wp_done || fail "wp_store:" e' "not a value"
|iAssumptionCore || fail 2 "wp_store: cannot find" l "↦ ?" |iAssumption || fail "wp_store: cannot find heap_ctx"
|env_cbv; reflexivity |done || eauto with ndisj
|wp_finish] |apply _
end) || fail "wp_store: cannot find 'Store' in" e |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_store: cannot find" l "↦ ?"
|env_cbv; reflexivity
|wp_finish]
| _ => fail "wp_store: not a 'wp'" | _ => fail "wp_store: not a 'wp'"
end. end.
Tactic Notation "wp_cas_fail" := Tactic Notation "wp_cas_fail" :=
lazymatch goal with lazymatch goal with
| |- _ ⊢ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ ⊢ wp ?E ?e ?Q =>
match eval hnf in e' with first
| CAS ?l ?e1 ?e2 => [reshape_expr e ltac:(fun K e' =>
wp_bind K; eapply tac_wp_cas_fail; match eval hnf in e' with CAS _ _ _ => wp_bind K end)
[wp_done || fail 2 "wp_cas_fail:" e1 "not a value" |fail 1 "wp_cas_fail: cannot find 'CAS' in" e];
|wp_done || fail 2 "wp_cas_fail:" e2 "not a value" eapply tac_wp_cas_fail;
|iAssumption || fail 2 "wp_cas_fail: cannot find heap_ctx" [let e' := match goal with |- to_val ?e' = _ => e' end in
|done || eauto with ndisj wp_done || fail "wp_cas_fail:" e' "not a value"
|apply _ |let e' := match goal with |- to_val ?e' = _ => e' end in
|iAssumptionCore || fail 2 "wp_cas_fail: cannot find" l "↦ ?" wp_done || fail "wp_cas_fail:" e' "not a value"
|try congruence |iAssumption || fail "wp_cas_fail: cannot find heap_ctx"
|wp_finish] |done || eauto with ndisj
end) || fail "wp_cas_fail: cannot find 'CAS' in" e |apply _
|let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?"
|try congruence
|wp_finish]
| _ => fail "wp_cas_fail: not a 'wp'" | _ => fail "wp_cas_fail: not a 'wp'"
end. end.
Tactic Notation "wp_cas_suc" := Tactic Notation "wp_cas_suc" :=
lazymatch goal with lazymatch goal with
| |- _ ⊢ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ ⊢ wp ?E ?e ?Q =>
match eval hnf in e' with first
| CAS ?l ?e1 ?e2 => [reshape_expr e ltac:(fun K e' =>
wp_bind K; eapply tac_wp_cas_suc; match eval hnf in e' with CAS _ _ _ => wp_bind K end)
[wp_done || fail 2 "wp_cas_suc:" e1 "not a value" |fail 1 "wp_cas_suc: cannot find 'CAS' in" e];
|wp_done || fail 2 "wp_cas_suc:" e1 "not a value" eapply tac_wp_cas_suc;
|iAssumption || fail 2 "wp_cas_suc: cannot find heap_ctx" [let e' := match goal with |- to_val ?e' = _ => e' end in
|done || eauto with ndisj wp_done || fail "wp_cas_suc:" e' "not a value"
|apply _ |let e' := match goal with |- to_val ?e' = _ => e' end in
|iAssumptionCore || fail 2 "wp_cas_suc: cannot find" l "↦ ?" wp_done || fail "wp_cas_suc:" e' "not a value"
|try congruence |iAssumption || fail "wp_cas_suc: cannot find heap_ctx"
|env_cbv; reflexivity |done || eauto with ndisj
|wp_finish] |apply _
end) || fail "wp_cas_suc: cannot find 'CAS' in" e |let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_suc: cannot find" l "↦ ?"
|try congruence
|env_cbv; reflexivity
|wp_finish]
| _ => fail "wp_cas_suc: not a 'wp'" | _ => fail "wp_cas_suc: not a 'wp'"
end. end.
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