wp_tactics.v 3.56 KB
Newer Older
1
From algebra Require Export upred_tactics.
2 3 4
From heap_lang Require Export tactics substitution.
Import uPred.

5 6 7 8 9 10 11 12 13 14
(** wp-specific helper tactics *)
(* First try to productively strip off laters; if that fails, at least
   cosmetically get rid of laters in the conclusion. *)
Ltac wp_strip_later :=
  let rec go :=
    lazymatch goal with
    | |- _  (_  _) => apply sep_mono; go
    | |- _   _ => apply later_intro
    | |- _  _ => reflexivity
    end
15
  in intros_revert ltac:(first [ strip_later | etrans; [|go] ] ).
16 17 18
Ltac wp_bind K :=
  lazymatch eval hnf in K with
  | [] => idtac
19
  | _ => etrans; [|solve [ apply (wp_bind K) ]]; simpl
20
  end.
21 22 23
Ltac wp_finish :=
  let rec go :=
  match goal with
24
  | |- _   _ => etrans; [|apply later_mono; go; reflexivity]
25
  | |- _  wp _ _ _ =>
26
     etrans; [|eapply wp_value_pvs; reflexivity];
27 28
     (* sometimes, we will have to do a final view shift, so only apply
     wp_value if we obtain a consecutive wp *)
29 30
     try (eapply pvs_intro;
          match goal with |- _  wp _ _ _ => simpl | _ => fail end)
31
  | _ => idtac
32
  end in simpl; intros_revert go.
33

34
Tactic Notation "wp_rec" ">" :=
35
  löb ltac:((* Find the redex and apply wp_rec *)
36
              idtac; (* <https://coq.inria.fr/bugs/show_bug.cgi?id=4584> *)
37
               lazymatch goal with
Ralf Jung's avatar
Ralf Jung committed
38 39 40
               | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
                        match eval cbv in e' with
                        | App (Rec _ _ _) _ =>
41 42
                          wp_bind K; etrans; [|eapply wp_rec; reflexivity];
                          wp_finish
Ralf Jung's avatar
Ralf Jung committed
43
                        end)
44 45
               end).
Tactic Notation "wp_rec" := wp_rec>; wp_strip_later.
46

47 48 49 50 51
Tactic Notation "wp_lam" ">" :=
  match goal with
  | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
    match eval cbv in e' with
    | App (Rec "" _ _) _ =>
52
       wp_bind K; etrans; [|eapply wp_lam; reflexivity]; wp_finish
53 54 55 56 57 58 59 60 61
    end)
  end.
Tactic Notation "wp_lam" := wp_lam>; wp_strip_later.

Tactic Notation "wp_let" ">" := wp_lam>.
Tactic Notation "wp_let" := wp_lam.
Tactic Notation "wp_seq" ">" := wp_let>.
Tactic Notation "wp_seq" := wp_let.

62
Tactic Notation "wp_op" ">" :=
63 64 65
  match goal with
  | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
    match eval cbv in e' with
66 67 68 69
    | BinOp LtOp _ _ => wp_bind K; apply wp_lt; wp_finish
    | BinOp LeOp _ _ => wp_bind K; apply wp_le; wp_finish
    | BinOp EqOp _ _ => wp_bind K; apply wp_eq; wp_finish
    | BinOp _ _ _ =>
70
       wp_bind K; etrans; [|eapply wp_bin_op; reflexivity]; wp_finish
71
    | UnOp _ _ =>
72
       wp_bind K; etrans; [|eapply wp_un_op; reflexivity]; wp_finish
73 74
    end)
  end.
75 76
Tactic Notation "wp_op" := wp_op>; wp_strip_later.

77
Tactic Notation "wp_if" ">" :=
78 79 80 81
  match goal with
  | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
    match eval cbv in e' with
    | If _ _ _ =>
82
       wp_bind K;
83
       etrans; [|apply wp_if_true || apply wp_if_false]; wp_finish
84 85
    end)
  end.
86
Tactic Notation "wp_if" := wp_if>; wp_strip_later.
87

88 89 90 91 92
Tactic Notation "wp_focus" open_constr(efoc) :=
  match goal with
  | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
    match e' with efoc => unify e' efoc; wp_bind K end)
  end.
93

94
Tactic Notation "wp" ">" tactic(tac) :=
95 96 97
  match goal with
  | |- _  wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => wp_bind K; tac)
  end.
Ralf Jung's avatar
Ralf Jung committed
98
Tactic Notation "wp" tactic(tac) := (wp> tac); [wp_strip_later|..].
99

Ralf Jung's avatar
Ralf Jung committed
100 101
(* In case the precondition does not match.
   TODO: Have one tactic unifying wp and ewp. *)
102 103
Tactic Notation "ewp" tactic(tac) := wp (etrans; [|tac]).
Tactic Notation "ewp" ">" tactic(tac) := wp> (etrans; [|tac]).