Commit 162c2f80 authored by Robbert Krebbers's avatar Robbert Krebbers

Expressions as dependent type.

parent c1f41d83
From heap_lang Require Export substitution notation. From heap_lang Require Export notation.
Definition newbarrier : val := λ: <>, ref #0. Definition newbarrier : val := λ: <>, ref #0.
Definition signal : val := λ: "x", "x" <- #1. Definition signal : val := λ: "x", '"x" <- #1.
Definition wait : val := Definition wait : val :=
rec: "wait" "x" := if: !"x" = #1 then #() else "wait" "x". rec: "wait" "x" := if: !'"x" = #1 then #() else '"wait" '"x".
Instance newbarrier_closed : Closed newbarrier. Proof. solve_closed. Qed.
Instance signal_closed : Closed signal. Proof. solve_closed. Qed.
Instance wait_closed : Closed wait. Proof. solve_closed. Qed.
...@@ -3,12 +3,12 @@ From program_logic Require Import auth sts saved_prop hoare ownership. ...@@ -3,12 +3,12 @@ From program_logic Require Import auth sts saved_prop hoare ownership.
Import uPred. Import uPred.
Definition worker (n : Z) : val := Definition worker (n : Z) : val :=
λ: "b" "y", wait "b" ;; !"y" #n. λ: "b" "y", ^wait '"b" ;; !'"y" #n.
Definition client : expr := Definition client : expr [] :=
let: "y" := ref #0 in let: "y" := ref #0 in
let: "b" := newbarrier #() in let: "b" := ^newbarrier #() in
Fork (Fork (worker 12 "b" "y") ;; worker 17 "b" "y") ;; Fork (Fork (^(worker 12) '"b" '"y") ;; ^(worker 17) '"b" '"y") ;;
"y" <- (λ: "z", "z" + #42) ;; signal "b". '"y" <- (λ: "z", '"z" + #42) ;; ^signal '"b".
Section client. Section client.
Context {Σ : rFunctorG} `{!heapG Σ, !barrierG Σ} (heapN N : namespace). Context {Σ : rFunctorG} `{!heapG Σ, !barrierG Σ} (heapN N : namespace).
...@@ -16,7 +16,7 @@ Section client. ...@@ -16,7 +16,7 @@ Section client.
Definition y_inv q y : iProp := Definition y_inv q y : iProp :=
( f : val, y {q} f n : Z, || f #n {{ λ v, v = #(n + 42) }})%I. ( f : val, y {q} f n : Z, || f #n {{ λ v, v = #(n + 42) }})%I.
Lemma y_inv_split q y : Lemma y_inv_split q y :
y_inv q y (y_inv (q/2) y y_inv (q/2) y). y_inv q y (y_inv (q/2) y y_inv (q/2) y).
Proof. Proof.
...@@ -56,7 +56,7 @@ Section client. ...@@ -56,7 +56,7 @@ Section client.
wp_seq. (ewp eapply wp_store); eauto with I. strip_later. wp_seq. (ewp eapply wp_store); eauto with I. strip_later.
rewrite assoc [(_ y _)%I]comm. apply sep_mono_r, wand_intro_l. rewrite assoc [(_ y _)%I]comm. apply sep_mono_r, wand_intro_l.
wp_seq. rewrite -signal_spec right_id assoc sep_elim_l comm. wp_seq. rewrite -signal_spec right_id assoc sep_elim_l comm.
apply sep_mono_r. rewrite /y_inv -(exist_intro (λ: "z", "z" + #42)%V). apply sep_mono_r. rewrite /y_inv -(exist_intro (λ: "z", '"z" + #42)%V).
apply sep_intro_True_r; first done. apply: always_intro. apply sep_intro_True_r; first done. apply: always_intro.
apply forall_intro=>n. wp_let. wp_op. by apply const_intro. } apply forall_intro=>n. wp_let. wp_op. by apply const_intro. }
(* The two spawned threads, the waiters. *) (* The two spawned threads, the waiters. *)
......
...@@ -19,12 +19,12 @@ Implicit Types Φ : val → iProp heap_lang Σ. ...@@ -19,12 +19,12 @@ Implicit Types Φ : val → iProp heap_lang Σ.
(** Proof rules for the sugar *) (** Proof rules for the sugar *)
Lemma wp_lam E x ef e v Φ : Lemma wp_lam E x ef e v Φ :
to_val e = Some v to_val e = Some v
|| subst' ef x v @ E {{ Φ }} || App (Lam x ef) e @ E {{ Φ }}. || subst' x e ef @ E {{ Φ }} || App (Lam x ef) e @ E {{ Φ }}.
Proof. intros. by rewrite -wp_rec. Qed. Proof. intros. by rewrite -wp_rec. Qed.
Lemma wp_let E x e1 e2 v Φ : Lemma wp_let E x e1 e2 v Φ :
to_val e1 = Some v to_val e1 = Some v
|| subst' e2 x v @ E {{ Φ }} || Let x e1 e2 @ E {{ Φ }}. || subst' x e1 e2 @ E {{ Φ }} || Let x e1 e2 @ E {{ Φ }}.
Proof. apply wp_lam. Qed. Proof. apply wp_lam. Qed.
Lemma wp_seq E e1 e2 v Φ : Lemma wp_seq E e1 e2 v Φ :
...@@ -37,17 +37,13 @@ Proof. rewrite -wp_seq // -wp_value //. Qed. ...@@ -37,17 +37,13 @@ Proof. rewrite -wp_seq // -wp_value //. Qed.
Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 to_val e0 = Some v0
|| subst' e1 x1 v0 @ E {{ Φ }} || Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. || subst' x1 e0 e1 @ E {{ Φ }} || Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. Proof. intros. by rewrite -wp_case_inl // -[X in _ X]later_intro -wp_let. Qed.
intros. rewrite -wp_case_inl // -[X in _ X]later_intro. by apply wp_let.
Qed.
Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 to_val e0 = Some v0
|| subst' e2 x2 v0 @ E {{ Φ }} || Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. || subst' x2 e0 e2 @ E {{ Φ }} || Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed.
intros. rewrite -wp_case_inr // -[X in _ X]later_intro. by apply wp_let.
Qed.
Lemma wp_le E (n1 n2 : Z) P Φ : Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P Φ (LitV (LitBool true))) (n1 n2 P Φ (LitV (LitBool true)))
......
This diff is collapsed.
...@@ -12,7 +12,7 @@ Context {Σ : rFunctor}. ...@@ -12,7 +12,7 @@ Context {Σ : rFunctor}.
Implicit Types P Q : iProp heap_lang Σ. Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ. Implicit Types Φ : val iProp heap_lang Σ.
Implicit Types K : ectx. Implicit Types K : ectx.
Implicit Types ef : option expr. Implicit Types ef : option (expr []).
(** Bind. *) (** Bind. *)
Lemma wp_bind {E e} K Φ : Lemma wp_bind {E e} K Φ :
...@@ -84,19 +84,19 @@ Qed. ...@@ -84,19 +84,19 @@ Qed.
Lemma wp_rec E f x e1 e2 v Φ : Lemma wp_rec E f x e1 e2 v Φ :
to_val e2 = Some v to_val e2 = Some v
|| subst' (subst' e1 f (RecV f x e1)) x v @ E {{ Φ }} || subst' x e2 (subst' f (Rec f x e1) e1) @ E {{ Φ }}
|| App (Rec f x e1) e2 @ E {{ Φ }}. || App (Rec f x e1) e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_step (App _ _) intros. rewrite -(wp_lift_pure_det_step (App _ _)
(subst' (subst' e1 f (RecV f x e1)) x v) None) ?right_id //=; (subst' x e2 (subst' f (Rec f x e1) e1)) None) //= ?right_id;
intros; inv_step; eauto. intros; inv_step; eauto.
Qed. Qed.
Lemma wp_rec' E f x erec v1 e2 v2 Φ : Lemma wp_rec' E f x erec e1 e2 v2 Φ :
v1 = RecV f x erec e1 = Rec f x erec
to_val e2 = Some v2 to_val e2 = Some v2
|| subst' (subst' erec f v1) x v2 @ E {{ Φ }} || subst' x e2 (subst' f e1 erec) @ E {{ Φ }}
|| App (of_val v1) e2 @ E {{ Φ }}. || App e1 e2 @ E {{ Φ }}.
Proof. intros ->. apply wp_rec. Qed. Proof. intros ->. apply wp_rec. Qed.
Lemma wp_un_op E op l l' Φ : Lemma wp_un_op E op l l' Φ :
......
...@@ -10,18 +10,22 @@ Notation "|| e {{ Φ } }" := (wp ⊤ e%E Φ) ...@@ -10,18 +10,22 @@ Notation "|| e {{ Φ } }" := (wp ⊤ e%E Φ)
Coercion LitInt : Z >-> base_lit. Coercion LitInt : Z >-> base_lit.
Coercion LitBool : bool >-> base_lit. Coercion LitBool : bool >-> base_lit.
(** No coercion from base_lit to expr. This makes is slightly easier to tell
apart language and Coq expressions. *)
Coercion Var : string >-> expr.
Coercion App : expr >-> Funclass. Coercion App : expr >-> Funclass.
Coercion of_val : val >-> expr. Coercion of_val : val >-> expr.
Coercion BNamed : string >-> binder. Coercion BNamed : string >-> binder.
Notation "<>" := BAnon : binder_scope. Notation "<>" := BAnon : binder_scope.
(* No scope, does not conflict and scope is often not inferred properly. *) (* No scope for the values, does not conflict and scope is often not inferred properly. *)
Notation "# l" := (LitV l%Z%V) (at level 8, format "# l"). Notation "# l" := (LitV l%Z%V) (at level 8, format "# l").
Notation "% l" := (LocV l) (at level 8, format "% l"). Notation "% l" := (LocV l) (at level 8, format "% l").
Notation "# l" := (LitV l%Z%V) (at level 8, format "# l") : val_scope.
Notation "% l" := (LocV l) (at level 8, format "% l") : val_scope.
Notation "# l" := (Lit l%Z%V) (at level 8, format "# l") : expr_scope.
Notation "% l" := (Loc l) (at level 8, format "% l") : expr_scope.
Notation "' x" := (Var x) (at level 8, format "' x") : expr_scope.
Notation "^ v" := (of_val' v%V) (at level 8, format "^ v") : expr_scope.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *) first. *)
...@@ -56,10 +60,23 @@ Notation "'if:' e1 'then' e2 'else' e3" := (If e1%E e2%E e3%E) ...@@ -56,10 +60,23 @@ Notation "'if:' e1 'then' e2 'else' e3" := (If e1%E e2%E e3%E)
are stated explicitly instead of relying on the Notations Let and Seq as are stated explicitly instead of relying on the Notations Let and Seq as
defined above. This is needed because App is now a coercion, and these defined above. This is needed because App is now a coercion, and these
notations are otherwise not pretty printed back accordingly. *) notations are otherwise not pretty printed back accordingly. *)
Notation "λ: x , e" := (Lam x e%E) Notation "'rec:' f x y := e" := (Rec f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y := e" := (RecV f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : val_scope.
Notation "'rec:' f x y .. z := e" := (Rec f x (Lam y .. (Lam z e%E) ..))
(at level 102, f, x, y, z at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y .. z := e" := (RecV f x (Lam y .. (Lam z e%E) ..))
(at level 102, f, x, y, z at level 1, e at level 200) : val_scope.
Notation "λ: x , e" := (Lam x e%E)
(at level 102, x at level 1, e at level 200) : expr_scope. (at level 102, x at level 1, e at level 200) : expr_scope.
Notation "λ: x y .. z , e" := (Lam x (Lam y .. (Lam z e%E) ..))
(at level 102, x, y, z at level 1, e at level 200) : expr_scope.
Notation "λ: x , e" := (LamV x e%E) Notation "λ: x , e" := (LamV x e%E)
(at level 102, x at level 1, e at level 200) : val_scope. (at level 102, x at level 1, e at level 200) : val_scope.
Notation "λ: x y .. z , e" := (LamV x (Lam y .. (Lam z e%E) .. ))
(at level 102, x, y, z at level 1, e at level 200) : val_scope.
Notation "'let:' x := e1 'in' e2" := (Lam x e2%E e1%E) Notation "'let:' x := e1 'in' e2" := (Lam x e2%E e1%E)
(at level 102, x at level 1, e1, e2 at level 200) : expr_scope. (at level 102, x at level 1, e1, e2 at level 200) : expr_scope.
...@@ -70,20 +87,3 @@ Notation "'let:' x := e1 'in' e2" := (LamV x e2%E e1%E) ...@@ -70,20 +87,3 @@ Notation "'let:' x := e1 'in' e2" := (LamV x e2%E e1%E)
(at level 102, x at level 1, e1, e2 at level 200) : val_scope. (at level 102, x at level 1, e1, e2 at level 200) : val_scope.
Notation "e1 ;; e2" := (LamV BAnon e2%E e1%E) Notation "e1 ;; e2" := (LamV BAnon e2%E e1%E)
(at level 100, e2 at level 200, format "e1 ;; e2") : val_scope. (at level 100, e2 at level 200, format "e1 ;; e2") : val_scope.
Notation "'rec:' f x y := e" := (Rec f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y := e" := (RecV f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : val_scope.
Notation "'rec:' f x y z := e" := (Rec f x (Lam y (Lam z e%E)))
(at level 102, f, x, y, z at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y z := e" := (RecV f x (Lam y (Lam z e%E)))
(at level 102, f, x, y, z at level 1, e at level 200) : val_scope.
Notation "λ: x y , e" := (Lam x (Lam y e%E))
(at level 102, x, y at level 1, e at level 200) : expr_scope.
Notation "λ: x y , e" := (LamV x (Lam y e%E))
(at level 102, x, y at level 1, e at level 200) : val_scope.
Notation "λ: x y z , e" := (Lam x (Lam y (Lam z e%E)))
(at level 102, x, y, z at level 1, e at level 200) : expr_scope.
Notation "λ: x y z , e" := (LamV x (Lam y (Lam z e%E)))
(at level 102, x, y, z at level 1, e at level 200) : val_scope.
This diff is collapsed.
From heap_lang Require Export lang. From heap_lang Require Export substitution.
From prelude Require Import fin_maps. From prelude Require Import fin_maps.
Import heap_lang. Import heap_lang.
...@@ -34,6 +34,7 @@ Ltac reshape_val e tac := ...@@ -34,6 +34,7 @@ Ltac reshape_val e tac :=
let rec go e := let rec go e :=
match e with match e with
| of_val ?v => v | of_val ?v => v
| of_val' ?v => v
| Rec ?f ?x ?e => constr:(RecV f x e) | Rec ?f ?x ?e => constr:(RecV f x e)
| Lit ?l => constr:(LitV l) | Lit ?l => constr:(LitV l)
| Pair ?e1 ?e2 => | Pair ?e1 ?e2 =>
...@@ -83,7 +84,7 @@ Ltac do_step tac := ...@@ -83,7 +84,7 @@ Ltac do_step tac :=
| |- prim_step ?e1 ?σ1 ?e2 ?σ2 ?ef => | |- prim_step ?e1 ?σ1 ?e2 ?σ2 ?ef =>
reshape_expr e1 ltac:(fun K e1' => reshape_expr e1 ltac:(fun K e1' =>
eapply Ectx_step with K e1' _; [reflexivity|reflexivity|]; eapply Ectx_step with K e1' _; [reflexivity|reflexivity|];
first [apply alloc_fresh|econstructor]; first [apply alloc_fresh|econstructor; try reflexivity; simpl_subst];
rewrite ?to_of_val; tac; fail) rewrite ?to_of_val; tac; fail)
| |- head_step ?e1 ?σ1 ?e2 ?σ2 ?ef => | |- head_step ?e1 ?σ1 ?e2 ?σ2 ?ef =>
first [apply alloc_fresh|econstructor]; first [apply alloc_fresh|econstructor];
......
...@@ -4,21 +4,15 @@ From heap_lang Require Import wp_tactics heap notation. ...@@ -4,21 +4,15 @@ From heap_lang Require Import wp_tactics heap notation.
Import uPred. Import uPred.
Section LangTests. Section LangTests.
Definition add := (#21 + #21)%E. Definition add : expr [] := (#21 + #21)%E.
Goal σ, prim_step add σ (#42) σ None. Goal σ, prim_step add σ (#42) σ None.
Proof. intros; do_step done. Qed. Proof. intros; do_step done. Qed.
Definition rec_app : expr := ((rec: "f" "x" := "f" "x") #0). Definition rec_app : expr [] := ((rec: "f" "x" := '"f" '"x") #0)%E.
Goal σ, prim_step rec_app σ rec_app σ None. Goal σ, prim_step rec_app σ rec_app σ None.
Proof. Proof. intros. rewrite /rec_app. do_step done. Qed.
intros. rewrite /rec_app. (* FIXME: do_step does not work here *) Definition lam : expr [] := (λ: "x", '"x" + #21)%E.
by eapply (Ectx_step _ _ _ _ _ []), (BetaS _ _ _ _ #0).
Qed.
Definition lam : expr := λ: "x", "x" + #21.
Goal σ, prim_step (lam #21)%E σ add σ None. Goal σ, prim_step (lam #21)%E σ add σ None.
Proof. Proof. intros. rewrite /lam. do_step done. Qed.
intros. rewrite /lam. (* FIXME: do_step does not work here *)
by eapply (Ectx_step _ _ _ _ _ []), (BetaS <> "x" ("x" + #21) _ #21).
Qed.
End LangTests. End LangTests.
Section LiftingTests. Section LiftingTests.
...@@ -27,8 +21,8 @@ Section LiftingTests. ...@@ -27,8 +21,8 @@ Section LiftingTests.
Implicit Types P Q : iPropG heap_lang Σ. Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ. Implicit Types Φ : val iPropG heap_lang Σ.
Definition heap_e : expr := Definition heap_e : expr [] :=
let: "x" := ref #1 in "x" <- !"x" + #1;; !"x". let: "x" := ref #1 in '"x" <- !'"x" + #1 ;; !'"x".
Lemma heap_e_spec E N : Lemma heap_e_spec E N :
nclose N E heap_ctx N || heap_e @ E {{ λ v, v = #2 }}. nclose N E heap_ctx N || heap_e @ E {{ λ v, v = #2 }}.
Proof. Proof.
...@@ -42,16 +36,11 @@ Section LiftingTests. ...@@ -42,16 +36,11 @@ Section LiftingTests.
Definition FindPred : val := Definition FindPred : val :=
rec: "pred" "x" "y" := rec: "pred" "x" "y" :=
let: "yp" := "y" + #1 in let: "yp" := '"y" + #1 in
if: "yp" < "x" then "pred" "x" "yp" else "y". if: '"yp" < '"x" then '"pred" '"x" '"yp" else '"y".
Definition Pred : val := Definition Pred : val :=
λ: "x", λ: "x",
if: "x" #0 then -FindPred (-"x" + #2) #0 else FindPred "x" #0. if: '"x" #0 then -^FindPred (-'"x" + #2) #0 else ^FindPred '"x" #0.
Instance FindPred_closed : Closed FindPred | 0.
Proof. solve_closed. Qed.
Instance Pred_closed : Closed Pred | 0.
Proof. solve_closed. Qed.
Lemma FindPred_spec n1 n2 E Φ : Lemma FindPred_spec n1 n2 E Φ :
n1 < n2 n1 < n2
...@@ -74,7 +63,7 @@ Section LiftingTests. ...@@ -74,7 +63,7 @@ Section LiftingTests.
Qed. Qed.
Lemma Pred_user E : Lemma Pred_user E :
(True : iProp) || let: "x" := Pred #42 in Pred "x" @ E {{ λ v, v = #40 }}. (True : iProp) || let: "x" := Pred #42 in ^Pred '"x" @ E {{ λ v, v = #40 }}.
Proof. Proof.
intros. ewp apply Pred_spec. wp_let. ewp apply Pred_spec. auto with I. intros. ewp apply Pred_spec. wp_let. ewp apply Pred_spec. auto with I.
Qed. Qed.
......
...@@ -27,25 +27,25 @@ Tactic Notation "wp_rec" ">" := ...@@ -27,25 +27,25 @@ Tactic Notation "wp_rec" ">" :=
idtac; (* <https://coq.inria.fr/bugs/show_bug.cgi?id=4584> *) idtac; (* <https://coq.inria.fr/bugs/show_bug.cgi?id=4584> *)
lazymatch goal with lazymatch goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval cbv in e' with match eval hnf in e' with App ?e1 _ =>
| App (Rec _ _ _) _ => (* hnf does not reduce through an of_val *)
wp_bind K; etrans; (* match eval hnf in e1 with Rec _ _ _ => *)
[|first [eapply wp_rec' | eapply wp_rec]; wp_bind K; etrans;
repeat (reflexivity || rewrite /= to_of_val)]; [|eapply wp_rec'; repeat rewrite /= to_of_val; reflexivity];
simpl_subst; wp_finish simpl_subst; wp_finish
end) (* end *) end)
end). end).
Tactic Notation "wp_rec" := wp_rec>; try strip_later. Tactic Notation "wp_rec" := wp_rec>; try strip_later.
Tactic Notation "wp_lam" ">" := Tactic Notation "wp_lam" ">" :=
match goal with match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval cbv in e' with match eval hnf in e' with App ?e1 _ =>
| App (Rec BAnon _ _) _ => (* match eval hnf in e1 with Rec BAnon _ _ => *)
wp_bind K; etrans; wp_bind K; etrans;
[|eapply wp_lam; repeat (reflexivity || rewrite /= to_of_val)]; [|eapply wp_lam; repeat (reflexivity || rewrite /= to_of_val)];
simpl_subst; wp_finish simpl_subst; wp_finish
end) (* end *) end)
end. end.
Tactic Notation "wp_lam" := wp_lam>; try strip_later. Tactic Notation "wp_lam" := wp_lam>; try strip_later.
...@@ -57,7 +57,7 @@ Tactic Notation "wp_seq" := wp_let. ...@@ -57,7 +57,7 @@ Tactic Notation "wp_seq" := wp_let.
Tactic Notation "wp_op" ">" := Tactic Notation "wp_op" ">" :=
match goal with match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval cbv in e' with match eval hnf in e' with
| BinOp LtOp _ _ => wp_bind K; apply wp_lt; wp_finish | BinOp LtOp _ _ => wp_bind K; apply wp_lt; wp_finish
| BinOp LeOp _ _ => wp_bind K; apply wp_le; wp_finish | BinOp LeOp _ _ => wp_bind K; apply wp_le; wp_finish
| BinOp EqOp _ _ => wp_bind K; apply wp_eq; wp_finish | BinOp EqOp _ _ => wp_bind K; apply wp_eq; wp_finish
...@@ -72,10 +72,9 @@ Tactic Notation "wp_op" := wp_op>; try strip_later. ...@@ -72,10 +72,9 @@ Tactic Notation "wp_op" := wp_op>; try strip_later.
Tactic Notation "wp_if" ">" := Tactic Notation "wp_if" ">" :=
match goal with match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => | |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval cbv in e' with match eval hnf in e' with If _ _ _ =>
| If _ _ _ => wp_bind K;
wp_bind K; etrans; [|apply wp_if_true || apply wp_if_false]; wp_finish
etrans; [|apply wp_if_true || apply wp_if_false]; wp_finish
end) end)
end. end.
Tactic Notation "wp_if" := wp_if>; try strip_later. Tactic Notation "wp_if" := wp_if>; try strip_later.
......
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