(************************************************************************)
(*         *      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)         *)
(************************************************************************)
(** N.B.: Using this encoding of vectors is discouraged. See <https://github.com/coq/coq/blob/master/stdlib/theories/Vectors/Vector.v>. *)
Attributes warn(cats="stdlib vector", note="Using Vector.t is known to be technically difficult, see <https://github.com/coq/coq/blob/master/stdlib/theories/Vectors/Vector.v>.").
(** Definitions of Vectors and functions to use them  Initial Author: Pierre Boutillier Institution: PPS, INRIA 12/2010 *)
(** Names should be "caml name in list.ml" if exists and order of arguments have to be the same. complain if you see mistakes ... *)
#[local] Set Warnings "-stdlib-vector".
Require Vectors.Fin.
Local Open Scope nat_scope.
(* Set Universe Polymorphism. *)
(** A vector is a list of size n whose elements belong to a set A. *)
#[universes(template)]
Inductive t A : nat -> Type :=
|nil : t A 0
|cons : forall (h:A) (n:nat), t A n -> t A (S n).
Local Notation "[ ]" := (nil _) (format "[ ]").
Local Notation "h :: t" := (cons _ h _ t) (at level 60, right associativity).
Section SCHEMES.
(** An induction scheme for non-empty vectors *)
Definition rectS {A} (P:forall {n}, t A (S n) -> Type)
(bas: forall a: A, P (a :: []))
(rect: forall a {n} (v: t A (S n)), P v -> P (a :: v)) :=
fix rectS_fix {n} (v: t A (S n)) : P v :=
match v with
|@cons _ a 0 v =>
match v with
|nil _ => bas a
|_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end
|@cons _ a (S nn') v => rect a v (rectS_fix v)
|_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
(** A vector of length [0] is [nil] *)
Definition case0 {A} (P:t A 0 -> Type) (H:P (nil A)) v:P v :=
match v with
|[] => H
|_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
(** A vector of length [S _] is [cons] *)
Definition caseS {A} (P : forall {n}, t A (S n) -> Type)
(H : forall h {n} t, @P n (h :: t)) {n} (v: t A (S n)) : P v :=
match v with
|h :: t => H h t
|_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
Definition caseS' {A} {n : nat} (v : t A (S n)) : forall (P : t A (S n) -> Type)
(H : forall h t, P (h :: t)), P v :=
match v with
| h :: t => fun P H => H h t
| _ => fun devil => False_rect (@IDProp) devil
end.
(** An induction scheme for 2 vectors of same length *)
Definition rect2 {A B} (P:forall {n}, t A n -> t B n -> Type)
(bas : P [] []) (rect : forall {n v1 v2}, P v1 v2 ->
forall a b, P (a :: v1) (b :: v2)) :=
fix rect2_fix {n} (v1 : t A n) : forall v2 : t B n, P v1 v2 :=
match v1 with
| [] => fun v2 => case0 _ bas v2
| @cons _ h1 n' t1 => fun v2 =>
caseS' v2 (fun v2' => P (h1::t1) v2') (fun h2 t2 => rect (rect2_fix t1 t2) h1 h2)
end.
End SCHEMES.
Section BASES.
(** The first element of a non empty vector *)
Definition hd {A} := @caseS _ (fun n v => A) (fun h n t => h).
Global Arguments hd {A} {n} v.
(** The last element of an non empty vector *)
Definition last {A} := @rectS _ (fun _ _ => A) (fun a => a) (fun _ _ _ H => H).
Global Arguments last {A} {n} v.
(** Build a vector of n{^ th} [a] *)
Definition const {A} (a:A) := nat_rect _ [] (fun n x => cons _ a n x).
(** The [p]{^ th} element of a vector of length [m].  Computational behavior of this function should be the same as ocaml function. *)
Definition nth {A} :=
fix nth_fix {n : nat} (v : t A n) {struct v} : Fin.t n -> A :=
match v with
| nil _ => fun p => False_rect A (Fin.case0 _ p)
| cons _ x m v' => fun p =>
match p in (Fin.t m') return t A (pred m') -> A with
| Fin.F1 => fun _ => x
| Fin.FS p' => fun v' => nth_fix v' p'
end v'
end.
(** An equivalent definition of [nth]. *)
Definition nth_order {A} {n} (v: t A n) {p} (H: p < n) :=
(nth v (Fin.of_nat_lt H)).
(** Put [a] at the p{^ th} place of [v] *)
Fixpoint replace {A n} (v : t A n) (p: Fin.t n) (a : A) {struct p}: t A n :=
match p with
| @Fin.F1 k => fun v': t A (S k) => caseS' v' _ (fun h t => a :: t)
| @Fin.FS k p' => fun v' : t A (S k) =>
(caseS' v' (fun _ => t A (S k)) (fun h t => h :: (replace t p' a)))
end v.
(** Version of replace with [lt] *)
Definition replace_order {A n} (v: t A n) {p} (H: p < n) :=
replace v (Fin.of_nat_lt H).
(** Remove the first element of a non empty vector *)
Definition tl {A} := @caseS _ (fun n v => t A n) (fun h n t => t).
Global Arguments tl {A} {n} v.
(** Destruct a non empty vector *)
Definition uncons {A} {n : nat} (v : t A (S n)) : A * t A n := (hd v, tl v).
(** Remove last element of a non-empty vector *)
Definition shiftout {A} := @rectS _ (fun n _ => t A n) (fun a => [])
(fun h _ _ H => h :: H).
Global Arguments shiftout {A} {n} v.
(** Add an element at the end of a vector *)
Fixpoint shiftin {A} {n:nat} (a : A) (v:t A n) : t A (S n) :=
match v with
|[] => a :: []
|h :: t => h :: (shiftin a t)
end.
(** Copy last element of a vector *)
Definition shiftrepeat {A} := @rectS _ (fun n _ => t A (S (S n)))
(fun h =>  h :: h :: []) (fun h _ _ H => h :: H).
Global Arguments shiftrepeat {A} {n} v.
(** Take first [p] elements of a vector *)
Fixpoint take {A} {n} (p:nat) (le:p <= n) (v:t A n) : t A p :=
match p as p return p <= n -> t A p with
| 0 => fun _ => []
| S p' => match v in t _ n return S p' <= n -> t A (S p') with
| []=> fun le => False_rect _ (Nat.nle_succ_0 p' le)
| x::xs => fun le => x::take p' (le_S_n p' _ le) xs
end
end le.

(* Specifications: *)
(** Remove [p] last elements of a vector *)
Lemma trunc : forall {A} {n} (p:nat), n > p -> t A n
-> t A (n - p).