Commit a761ee45 authored by charguer's avatar charguer

restructure cf tactic notation

parent 76cbd8d1
...@@ -10,7 +10,8 @@ License: MIT. ...@@ -10,7 +10,8 @@ License: MIT.
From Sep Require Export LambdaSepLifted LambdaCFLifted. From Sep Require Export LambdaSepLifted LambdaCFLifted.
From Sep Require Export LambdaStructLifted. From Sep Require Export LambdaStructLifted.
From TLC Require Export LibListZ. From TLC Require Export LibList LibListZ.
Open Scope liblist_scope.
Open Scope Z_scope. Open Scope Z_scope.
(* Open Scope charac. TODO: not needed? *) (* Open Scope charac. TODO: not needed? *)
......
...@@ -220,7 +220,8 @@ Lemma rule_test_mkcounter : ...@@ -220,7 +220,8 @@ Lemma rule_test_mkcounter :
\[] \[]
(fun r => \[r = 3]). (fun r => \[r = 3]).
Proof using. Proof using.
xcf. xapp as C. xcf_trm 100%nat. (* todo: make xcf work *)
xapp as C.
xapps Rule_MCount. xapps Rule_MCount.
xapps Rule_MCount. xapps Rule_MCount.
xapps. xapps.
......
...@@ -30,6 +30,10 @@ Definition MQueue (L:list val) (p:loc) := ...@@ -30,6 +30,10 @@ Definition MQueue (L:list val) (p:loc) :=
Hexists (pf:loc), Hexists (pb:loc), Hexists (vx:val), Hexists (vy:val), Hexists (pf:loc), Hexists (pb:loc), Hexists (vx:val), Hexists (vy:val),
MCell pf pb p \* MListSeg pb L pf \* MCell vx vy pb. MCell pf pb p \* MListSeg pb L pf \* MCell vx vy pb.
(* ---------------------------------------------------------------------- *)
(** Create *)
Definition val_create := Definition val_create :=
ValFun 'v := ValFun 'v :=
Let 'r := val_alloc 2 in Let 'r := val_alloc 2 in
......
This diff is collapsed.
...@@ -11,6 +11,7 @@ License: MIT. ...@@ -11,6 +11,7 @@ License: MIT.
Set Implicit Arguments. Set Implicit Arguments.
From Sep Require Import LambdaCF LambdaStruct. From Sep Require Import LambdaCF LambdaStruct.
From TLC Require Import LibList.
Generalizable Variables A B. Generalizable Variables A B.
Ltac auto_star ::= jauto. Ltac auto_star ::= jauto.
......
...@@ -10,7 +10,7 @@ License: MIT. ...@@ -10,7 +10,7 @@ License: MIT.
Set Implicit Arguments. Set Implicit Arguments.
From TLC Require Export LibFix. From TLC Require Export LibFix.
From Sep Require Export LambdaSep. From Sep Require Export LambdaSepRO LambdaCFTactics.
Open Scope heap_scope. Open Scope heap_scope.
Implicit Types v w : val. Implicit Types v w : val.
...@@ -408,7 +408,7 @@ Notation "'Register_spec' f" := (Register_rule (trm_apps (trm_val f) _)) ...@@ -408,7 +408,7 @@ Notation "'Register_spec' f" := (Register_rule (trm_apps (trm_val f) _))
the specification that could apply to a goal [G]. the specification that could apply to a goal [G].
It places the specification as hypothesis at the head of the goal. *) It places the specification as hypothesis at the head of the goal. *)
Ltac xapp_basic_prepare tt := (* defined further *) Ltac xapp_basic_prepare tt ::= (* actually defined further *)
idtac. idtac.
Ltac xspec_context G := (* refined only in LambdaCFLifted *) Ltac xspec_context G := (* refined only in LambdaCFLifted *)
...@@ -449,41 +449,21 @@ Hint Extern 1 (Register_spec (val_prim val_ptr_add)) => Provide rule_ptr_add. ...@@ -449,41 +449,21 @@ Hint Extern 1 (Register_spec (val_prim val_ptr_add)) => Provide rule_ptr_add.
(* ********************************************************************** *) (* ********************************************************************** *)
(* * Tactics for progressing through proofs *) (* * Tactics for progressing through proofs *)
(** Extends tactics defined in [LambdaCFTactics.v] *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xcf] *) (* ** Tactic [xcf] *)
Ltac xcf_get_fun_remove_encs f := Ltac xcf_get_fun_from_goal tt ::=
constr:(f).
Ltac xcf_get_fun_from_trm t :=
match t with
| trm_apps (trm_val ?f) _ => xcf_get_fun_remove_encs f
| trm_app ?t1 ?t2 =>
match t1 with
| trm_app ?t11 ?t12 => xcf_get_fun_from_trm t1
| ?f => xcf_get_fun_remove_encs f
end
end.
Ltac xcf_get_fun_from_goal tt :=
match goal with |- triple ?t _ _ => xcf_get_fun_from_trm t end. match goal with |- triple ?t _ _ => xcf_get_fun_from_trm t end.
Ltac xcf_get_fun tt :=
xcf_get_fun_from_goal tt.
Ltac xcf_reveal_fun tt :=
try (let f := xcf_get_fun tt in
first [ unfold f
| match goal with H: f = _ |- _ => rewrite H end ]).
Ltac xcf_post tt := Ltac xcf_post tt :=
simpl. simpl.
Ltac xcf_trm n := Ltac xcf_trm n ::=
applys triple_trm_of_cf_iter n; [ xcf_post tt ]. applys triple_trm_of_cf_iter n; [ xcf_post tt ].
Ltac xcf_basic_fun n f' := Ltac xcf_basic_fun n f' ::=
let f := xcf_get_fun tt in let f := xcf_get_fun tt in
match f with match f with
| val_funs _ _ => (* TODO: use (apply (@..)) instead of applys? same in cflifted *) | val_funs _ _ => (* TODO: use (apply (@..)) instead of applys? same in cflifted *)
...@@ -497,79 +477,37 @@ Ltac xcf_basic_fun n f' := ...@@ -497,79 +477,37 @@ Ltac xcf_basic_fun n f' :=
| xcf_post tt ] | xcf_post tt ]
end. end.
Ltac xcf_prepare_args tt :=
rew_nary.
Ltac xcf_fun n :=
xcf_prepare_args tt;
let f' := xcf_get_fun tt in
xcf_reveal_fun tt;
rew_nary;
rew_vals_to_trms;
xcf_basic_fun n f'.
Ltac xcf_core n :=
intros; first [ xcf_fun n | xcf_trm n ].
Tactic Notation "xcf" :=
xcf_core 100%nat.
Tactic Notation "xcf_depth" constr(depth) :=
xcf_core depth.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xseq] *) (* ** Tactic [xseq] *)
Ltac xseq_core tt := Ltac xseq_core tt ::=
applys local_erase; esplit; split. applys local_erase; esplit; split.
Tactic Notation "xseq" :=
xseq_core tt.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xlet] *) (* ** Tactic [xlet] *)
Ltac xlet_core tt := Ltac xlet_core tt ::=
applys local_erase; esplit; split. applys local_erase; esplit; split.
Tactic Notation "xlet" :=
xlet_core tt.
Ltac xlet_as_core X :=
xlet_core tt; [ | intros X ].
Tactic Notation "xlet" "as" simple_intropattern(X) :=
xlet_as_core X.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xif] *) (* ** Tactic [xif] *)
Ltac xif_post tt := Ltac xif_core tt ::=
rew_bool_eq.
Ltac xif_core tt :=
applys local_erase; esplit; splits; applys local_erase; esplit; splits;
[ try reflexivity [ try reflexivity
| xif_post tt | xif_post tt
| xif_post tt ]. | xif_post tt ].
Tactic Notation "xif" :=
xif_core tt.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xfail] *) (* ** Tactic [xfail] *)
Ltac xfail_core tt := Ltac xfail_core tt ::=
applys local_erase; unfold cf_fail. applys local_erase; unfold cf_fail.
Tactic Notation "xfail" :=
xfail_core tt.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* * [xapp] and [xapps] and [xapp as] *) (* * [xapp] and [xapps] and [xapp as] *)
...@@ -588,19 +526,25 @@ Tactic Notation "xfail" := ...@@ -588,19 +526,25 @@ Tactic Notation "xfail" :=
*) *)
Ltac xapp_let_cont tt := Ltac hpull_cont tt ::=
try hpull.
Ltac hsimpl_cont tt ::=
hsimpl.
Ltac xapp_let_cont tt ::=
let X := fresh "X" in intros X; let X := fresh "X" in intros X;
instantiate; try xpull; gen X. instantiate; try xpull; gen X.
Ltac xapp_as_let_cont tt := Ltac xapp_as_let_cont tt ::=
instantiate; try xpull. instantiate; try xpull.
Ltac xapps_let_cont tt := Ltac xapps_let_cont tt ::=
let X := fresh "X" in intros X; let X := fresh "X" in intros X;
instantiate; try xpull; instantiate; try xpull;
first [ intro_subst | gen X ]. first [ intro_subst | gen X ].
Ltac xapp_template xlet_tactic xapp_tactic xlet_cont := Ltac xapp_template xlet_tactic xapp_tactic xlet_cont ::=
match goal with match goal with
| |- local (cf_let _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ] | |- local (cf_let _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ]
| |- local (cf_if _ _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ] | |- local (cf_if _ _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ]
...@@ -620,13 +564,7 @@ Ltac xapp_basic_prepare tt ::= ...@@ -620,13 +564,7 @@ Ltac xapp_basic_prepare tt ::=
try match goal with |- local _ _ _ => apply local_erase end; try match goal with |- local _ _ _ => apply local_erase end;
rew_nary. rew_nary.
Ltac hpull_cont tt := Ltac xapp_with_args E cont_xapply ::=
try hpull.
Ltac hsimpl_cont tt :=
hsimpl.
Ltac xapp_with_args E cont_xapply :=
match E with match E with
| __ => (* no spec provided *) | __ => (* no spec provided *)
let S := fresh "Spec" in let S := fresh "Spec" in
...@@ -647,75 +585,11 @@ Ltac xapp_with_args E cont_xapply := ...@@ -647,75 +585,11 @@ Ltac xapp_with_args E cont_xapply :=
end end
end. end.
Ltac xapp_basic E cont_post tt := Ltac xapp_basic E cont_post tt ::=
xapp_basic_prepare tt; xapp_basic_prepare tt;
xapp_with_args E ltac:(fun H => xapp_with_args E ltac:(fun H =>
xapp_xapply H cont_post). xapp_xapply H cont_post).
Ltac xapp_debug tt :=
xapp_basic_prepare tt;
xapp_with_args __ ltac:(fun H => generalize H).
Ltac xapp_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ idcont) ltac:(xapp_let_cont).
Ltac xapp_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E idcont) ltac:(xapp_let_cont).
Ltac xapp_as_core X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic __ idcont) ltac:(xapp_as_let_cont).
Ltac xapp_arg_as_core E X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic E idcont) ltac:(xapp_as_let_cont).
Ltac xapps_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ hpull_cont) ltac:(xapps_let_cont).
Ltac xapps_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E hpull_cont) ltac:(xapps_let_cont).
Tactic Notation "xapp" :=
xapp_core tt.
Tactic Notation "xapp" "~" :=
xapp; auto_tilde.
Tactic Notation "xapp" "*" :=
xapp; auto_star.
Tactic Notation "xapp" constr(E) :=
xapp_arg_core E.
Tactic Notation "xapp" "~" constr(E) :=
xapp E; auto_tilde.
Tactic Notation "xapp" "*" constr(E) :=
xapp E; auto_star.
Tactic Notation "xapps" :=
xapps_core tt.
Tactic Notation "xapps" "~" :=
xapps; auto_tilde.
Tactic Notation "xapps" "*" :=
xapps; auto_star.
Tactic Notation "xapps" constr(E) :=
xapps_arg_core E.
Tactic Notation "xapps" "~" constr(E) :=
xapps E; auto_tilde.
Tactic Notation "xapps" "*" constr(E) :=
xapps E; auto_star.
Tactic Notation "xapp" "as" simple_intropattern(X) :=
xapp_as_core X.
Tactic Notation "xapp" "~" "as" simple_intropattern(X) :=
xapp as X; auto_tilde.
Tactic Notation "xapp" "*" "as" simple_intropattern(X) :=
xapp as X; auto_star.
Tactic Notation "xapp" constr(E) "as" simple_intropattern(X) :=
xapp_arg_as_core E X.
Tactic Notation "xapp" "~" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_tilde.
Tactic Notation "xapp" "*" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_star.
(* TODO: xapps should do hsimpl if not in a let *) (* TODO: xapps should do hsimpl if not in a let *)
...@@ -762,42 +636,21 @@ Ltac xval_as_basic X EX := ...@@ -762,42 +636,21 @@ Ltac xval_as_basic X EX :=
| _ => applys xval_htop_as_lemma; intros X EX | _ => applys xval_htop_as_lemma; intros X EX
end. end.
Ltac xval_core tt := Ltac xval_core tt ::=
xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapp_let_cont). xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapp_let_cont).
Ltac xval_as_core X := Ltac xval_as_core X ::=
match goal with match goal with
| |- local (cf_val _) _ _ => let EX := fresh "E" X in xval_as_basic X EX | |- local (cf_val _) _ _ => let EX := fresh "E" X in xval_as_basic X EX
| _ => xval_template ltac:(fun tt => xlet as X) ltac:(xval_basic) ltac:(xapp_as_let_cont) | _ => xval_template ltac:(fun tt => xlet as X) ltac:(xval_basic) ltac:(xapp_as_let_cont)
end. end.
Ltac xvals_core tt := Ltac xvals_core tt ::=
match goal with match goal with
| |- local (cf_val _) _ _ => xval_basic tt; hsimpl | |- local (cf_val _) _ _ => xval_basic tt; hsimpl
| _ => xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapps_let_cont) | _ => xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapps_let_cont)
end. end.
Tactic Notation "xval" :=
xval_core tt.
Tactic Notation "xval" "~" :=
xval; auto_tilde.
Tactic Notation "xval" "*" :=
xval; auto_star.
Tactic Notation "xvals" :=
xvals_core tt.
Tactic Notation "xvals" "~" :=
xvals; auto_tilde.
Tactic Notation "xvals" "*" :=
xvals; auto_star.
Tactic Notation "xval" "as" simple_intropattern(X) :=
xval_as_core X.
Tactic Notation "xval" "~" "as" simple_intropattern(X) :=
xval as X; auto_tilde.
Tactic Notation "xval" "*" "as" simple_intropattern(X) :=
xval as X; auto_star.
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Tactic [xwhile] *) (* ** Tactic [xwhile] *)
...@@ -808,28 +661,21 @@ Ltac xwhile_template xwhile_tactic xseq_cont := ...@@ -808,28 +661,21 @@ Ltac xwhile_template xwhile_tactic xseq_cont :=
| _ => xwhile_tactic tt | _ => xwhile_tactic tt
end. end.
Ltac xwhile_intros_all R LR HR := Ltac xwhile_intros_all R LR HR ::=
intros R LR; hnf; intros HR. intros R LR; hnf; intros HR.
Ltac xwhile_intros R := Ltac xwhile_intros R ::=
let LR := fresh "L" R in let LR := fresh "L" R in
let HR := fresh "H" R in let HR := fresh "H" R in
xwhile_intros_all R LR HR. xwhile_intros_all R LR HR.
Ltac xwhile_basic xwhile_intros_tactic := Ltac xwhile_basic xwhile_intros_tactic ::=
applys local_erase; applys local_erase;
xwhile_intros_tactic tt. xwhile_intros_tactic tt.
Ltac xwhile_core xwhile_tactic := Ltac xwhile_core xwhile_tactic ::=
xwhile_template ltac:(xwhile_tactic) ltac:(fun tt => xpull). xwhile_template ltac:(xwhile_tactic) ltac:(fun tt => xpull).
Tactic Notation "xwhile" "as" ident(R) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros R)).
Tactic Notation "xwhile" "as" ident(R) ident(LR) ident(HR) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros_all R LR HR)).
(* ********************************************************************** *) (* ********************************************************************** *)
......
...@@ -13,7 +13,7 @@ License: MIT. ...@@ -13,7 +13,7 @@ License: MIT.
Set Implicit Arguments. Set Implicit Arguments.
From TLC Require Export LibCore. From TLC Require Export LibCore.
From Sep Require Export LambdaCF LambdaSepLifted. From Sep Require Export LambdaCF LambdaSepLifted.
Import LibList. From TLC Require Import LibList.
Generalizable Variables A B. Generalizable Variables A B.
Open Scope charac. Open Scope charac.
...@@ -404,6 +404,8 @@ Qed. ...@@ -404,6 +404,8 @@ Qed.
(* ********************************************************************** *) (* ********************************************************************** *)
(* * CFLifted tactics *) (* * CFLifted tactics *)
(** Extends tactics defined in [LambdaCFTactics.v] and [LambdaCF.v] *)
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* ** Registering specifications *) (* ** Registering specifications *)
......
This diff is collapsed.
(**
This file defines tactic notations useful for characteristic formulae
Author: Arthur Charguéraud.
License: MIT.
*)
Set Implicit Arguments.
From Sep Require Export LambdaSemantics.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xcf] *)
Ltac xcf_trm n :=
fail "not instantiated".
Ltac xcf_basic_fun n f' :=
fail "not instantiated".
Ltac xcf_get_fun_remove_encs f :=
constr:(f).
Ltac xcf_get_fun_from_trm t :=
match t with
| trm_apps (trm_val ?f) _ => xcf_get_fun_remove_encs f
| trm_app ?t1 ?t2 =>
match t1 with
| trm_app ?t11 ?t12 => xcf_get_fun_from_trm t1
| ?f => xcf_get_fun_remove_encs f
end
end.
Ltac xcf_get_fun_from_goal tt :=
fail "not instantiated".
Ltac xcf_get_fun tt :=
xcf_get_fun_from_goal tt.
Ltac xcf_reveal_fun tt :=
try (let f := xcf_get_fun tt in
first [ unfold f
| match goal with H: f = _ |- _ => rewrite H end ]).
Ltac xcf_prepare_args tt :=
rew_nary.
Ltac xcf_fun n :=
xcf_prepare_args tt;
let f' := xcf_get_fun tt in
xcf_reveal_fun tt;
rew_nary;
rew_vals_to_trms;
xcf_basic_fun n f'.
Ltac xcf_core n :=
intros; first [ xcf_fun n | xcf_trm n ].
Tactic Notation "xcf" :=
xcf_core 100%nat.
Tactic Notation "xcf_depth" constr(depth) :=
xcf_core depth.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xseq] *)
Ltac xseq_core tt :=
fail "not instantiated".
Tactic Notation "xseq" :=
xseq_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xlet] *)
Ltac xlet_core tt :=
fail "not instantiated".
Tactic Notation "xlet" :=
xlet_core tt.
Ltac xlet_as_core X :=
xlet_core tt; [ | intros X ].
Tactic Notation "xlet" "as" simple_intropattern(X) :=
xlet_as_core X.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xif] *)
Ltac xif_post tt :=
rew_bool_eq.
Ltac xif_core tt :=
fail "not instantiated".
Tactic Notation "xif" :=
xif_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xfail] *)
Ltac xfail_core tt :=
fail "not instantiated".
Tactic Notation "xfail" :=
xfail_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xapp] *)
Ltac hpull_cont tt :=
fail "not instantiated".
Ltac hsimpl_cont tt :=
fail "not instantiated".
Ltac xapp_let_cont tt :=
fail "not instantiated".
Ltac xapp_as_let_cont tt :=
fail "not instantiated".
Ltac xapps_let_cont tt :=
fail "not instantiated".
Ltac xapp_template xlet_tactic xapp_tactic xlet_cont :=
fail "not instantiated".
Ltac xapp_basic_prepare tt :=
fail "not instantiated".
Ltac xapp_with_args E cont_xapply :=
fail "not instantiated".
Ltac xapp_basic E cont_post tt :=
fail "not instantiated".
Ltac xapp_debug tt :=
xapp_basic_prepare tt;
xapp_with_args __ ltac:(fun H => generalize H).
Ltac xapp_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ idcont) ltac:(xapp_let_cont).
Ltac xapp_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E idcont) ltac:(xapp_let_cont).
Ltac xapp_as_core X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic __ idcont) ltac:(xapp_as_let_cont).
Ltac xapp_arg_as_core E X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic E idcont) ltac:(xapp_as_let_cont).
Ltac xapps_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ hpull_cont) ltac:(xapps_let_cont).
Ltac xapps_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E hpull_cont) ltac:(xapps_let_cont).
Tactic Notation "xapp" :=
xapp_core tt.
Tactic Notation "xapp" "~" :=
xapp; auto_tilde.
Tactic Notation "xapp" "*" :=
xapp; auto_star.
Tactic Notation "xapp" constr(E) :=
xapp_arg_core E.
Tactic Notation "xapp" "~" constr(E) :=
xapp E; auto_tilde.
Tactic Notation "xapp" "*" constr(E) :=
xapp E; auto_star.
Tactic Notation "xapps" :=
xapps_core tt.
Tactic Notation "xapps" "~" :=
xapps; auto_tilde.
Tactic Notation "xapps" "*" :=
xapps; auto_star.
Tactic Notation "xapps" constr(E) :=
xapps_arg_core E.
Tactic Notation "xapps" "~" constr(E) :=
xapps E; auto_tilde.
Tactic Notation "xapps" "*" constr(E) :=
xapps E; auto_star.
Tactic Notation "xapp" "as" simple_intropattern(X) :=
xapp_as_core X.
Tactic Notation "xapp" "~" "as" simple_intropattern(X) :=
xapp as X; auto_tilde.
Tactic Notation "xapp" "*" "as" simple_intropattern(X) :=
xapp as X; auto_star.
Tactic Notation "xapp" constr(E) "as" simple_intropattern(X) :=
xapp_arg_as_core E X.
Tactic Notation "xapp" "~" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_tilde.
Tactic Notation "xapp" "*" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_star.