(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
Require Arith_base.
(** N.B.: This file defines a dependently-type programming view of bounded integers. Another popular approach is to bundle integers with a proof of boundedness, thus inheriting integer arithmetic rather than redefining it on the bounded type. See https://github.com/coq/coq/blob/master/stdlib/theories/Vectors/Vector.v for a similar discussion on bounded lists.  An alternative implementation can be found for instance in https://github.com/math-comp/math-comp/blob/master/mathcomp/ssreflect/fintype.v One can read more about this type in section 7.4 of this book: https://zenodo.org/record/4282710#.X_q4aGso-yU . *)
Attributes warn(cats="stdlib vector", note="Alternatives to Fin.t are available, see <https://github.com/coq/coq/blob/master/stdlib/theories/Vectors/Fin.v>.").
(** [fin n] is a way to represent \[1 .. n\]  [fin n] can be seen as a n-uplet of unit. [F1] is the first element of the n-uplet. If [f] is the k-th element of the (n-1)-uplet, [FS f] is the (k+1)-th element of  the n-uplet.  Author: Pierre Boutillier Institution: PPS, INRIA 12/2010-01/2012-07/2012 *)
Inductive t : nat -> Set :=
|F1 : forall {n}, t (S n)
|FS : forall {n}, t n -> t (S n).
Section SCHEMES.
Definition case0 P (p: t 0): P p :=
match p with | F1 | FS  _ => fun devil => False_rect (@ID) devil (* subterm !!! *) end.
Definition caseS' {n : nat} (p : t (S n)) : forall (P : t (S n) -> Type)
(P1 : P F1) (PS : forall (p : t n), P (FS p)), P p :=
match p with
| @F1 k => fun P P1 PS => P1
| FS pp => fun P P1 PS => PS pp
end.
Definition caseS (P: forall {n}, t (S n) -> Type)
(P1: forall n, @P n F1) (PS : forall {n} (p: t n), P (FS p))
{n} (p: t (S n)) : P p := caseS' p P (P1 n) PS.
Definition rectS (P: forall {n}, t (S n) -> Type)
(P1: forall n, @P n F1) (PS : forall {n} (p: t (S n)), P p -> P (FS p)):
forall {n} (p: t (S n)), P p :=
fix rectS_fix {n} (p: t (S n)): P p:=
match p with
| @F1 k => P1 k
| @FS 0 pp => case0 (fun f => P (FS f)) pp
| @FS (S k) pp => PS pp (rectS_fix pp)
end.
Definition rect2 (P : forall {n} (a b : t n), Type)
(H0 : forall n, @P (S n) F1 F1)
(H1 : forall {n} (f : t n), P F1 (FS f))
(H2 : forall {n} (f : t n), P (FS f) F1)
(HS : forall {n} (f g : t n), P f g -> P (FS f) (FS g)) :
forall {n} (a b : t n), P a b :=
fix rect2_fix {n} (a : t n) {struct a} : forall (b : t n), P a b :=
match a with
| @F1 m => fun (b : t (S m)) => caseS' b (P F1) (H0 _) H1
| @FS m a' => fun (b : t (S m)) =>
caseS' b (fun b => P (@FS m a') b) (H2 a') (fun b' => HS _ _ (rect2_fix a' b'))
end.
End SCHEMES.
Definition FS_inj {n} (x y: t n) (eq: FS x = FS y): x = y :=
match eq in _ = a return
match a as a' in t m return match m with |0 => Prop |S n' => t n' -> Prop end
with F1 =>  fun _ => True |FS y => fun x' => x' = y end x with
eq_refl => eq_refl
end.
(** [to_nat f] = p iff [f] is the p{^ th} element of [fin m]. *)
Fixpoint to_nat {m} (n : t m) : {i | i < m} :=
match n with
|@F1 j => exist _ 0 (Nat.lt_0_succ j)
|FS p => match to_nat p with |exist _ i P => exist _ (S i) (proj1 (Nat.succ_lt_mono _ _) P) end
end.
(** [of_nat p n] answers the p{^ th} element of [fin n] if p < n or a proof of p >= n else *)
Fixpoint of_nat (p n : nat) : (t n) + { exists m, p = n + m } :=
match n with
|0 => inright _ (ex_intro _ p eq_refl)
|S n' => match p with
|0 => inleft _ (F1)
|S p' => match of_nat p' n' with
|inleft f => inleft _ (FS f)
|inright arg => inright _ (match arg with |ex_intro _ m e =>
ex_intro (fun x => S p' = S n' + x) m (f_equal S e) end)
end
end
end.
(** [of_nat_lt p n H] answers the p{^ th} element of [fin n] it behaves much better than [of_nat p n] on open term *)
Fixpoint of_nat_lt {p n : nat} : p < n -> t n :=
match n with
|0 => fun H : p < 0 => False_rect _ (PeanoNat.Nat.nlt_0_r p H)
|S n' => match p with
|0 => fun _ => @F1 n'
|S p' => fun H => FS (of_nat_lt (proj2 (Nat.succ_lt_mono _ _) H))
end
end.

(* Specifications: *)
Lemma of_nat_ext {p}{n} (h h' : p < n) : of_nat_lt h = of_nat_lt h'.
Lemma of_nat_to_nat_inv {m} (p : t m) : of_nat_lt (proj2_sig (to_nat p)) = p.
Lemma to_nat_of_nat {p}{n} (h : p < n) : to_nat (of_nat_lt h) = exist _ p h.
Lemma to_nat_inj {n} (p q : t n) :
proj1_sig (to_nat p) = proj1_sig (to_nat q) -> p = q.