(* $Id: Sigtel.v,v 1.2 1999/10/05 10:35:42 boulme Exp $ *)
(* Definition of telescopes *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Export List.

Section Sigtel.

(* The set of labels in records *)
Variable A : Set.

Inductive EsigT : Type :=
    Esig_ : EsigT.
Record FunIn (a : A) (T : Type) : Type :=  {dom : Type; fun_ :> dom -> T}.

(* Signature of telescopes *)
Fixpoint sigtel (l : list A) : Type :=
  match l with
  | nil => EsigT
  | a :: m => FunIn a (sigtel m)
  end.

Definition Esig : sigtel nil := Esig_.
Definition Csig (a : A) (l : list A) (T : Type) (f : T -> sigtel l) :
  sigtel (a :: l) := Build_FunIn a f.


Definition sigtel_rect :
  forall P : forall l : list A, sigtel l -> Type,
  P nil Esig ->
  (forall (a : A) (l : list A) (T : Type) (f : T -> sigtel l),
   (forall x : T, P l (f x)) -> P (a :: l) (Csig a f)) ->
  forall (l : list A) (s : sigtel l), P l s.
  intros P HE HC l; elim l.
  intro s; case s; simpl in |- *; auto.
  intros a m HR s; case s; simpl in |- *; intros x f; unfold Csig in HC;
   apply HC; auto.
Defined.

Section DependentPair.

Variable T : Type.
Variable f : T -> Type.

Record dpairT (a : A) : Type :=  {dprojT1 : T; dprojT2 : f dprojT1}.

End DependentPair.


(* Implementation of telescopes *)
Fixpoint impltel (l : list A) : sigtel l -> Type :=
  match l return (sigtel l -> Type) with
  | nil => fun _ => unit
  | a :: m => fun s => dpairT (fun x : dom s => impltel (s x)) a
  end.

Definition Eimpl : impltel Esig := tt.

Definition Cimpl (a : A) (l : list A) (T : Type) (f : T -> sigtel l) 
  (x : T) (m : impltel (f x)) : impltel (Csig a f) :=
  Build_dpairT (f:=fun x : T => impltel (f x)) a m.

Definition impltel_rect :
  forall P : forall (l : list A) (s : sigtel l), impltel s -> Type,
  P _ _ Eimpl ->
  (forall (a : A) (l : list A) (T : Type) (f : T -> sigtel l) 
     (x : T) (i : impltel (f x)),
   P l (f x) i -> P (a :: l) (Csig a f) (Cimpl a i)) ->
  forall (l : list A) (s : sigtel l) (i : impltel s), P l s i.
  intros P HE HC l s; pattern l, s in |- *; apply sigtel_rect; simpl in |- *;
   clear s l.
  intro i; case i; simpl in |- *; auto.
  intros a l T f HR i; case i; simpl in |- *; intros x j; unfold Cimpl in HC;
   apply HC; auto.
Defined.

End Sigtel.
Hint Resolve Esig_ Build_FunIn: sigtel.
Hint Resolve tt Build_dpairT: sigtel.

