(** * LibTactics: A Collection of Handy General-Purpose Tactics *)
(** This file has been copied from "Programming Language Foundations", a textbook from the "Software Foundations" series. The origin of this file seems to be https://github.com/charguer/tlc – with Arthur Charguéraud being the original author. See LICENSE-LibTactics. *)
(** Some changes have been introduced for the purposes of BusyCoq: - the [>>] notation has been marked [Local]. *)
(** This file contains a set of tactics that extends the set of builtin tactics provided with the standard distribution of Coq. It intends to overcome a number of limitations of the standard set of tactics, and thereby to help user to write shorter and more robust scripts.  Hopefully, Coq tactics will be improved as time goes by, and this file should ultimately be useless. In the meanwhile, serious Coq users will probably find it very useful.  The present file contains the implementation and the detailed documentation of those tactics. The SF reader need not read this file; instead, he/she is encouraged to read the chapter named UseTactics.v, which is gentle introduction to the most useful tactics from the LibTactic library. *)
(** The main features offered are: - More convenient syntax for naming hypotheses, with tactics for introduction and inversion that take as input only the name of hypotheses of type [Prop], rather than the name of all variables. - Tactics providing true support for manipulating N-ary conjunctions, disjunctions and existentials, hidding the fact that the underlying implementation is based on binary propositions. - Convenient support for automation: tactics followed with the symbol "~" or "*" will call automation on the generated subgoals. The symbol "~" stands for [auto] and "*" for [intuition eauto]. These bindings can be customized. - Forward-chaining tactics are provided to instantiate lemmas either with variable or hypotheses or a mix of both. - A more powerful implementation of [apply] is provided (it is based on [refine] and thus behaves better with respect to conversion). - An improved inversion tactic which substitutes equalities on variables generated by the standard inversion mecanism. Moreover, it supports the elimination of dependently typed equalities (requires axiom [K], which is a weak form of Proof Irrelevance). - Tactics for saving time when writing proofs, with tactics to asserts hypotheses or sub-goals, and improved tactics for clearing, renaming, and sorting hypotheses. *)
(** External credits: - thanks to Xavier Leroy for providing the idea of tactic [forward] - thanks to Georges Gonthier for the implementation trick in [rapply] *)
Set Implicit Arguments.
Declare Scope ltac_scope.
(* ################################################################# *)
(** * Fixing Stdlib *)
(* Very important to remove hint trans_eq_bool from LibBool, otherwise eauto slows down dramatically: Lemma test : forall b, b = false. time eauto 7. (* takes over 4 seconds to fail! *) *)
#[global]
Remove Hints Bool.trans_eq_bool : core.
(* ################################################################# *)
(** * Tools for Programming with Ltac *)
(* ================================================================= *)
(** ** Identity Continuation *)
Ltac idcont tt :=
idtac.
(* ================================================================= *)
(** ** Untyped Arguments for Tactics *)
(** Any Coq value can be boxed into the type [Boxer]. This is useful to use Coq computations for implementing tactics. *)
Inductive Boxer : Type :=
| boxer : forall (A:Type), A -> Boxer.
(* ================================================================= *)
(** ** Optional Arguments for Tactics  *)
(** [ltac_no_arg] is a constant that can be used to simulate optional arguments in tactic definitions. Use [mytactic ltac_no_arg] on the tactic invokation, and use [match arg with ltac_no_arg => ..] or [match type of arg with ltac_No_arg  => ..] to test whether an argument was provided. *)
Inductive ltac_No_arg : Set :=
| ltac_no_arg : ltac_No_arg.
(* ================================================================= *)
(** ** Wildcard Arguments for Tactics  *)
(** [ltac_wild] is a constant that can be used to simulate wildcard arguments in tactic definitions. Notation is [__]. *)
Inductive ltac_Wild : Set :=
| ltac_wild : ltac_Wild.
Notation "'__'" := ltac_wild : ltac_scope.
(** [ltac_wilds] is another constant that is typically used to simulate a sequence of [N] wildcards, with [N] chosen appropriately depending on the context. Notation is [___]. *)
Inductive ltac_Wilds : Set :=
| ltac_wilds : ltac_Wilds.
Notation "'___'" := ltac_wilds : ltac_scope.
Open Scope ltac_scope.
(* ================================================================= *)
(** ** Position Markers *)
(** [ltac_Mark] and [ltac_mark] are dummy definitions used as sentinel by tactics, to mark a certain position in the context or in the goal. *)
Inductive ltac_Mark : Type :=
| ltac_mark : ltac_Mark.
(** [gen_until_mark] repeats [generalize] on hypotheses from the context, starting from the bottom and stopping as soon as reaching an hypothesis of type [Mark]. If fails if [Mark] does not appear in the context. *)
Ltac gen_until_mark :=
match goal with H: ?T |- _ =>
match T with
| ltac_Mark => clear H
| _ => generalize H; clear H; gen_until_mark
end end.
(** [gen_until_mark_with_processing F] is similar to [gen_until_mark] except that it calls [F] on each hypothesis immediately before generalizing it. This is useful for processing the hypotheses. *)
Ltac gen_until_mark_with_processing cont :=
match goal with H: ?T |- _ =>
match T with
| ltac_Mark => clear H
| _ => cont H; generalize H; clear H;
gen_until_mark_with_processing cont
end end.
(** [intro_until_mark] repeats [intro] until reaching an hypothesis of type [Mark]. It throws away the hypothesis [Mark]. It fails if [Mark] does not appear as an hypothesis in the goal. *)
Ltac intro_until_mark :=
match goal with
| |- (ltac_Mark -> _) => intros _
| _ => intro; intro_until_mark
end.
(* ================================================================= *)
(** ** List of Arguments for Tactics  *)
(** A datatype of type [list Boxer] is used to manipulate list of Coq values in ltac. Notation is [>> v1 v2 ... vN] for building a list containing the values [v1] through [vN]. *)
(* Note: could attempt the use of a recursive notation *)
Local Notation "'>>'" :=
(@nil Boxer)
(at level 0)
: ltac_scope.
Local Notation "'>>' v1" :=
((boxer v1)::nil)
(at level 0, v1 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2" :=
((boxer v1)::(boxer v2)::nil)
(at level 0, v1 at level 0, v2 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3" :=
((boxer v1)::(boxer v2)::(boxer v3)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::(boxer v12)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0,
v12 at level 0)
: ltac_scope.
Local Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::(boxer v12)::(boxer v13)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0,
v12 at level 0, v13 at level 0)
: ltac_scope.
(** The tactic [list_boxer_of] inputs a term [E] and returns a term of type "list boxer", according to the following rules: - if [E] is already of type "list Boxer", then it returns [E]; - otherwise, it returns the list [(boxer E)::nil]. *)
Ltac list_boxer_of E :=
match type of E with
| List.list Boxer => constr:(E)
| _ => constr:((boxer E)::nil)
end.
(* ================================================================= *)
(** ** Databases of Lemmas  *)
(** Use the hint facility to implement a database mapping terms to terms. To declare a new database, use a definition: [Definition mydatabase := True.]  Then, to map [mykey] to [myvalue], write the hint: [Hint Extern 1 (Register mydatabase mykey) => Provide myvalue.]  Finally, to query the value associated with a key, run the tactic [ltac_database_get mydatabase mykey]. This will leave at the head of the goal the term [myvalue]. It can then be named and exploited using [intro]. *)
Inductive Ltac_database_token : Prop := ltac_database_token.
Definition ltac_database (D:Boxer) (T:Boxer) (A:Boxer) := Ltac_database_token.
Notation "'Register' D T" := (ltac_database (boxer D) (boxer T) _)
(at level 69, D at level 0, T at level 0).
Proof using. split. Qed.
Ltac Provide T := apply (@ltac_database_provide (boxer T)).
Ltac ltac_database_get D T :=
let A := fresh "TEMP" in evar (A:Boxer);
let H := fresh "TEMP" in
assert (H : ltac_database (boxer D) (boxer T) A);
[ subst A; auto
| subst A; match type of H with ltac_database _ _ (boxer ?L) =>
generalize L end; clear H ].
(* Note for a possible alternative implementation of the ltac_database_token: Inductive Ltac_database : Type := | ltac_database : forall A, A -> Ltac_database. Implicit Arguments ltac_database [A]. *)
(* ================================================================= *)
(** ** On-the-Fly Removal of Hypotheses *)
(** In a list of arguments [>> H1 H2 .. HN] passed to a tactic such as [lets] or [applys] or [forwards] or [specializes], the term [rm], an identity function, can be placed in front of the name of an hypothesis to be deleted. *)
Definition rm (A:Type) (X:A) := X.
(** [rm_term E] removes one hypothesis that admits the same type as [E]. *)
Ltac rm_term E :=
let T := type of E in
match goal with H: T |- _ => try clear H end.
(** [rm_inside E] calls [rm_term Ei] for any subterm of the form [rm Ei] found in E *)
Ltac rm_inside E :=
let go E := rm_inside E in
match E with
| rm ?X => rm_term X
| ?X1 ?X2 =>
go X1; go X2
| ?X1 ?X2 ?X3 =>
go X1; go X2; go X3
| ?X1 ?X2 ?X3 ?X4 =>
go X1; go X2; go X3; go X4
| ?X1 ?X2 ?X3 ?X4 ?X5 =>
go X1; go X2; go X3; go X4; go X5
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 =>
go X1; go X2; go X3; go X4; go X5; go X6
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 ?X10 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9; go X10
| _ => idtac
end.
(** For faster performance, one may deactivate [rm_inside] by replacing the body of this definition with [idtac]. *)
Ltac fast_rm_inside E :=
rm_inside E.
(* ================================================================= *)
(** ** Numbers as Arguments *)
(** When tactic takes a natural number as argument, it may be parsed either as a natural number or as a relative number. In order for tactics to convert their arguments into natural numbers, we provide a conversion tactic.  Note: the tactic [number_to_nat] is extended in [LibInt] to take into account the [Z] type. *)
Require Coq.Numbers.BinNums Coq.ZArith.BinInt.
Definition ltac_int_to_nat (x:BinInt.Z) : nat :=
match x with
| BinInt.Z0 => 0%nat
| BinInt.Zpos p => BinPos.nat_of_P p
| BinInt.Zneg p => 0%nat
end.
Ltac number_to_nat N :=
match type of N with
| nat => constr:(N)
| BinInt.Z => let N' := constr:(ltac_int_to_nat N) in eval compute in N'
end.
(** [ltac_pattern E at K] is the same as [pattern E at K] except that [K] is a Coq number (nat or Z) rather than a Ltac integer. Syntax [ltac_pattern E as K in H] is also available. *)
Tactic Notation "ltac_pattern" constr(E) "at" constr(K) :=
match number_to_nat K with
| 1 => pattern E at 1
| 2 => pattern E at 2
| 3 => pattern E at 3
| 4 => pattern E at 4
| 5 => pattern E at 5
| 6 => pattern E at 6
| 7 => pattern E at 7
| 8 => pattern E at 8
| _ => fail "ltac_pattern: arity not supported"
end.
Tactic Notation "ltac_pattern" constr(E) "at" constr(K) "in" hyp(H) :=
match number_to_nat K with
| 1 => pattern E at 1 in H
| 2 => pattern E at 2 in H
| 3 => pattern E at 3 in H
| 4 => pattern E at 4 in H
| 5 => pattern E at 5 in H
| 6 => pattern E at 6 in H
| 7 => pattern E at 7 in H
| 8 => pattern E at 8 in H
| _ => fail "ltac_pattern: arity not supported"
end.
(** [ltac_set (x := E) at K] is the same as [set (x := E) at K] except that [K] is a Coq number (nat or Z) rather than a Ltac integer. *)
Tactic Notation "ltac_set" "(" ident(X) ":=" constr(E) ")" "at" constr(K) :=
match number_to_nat K with
| 1%nat => set (X := E) at 1
| 2%nat => set (X := E) at 2
| 3%nat => set (X := E) at 3
| 4%nat => set (X := E) at 4
| 5%nat => set (X := E) at 5
| 6%nat => set (X := E) at 6
| 7%nat => set (X := E) at 7
| 8%nat => set (X := E) at 8
| 9%nat => set (X := E) at 9
| 10%nat => set (X := E) at 10
| 11%nat => set (X := E) at 11
| 12%nat => set (X := E) at 12
| 13%nat => set (X := E) at 13
| _ => fail "ltac_set: arity not supported"
end.
(* ================================================================= *)
(** ** Testing Tactics *)
(** [show tac] executes a tactic [tac] that produces a result, and then display its result. *)
Tactic Notation "show" tactic(tac) :=
let R := tac in pose R.
(** [dup N] produces [N] copies of the current goal. It is useful for building examples on which to illustrate behaviour of tactics. [dup] is short for [dup 2]. *)

Lemma dup_lemma : forall P, P -> P -> P.