Section MAIN.
(* conseq adjoins an element x of X to finite functions f:(fin N)->X *)
(* This is done by {0->x; m+1->f(m)} : (fin N+1)->X, ie. the new element *)
(* is inserted at the front. That's why it's called conseq: it's the seq *)
(* variant of the cons operator as seen in lists *)
(** %\label{conseq}% *)
Definition conseq :
forall (A : Setoid) (n : Nat) (a : A) (v : seq n A), seq (S n) A.
intros.
apply
(Build_Map
(Ap:=fun m : fin (S n) =>
match m return (A:Type) with
| Build_finiteT x0 x1 =>
match x0 as x2 return (x2 < S n -> (A:Type)) with
| O => fun _ : 0 < S n => a
| S m' =>
fun HSm' : S m' < S n =>
Ap v (Build_finiteT (lt_S_n m' n HSm'))
end x1
end)).
red in |- *.
simpl in |- *.
intros x0 y.
case x0.
case y.
simpl in |- *.
intros x2 y1.
induction x2.
intros x2 y2.
induction x2.
intro; apply Refl.
intro H.
inversion H.
clear IHx2.
simple induction index.
intros h H.
inversion H.
intros.
clear H.
apply Ap_comp; auto with algebra.
Defined.
Notation "a ;; b" := (conseq a b) (at level 60, right associativity).
Variables (A : Setoid) (n : Nat) (a : A).
intros.
simpl in |- *.
red in |- *.
intro i'.
elim i'.
intro i.
simpl in |- *.
case i.
auto.
intros.
apply Ap_comp; auto with algebra.
Qed.
Hint Resolve cons_comp: algebra.
auto with algebra.
Qed.
(** %\label{head}% *)
Definition head (A : Setoid) (n : Nat) (v : seq (S n) A) :=
v (Build_finiteT (lt_O_Sn n)).
unfold head in |- *.
auto with algebra.
Qed.
Hint Resolve head_comp cons_first_element: algebra.
auto with algebra.
Qed.
auto with algebra.
Qed.
Hint Resolve head_unfolding1 head_unfolding2: algebra.
Hint Extern 0 (head _ =' _ in _) => unfold head in |- *: algebra.
Hint Extern 0 (_ =' head _ in _) => unfold head in |- *: algebra.
auto with algebra.
Qed.
Hint Resolve head_cons_inv: algebra.
intros.
unfold head in |- *.
apply Ap_comp; auto with algebra.
Qed.
Hint Resolve seq_S_O_contains_single_elt: algebra.
intros.
simpl in |- *.
red in |- *.
intro.
apply Trans with (head v).
apply seq_S_O_contains_single_elt; auto with algebra.
apply Trans with (head v'); auto with algebra.
Qed.
Hint Resolve seq_S_O_head_fixes_everything: algebra.
intros.
simpl in |- *.
apply Ap_comp; auto with algebra.
Qed.
Hint Resolve cons_later_elements: algebra.
(* Taking the "tl" of a sequence *)
(** %\label{Seqtl}% *)
Definition Seqtl : forall n : Nat, seq n A -> seq (pred n) A.
clear n.
intro n.
case n.
intro f.
exact f.
intros m f.
apply
(Build_Map
(Ap:=fun i' : fin m =>
match i' with
| Build_finiteT i Hi => f (Build_finiteT (lt_n_S _ _ (Hi:i < m)))
end)).
red in |- *.
intros x y.
case x.
case y.
simpl in |- *.
intros.
apply Ap_comp; auto with algebra.
Defined.
induction n.
intros.
simpl in |- *.
auto.
intros.
simpl in |- *.
red in |- *.
simpl in |- *.
intro.
elim x.
intros.
apply Ap_comp; auto with algebra.
Qed.
Hint Resolve Seqtl_comp: algebra.
(** - "hdtl" is a 'tool' for writing a sequence as the cons of its head and its tail %\label{hdtl}% *)
Definition hdtl (v : seq (S n) A) := head v;; Seqtl v:seq (S n) A.
(* note we don't say v='(head v);;(Seqtl v): we want freedom in the choice of the proof H *)
intros.
simpl in |- *.
red in |- *.
simpl in |- *.
intro x.
case x.
intro.
case index.
intros; apply Ap_comp; simpl in |- *; auto with algebra arith.
red in |- *; auto with algebra.
intros; apply Ap_comp; simpl in |- *; auto with algebra arith.
red in |- *; auto with algebra.
Qed.
Hint Resolve conseq_hdtl: algebra.
unfold hdtl in |- *.
intros.
unfold head in |- *.
apply conseq_hdtl.
Qed.
Hint Resolve hdtl_x_is_x: algebra.
Hint Extern 0 (head _;; Seqtl _ =' _ in _) =>
fold hdtl in |- *; apply Sym; apply hdtl_x_is_x: algebra.
Hint Extern 0 (_ =' head _;; Seqtl _ in _) =>
fold hdtl in |- *; apply hdtl_x_is_x: algebra.
intro.
elim P.
intros.
unfold pred_compatible in Pred_compatible_prf.
apply Pred_compatible_prf with (hdtl w); auto with algebra.
unfold hdtl in |- *.
apply H.
Qed.

Lemma cons_lemma_verynice :
forall (P : Predicate (seq (S n) A)) (H : 0 < S n) (w : seq (S n) A),
Pred_fun P (w (Build_finiteT H);; Seqtl w) -> Pred_fun P w.