(** * Various generic lemmas that aren't present in the standard library *)
From BusyCoq Require Export LibTactics.
Set Default Goal Selector "!".
(* We are currently in a deprecation cycle where this gets changed from [auto with *] to [auto]. Opt in to silence the warning. *)
Ltac Tauto.intuition_solver ::= auto.
(* sig *)
Notation "[: x :]" := (exist _ x _).
(* sumbool *)
Notation Yes := (left _ _).
Notation No := (right _ _).
Notation Reduce x := (if x then Yes else No).
Notation "a && b" := (if a then b else No).
(* sumor *)
Notation "!!" := (inright _).
Notation "[|| x ||]" := (inleft [: x :]).
Notation "'bind' x <- a ; b" := (match a with | [|| x ||] => b | !! => No end)
(right associativity, at level 60, x pattern).
Notation "'bind' x <-- a ; b" := (match a with | [|| x ||] => b | !! => !! end)
(right associativity, at level 60, x pattern).
Fixpoint lpow {A} (l : list A) (n : nat) : list A :=
match n with
| O => []
| S n => l ++ lpow l n
end.
Notation "l ^^ n" := (lpow l n) (at level 20).
#[export] Hint Rewrite firstn_nil skipn_nil skipn_all firstn_all
firstn_app_2 : list.
(** We define our own [reflect] in [Prop] instead of [Set], as we don't want it to occur in the extracted programs. *)
Inductive reflect (P : Prop) : bool -> Prop :=
| ReflectT : P -> reflect P true
| ReflectF : ~ P -> reflect P false.
#[global]
Hint Constructors reflect : core.
Fixpoint Str_app {A} (xs : list A) (ys : Stream A) : Stream A :=
match xs with
| [] => ys
| x :: xs => Cons x (Str_app xs ys)
end.
(** Notation for tapes *)
Notation "s >> r" := (Cons s r) (at level 25, right associativity).
Notation "l << s" := (Cons s l) (at level 24, left associativity, only parsing).
Notation "s :> r" := (s :: r) (at level 25, right associativity, only parsing).
Notation "l <: s" := (s :: l) (at level 24, left associativity, only parsing).
Notation "xs +> r" := (xs ++ r) (at level 25, right associativity, only parsing).
Notation "l <+ xs" := (xs ++ l) (at level 24, left associativity, only parsing).
Notation "xs *> r" := (Str_app xs r) (at level 25, right associativity).
Notation "l <* xs" := (Str_app xs l) (at level 24, left associativity, only parsing).
Notation "< [ ]" := nil (only parsing).
Notation "< [ x ; .. ; y ]" := (cons y .. (cons x []) ..) (only parsing).
(* Heterogenous addition *)
Definition het_add (a : N) (b : positive) : positive :=
match a with
| N0 => b
| Npos a => a + b
end.
Notation "a :+ b" := (het_add a b)  (at level 50, left associativity).
#[global] Instance Op_het_add : BinOp het_add :=
{ TBOp := Z.add; TBOpInj := het_add_Z }.
Add Zify BinOp Op_het_add.
#[global] Instance Op_nat_div2 : UnOp div2 :=
{ TUOp x := (x / 2)%Z;
TUOpInj x := ltac:(now rewrite div2_div, Nat2Z.inj_div) }.
Add Zify UnOp Op_nat_div2.

(* Make [lia]/[nia] more powerful *)
Lemma length_gt0_if_not_nil : forall A (xs : list A),
[] <> xs -> length xs <> 0.