(* ********************************************************************** *)
(** * N-ary Conjunctions and Disjunctions *)

(* ---------------------------------------------------------------------- *)
(** N-ary Conjunctions Splitting in Goals *)

(** Underlying implementation of [splits]. *)

Ltac splits_tactic N :=
  match N with
  | O => fail
  | S O => idtac
  | S ?N' => split; [| splits_tactic N']
  end.Ltac unfold_goal_until_conjunction :=
  match goal with
  | |- _ /\ _ => idtac
  | _ => progress(unfolds); unfold_goal_until_conjunction
  end.Ltac get_term_conjunction_arity T :=
  match T with
  | _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(8)
  | _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(7)
  | _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(6)
  | _ /\ _ /\ _ /\ _ /\ _ => constr:(5)
  | _ /\ _ /\ _ /\ _ => constr:(4)
  | _ /\ _ /\ _ => constr:(3)
  | _ /\ _ => constr:(2)
  | _ -> ?T' => get_term_conjunction_arity T'
  | _ => let P := get_head T in
         let T' := eval unfold P in T in
         match T' with
         | T => fail 1
         | _ => get_term_conjunction_arity T'
         end
         (* todo: warning this can loop... *)
  end.Ltac get_goal_conjunction_arity :=
  match goal with |- ?T => get_term_conjunction_arity T end.(** [splits_all] will recursively split any conjunction, unfolding
    definitions when necessary. Warning: this tactic will loop
    on goals of the form [well_founded R]. Todo: fix this *)

Ltac splits_all_base := repeat split.(* ---------------------------------------------------------------------- *)
(** N-ary Conjunctions Deconstruction *)

(** Underlying implementation of [destructs]. *)

Ltac destructs_conjunction_tactic N T :=
  match N with
  | 2 => destruct T as [? ?]
  | 3 => destruct T as [? [? ?]]
  | 4 => destruct T as [? [? [? ?]]]
  | 5 => destruct T as [? [? [? [? ?]]]]
  | 6 => destruct T as [? [? [? [? [? ?]]]]]
  | 7 => destruct T as [? [? [? [? [? [? ?]]]]]]
  end.Ltac unfold_goal_until_disjunction :=
  match goal with
  | |- _ \/ _ => idtac
  | _ => progress(unfolds); unfold_goal_until_disjunction
  end.Ltac get_term_disjunction_arity T :=
  match T with
  | _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(8)
  | _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(7)
  | _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(6)
  | _ \/ _ \/ _ \/ _ \/ _ => constr:(5)
  | _ \/ _ \/ _ \/ _ => constr:(4)
  | _ \/ _ \/ _ => constr:(3)
  | _ \/ _ => constr:(2)
  | _ -> ?T' => get_term_disjunction_arity T'
  | _ => let P := get_head T in
         let T' := eval unfold P in T in
         match T' with
         | T => fail 1
         | _ => get_term_disjunction_arity T'
         end
  end.Ltac get_goal_disjunction_arity :=
  match goal with |- ?T => get_term_disjunction_arity T end.(* ---------------------------------------------------------------------- *)
(** N-ary Disjunction Deconstruction *)

(** Underlying implementation of [branches]. *)

Ltac destructs_disjunction_tactic N T :=
  match N with
  | 2 => destruct T as [? | ?]
  | 3 => destruct T as [? | [? | ?]]
  | 4 => destruct T as [? | [? | [? | ?]]]
  | 5 => destruct T as [? | [? | [? | [? | ?]]]]
  end.(* ---------------------------------------------------------------------- *)
(** N-ary Existentials *)

(* Underlying implementation of [exists]. *)

Ltac get_term_existential_arity T :=
  match T with
  | exists x1 x2 x3 x4 x5 x6 x7 x8, _ => constr:(8)
  | exists x1 x2 x3 x4 x5 x6 x7, _ => constr:(7)
  | exists x1 x2 x3 x4 x5 x6, _ => constr:(6)
  | exists x1 x2 x3 x4 x5, _ => constr:(5)
  | exists x1 x2 x3 x4, _ => constr:(4)
  | exists x1 x2 x3, _ => constr:(3)
  | exists x1 x2, _ => constr:(2)
  | exists x1, _ => constr:(1)
  | _ -> ?T' => get_term_existential_arity T'
  | _ => let P := get_head T in
         let T' := eval unfold P in T in
         match T' with
         | T => fail 1
         | _ => get_term_existential_arity T'
         end
  end.Ltac get_goal_existential_arity :=
  match goal with |- ?T => get_term_existential_arity T end.(* ---------------------------------------------------------------------- *)
(** Existentials and conjunctions in hypotheses *)

(** todo: doc *)

Ltac intuit_core :=
  repeat match goal with
  | H: _ /\ _ |- _ => destruct H
  | H: exists a, _ |- _ => destruct H
  end.Ltac intuit_from H :=
  first [ progress (intuit_core)
        | destruct H; intuit_core ].(* ********************************************************************** *)
(** * Tactics to invoke automation *)

(* ---------------------------------------------------------------------- *)
(** ** [jauto], a new automation tactics *)

(** [jauto] is better at [intuition eauto] because it can open existentials
    from the context. In the same time, [jauto] can be faster than
    [intuition eauto] because it does not destruct disjunctions from the
    context. The strategy of [jauto] can be summarized as follows:
    - open all the existentials and conjunctions from the context
    - call esplit and split on the existentials and conjunctions in the goal
    - call eauto. *)

Ltac jauto_set_hyps :=
  repeat match goal with H: ?T |- _ =>
    match T with
    | _ /\ _ => destruct H
    | exists a, _ => destruct H
    | _ => generalizes H
    end
  end.Ltac jauto_set_goal :=
  repeat match goal with
  | |- exists a, _ => esplit
  | |- _ /\ _ => split
  end.Ltac jauto_set :=
  intros; jauto_set_hyps;
  intros; jauto_set_goal;
  unfold not in *.(* ---------------------------------------------------------------------- *)
(** ** Definitions of automation tactics *)

(** The two following tactics defined the default behaviour of
    "light automation" and "strong automation". These tactics
    may be redefined at any time using the syntax [Ltac .. ::= ..]. *)

(** [auto_tilde] is the tactic which will be called each time a symbol
    [~] is used after a tactic. *)

Ltac auto_tilde_default := auto.Ltac auto_tilde := auto_tilde_default.(** [auto_star] is the tactic which will be called each time a symbol
    [*] is used after a tactic. *)

Ltac auto_star_default := try solve [ auto | eauto | intuition eauto ].(* TODO: should be jauto *)
Ltac auto_star := auto_star_default.(* ********************************************************************** *)
(** * Tactics to sort out the proof context *)

(* ---------------------------------------------------------------------- *)
(** ** Hiding hypotheses *)

(* Implementation *)

Definition ltac_something (P:Type) (e:P) := e.

(* Specifications: *)
Lemma ltac_something_eq : forall (e:Type), e = (@ltac_something _ e).
Lemma ltac_something_hide : forall (e:Type), e -> (@ltac_something _ e).
Lemma ltac_something_show : forall (e:Type), (@ltac_something _ e) -> e.