(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)
(* Require Import Arith Omega Max List. *)
Set Implicit Arguments.
Section vector.
Variable X : Type.
Inductive vec : nat -> Type :=
| vec_nil  : vec 0
| vec_cons : forall n, X -> vec n -> vec (S n).
Let vec_decomp_type n :=
match n with
| 0   => Prop
| S n => (X * vec n)%type
end.
Definition vec_decomp n (v : vec n) :=
match v in vec k return vec_decomp_type k with
| vec_nil  => False
| @vec_cons n x v => (x,v)
end.
Definition vec_head n (v : vec (S n)) := match v with @vec_cons _ x _ => x end.
Definition vec_tail n (v : vec (S n)) := match v with @vec_cons _ _ w => w end.
Let vec_head_tail_type n : vec n -> Prop :=
match n with
| 0   => fun v => v = vec_nil
| S n => fun v => v = vec_cons (vec_head v) (vec_tail v)
end.
Let vec_head_tail_prop n v :  @vec_head_tail_type n v.
Fact vec_pos_tail n (v : vec (S n)) p : vec_pos (vec_tail v) p = vec_pos v (pos_nxt p).
Fact vec_pos1 n (v : vec (S (S n))) : vec_pos v pos1 = vec_head (vec_tail v).
Fact vec_pos_ext n (v w : vec n) : (forall p, vec_pos v p = vec_pos w p) -> v = w.
Fixpoint vec_set_pos n : (pos n -> X) -> vec n :=
match n return (pos n -> X) -> vec n with
| 0   => fun _ => vec_nil
| S n => fun g => vec_cons (g pos0) (vec_set_pos (fun p => g (pos_nxt p)))
end.
Fact vec_pos_set n (g : pos n -> X) p : vec_pos (vec_set_pos g) p = g p.
Fixpoint vec_change n (v : vec n) : pos n -> X -> vec n.
Fact vec_change_neq n v p q x : p <> q -> vec_pos (@vec_change n v p x) q = vec_pos v q.
Fact vec_change_idem n v p x y : vec_change (@vec_change n v p x) p y = vec_change v p y.
Fact vec_change_same n v p : @vec_change n v p (vec_pos v p) = v.
Variable eq_X_dec : forall x y : X, { x = y } + { x <> y }.
Fixpoint vec_eq_dec n (u v : vec n) : { u = v } + { u <> v }.
End vector.
(* notations *)
Arguments vec_nil { X }.
Infix "##" := vec_cons (at level 60, right associativity).
Section vec_app_split.
Variable (X : Type) (n m : nat).
Definition vec_app (v : vec X n) (w : vec X m) : vec X (n+m).
Fact vec_split_app v w : vec_split (vec_app v w) = (v,w).
Fact vec_pos_app_left v w i : vec_pos (vec_app v w) (pos_left _ i) = vec_pos v i.
Fact vec_app_cons X n m x v w : @vec_app X (S n) m (x##v) w = x##vec_app v w.
Section vec_map.
Variable (X Y : Type) (f : X -> Y).
Fixpoint vec_map n (v : vec X n) :=
match v with
| vec_nil => vec_nil
| x ## v  => f x ## vec_map v
end.
End vec_map.
Section vec_map2.
(* Definitions taken from stdlib *)
Definition case0 {A} (P:vec A 0 -> Type) (H:P (@vec_nil A)) v:P v :=
match v with
|vec_nil => H
|_ => fun devil => False_ind (@IDProp) devil (* subterm !!! *)
end.
Definition caseS' {A} {n : nat} (v : vec A (S n)) : forall (P : vec 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.
Definition rect2 {A B} (P:forall {n}, vec A n -> vec B n -> Type)
(bas : P vec_nil vec_nil) (recvec : forall {n v1 v2}, P v1 v2 ->
forall a b, P (a ## v1) (b ## v2)) :=
fix rect2_fix {n} (v1 : vec A n) : forall v2 : vec B n, P v1 v2 :=
match v1 with
| vec_nil => fun v2 => case0 _ bas v2
| @vec_cons _ n' h1 t1 => fun v2 =>
caseS' v2 (fun v2' => P (h1##t1) v2') (fun h2 t2 => recvec (rect2_fix t1 t2) h1 h2)
end.
Definition vec_map2 {A B C} (g:A -> B -> C) :
forall (n : nat), vec A n -> vec B n -> vec C n :=
@rect2 _ _ (fun n _ _ => vec C n) (@vec_nil C) (fun _ _ _ H a b => (g a b) ## H).
Global Arguments vec_map2 {A B C} g {n} v1 v2.
End vec_map2.
Fact vec_pos_map X Y (f : X -> Y) n (v : vec X n) p : vec_pos (vec_map f v) p = f (vec_pos v p).
Section vec_plus.
Variable n : nat.
Definition vec_plus (v w : vec nat n) := vec_set_pos (fun p => vec_pos v p + vec_pos w p).
Definition vec_zero : vec nat n := vec_set_pos (fun _ => 0).
Fact vec_pos_plus v w p : vec_pos (vec_plus v w) p = vec_pos v p + vec_pos w p.
Fact vec_zero_plus v : vec_plus vec_zero v = v.
Fact vec_zero_spec p : vec_pos vec_zero p = 0.
Fact vec_plus_assoc u v w : vec_plus u (vec_plus v w) = vec_plus (vec_plus u v) w.
Fact vec_plus_is_zero u v : vec_zero = vec_plus u v -> u = vec_zero /\ v = vec_zero.
Definition vec_one p : vec _ n := vec_set_pos (fun q => if pos_eq_dec p q then 1 else 0).
Fact vec_one_spec_eq p q : p = q -> vec_pos (vec_one p) q = 1.
Fact vec_one_spec_neq p q : p <> q -> vec_pos (vec_one p) q = 0.
End vec_plus.
Arguments vec_plus {n}.
Arguments vec_zero {n}.
Arguments vec_one {n}.
Reserved Notation " e '#>' x " (at level 58).
Reserved Notation " e [ v / x ] " (at level 57, v at level 0, x at level 0, left associativity).
Local Notation " e '#>' x " := (vec_pos e x) (at level 58).
Local Notation " e [ v / x ] " := (vec_change e x v) (at level 57, v at level 0, x at level 0, left associativity).
Tactic Notation "rew" "vec" :=
repeat lazymatch goal with
|              |- context[ _[_/?x]#>?x ] => rewrite vec_change_eq with (p := x) (1 := eq_refl)
| _ : ?x = ?y  |- context[ _[_/?x]#>?y ] => rewrite vec_change_eq with (p := x) (q := y)
| _ : ?y = ?x  |- context[ _[_/?x]#>?y ] => rewrite vec_change_eq with (p := x) (q := y)
| _ : ?x <> ?y |- context[ _[_/?x]#>?y ] => rewrite vec_change_neq with (p := x) (q := y)
| _ : ?y <> ?x |- context[ _[_/?x]#>?y ] => rewrite vec_change_neq with (p := x) (q := y)
|              |- context[ vec_pos vec_zero ?x ] => rewrite vec_zero_spec with (p := x)
|              |- context[ vec_pos (vec_one ?x) ?x ] => rewrite vec_one_spec_eq with (p := x) (1 := eq_refl)
| _ : ?x = ?y  |- context[ vec_pos (vec_one ?x) ?y ] => rewrite vec_one_spec_eq with (p := x) (q := y)
| _ : ?y = ?x  |- context[ vec_pos (vec_one ?x) ?y ] => rewrite vec_one_spec_eq with (p := x) (q := y)
| _ : ?x <> ?y |- context[ vec_pos (vec_one ?x) ?y ] => rewrite vec_one_spec_neq with (p := x) (q := y)
| _ : ?y <> ?x |- context[ vec_pos (vec_one ?x) ?y ] => rewrite vec_one_spec_neq with (p := x) (q := y)
| |- context[ _[_/?x][_/?x] ] => rewrite vec_change_idem with (p := x)
| |- context[ ?v[(?v#>?x)/?x] ] => rewrite vec_change_same with (p := x)
| |- context[ _[_/?x]#>?y ] => rewrite vec_change_neq with (p := x) (q := y); [ | discriminate ]
| |- context[ vec_plus vec_zero ?x ] => rewrite vec_zero_plus with (v := x)
| |- context[ vec_plus ?x vec_zero ] => rewrite (vec_plus_comm x vec_zero); rewrite vec_zero_plus with (v := x)
| |- vec_plus ?x ?y = vec_plus ?y ?x => apply vec_plus_comm
end; auto.
Tactic Notation "vec" "split" hyp(v) "with" ident(n) :=
rewrite (vec_head_tail v); generalize (vec_head v) (vec_tail v); clear v; intros n v.
Tactic Notation "vec" "nil" hyp(v) := rewrite (vec_0_nil v).
Fact vec_zero_S n : @vec_zero (S n) = 0##vec_zero.
Fact vec_one_nxt n p : @vec_one (S n) (pos_nxt p) = 0##vec_one p.
Fact vec_plus_cons n x v y w : @vec_plus (S n) (x##v) (y##w) = x+y ## vec_plus v w.
Fact vec_change_succ n v p : v[(S (v#>p))/p] = @vec_plus n (vec_one p) v.
Fact vec_change_pred n v p u : v#>p = S u -> v = @vec_plus n (vec_one p) (v[u/p]).
Fixpoint vec_sum n (v : vec nat n) :=
match v with
| vec_nil       => 0
| vec_cons x w  => x + vec_sum w
end.
Fact vec_sum_plus n v w : @vec_sum n (vec_plus v w) = vec_sum v + vec_sum w.
Fact vec_sum_zero n : @vec_sum n vec_zero = 0.
Fact vec_sum_is_zero n v : @vec_sum n v = 0 -> v = vec_zero.
Fact vec_sum_is_nzero n v : 0 < @vec_sum n v -> { p : _ & { w | v = vec_plus (vec_one p) w } }.
Section vec_nat_induction.
(* Specialized induction on vec nat n, with constant n *)
Variable (n : nat) (P : vec nat n -> Type).
Hypothesis HP0 : P vec_zero.
Hypothesis HP1 : forall p, P (vec_one p).
Hypothesis HP2 : forall v w, P v -> P w -> P (vec_plus v w).

(* Specifications: *)
Theorem vec_nat_induction v : P v.
End vec_nat_induction.