(* $Id: Build.v,v 1.2 1999/10/05 10:35:33 boulme Exp $ *)
(* Building telescopes *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Import Subsig.

Section build.


Variable A : Set.

(* curryfication on telescopes *)

Definition curry_sig (l1 : list A) (s1 : sigtel l1) :=
  sigtel_rect
    (P:=fun (l1 : list A) (s1 : sigtel l1) =>
        forall l2 : list A, (impltel s1 -> sigtel l2) -> Type)
    (fun _ f => impltel (f (Eimpl A)))
    (fun a l T f HR _ F =>
     forall x : T, HR _ _ (fun i : impltel (f x) => F (Cimpl a i))) s1.

Definition curry_impl (l1 : list A) (s1 : sigtel l1) :=
  sigtel_rect
    (P:=fun (l1 : list A) (s1 : sigtel l1) =>
        forall (l2 : list A) (f : impltel s1 -> sigtel l2),
        (forall i : impltel s1, impltel (f i)) -> curry_sig f)
    (fun _ _ g => g (Eimpl A))
    (fun a _ T f HR _ F G (x : T) =>
     HR _ _ (fun i : impltel (f x) => F (Cimpl a i))
       (fun i : impltel (f x) => G (Cimpl a i))) s1.

Definition Build (l : list A) (s : sigtel l) :=
  curry_impl (f:=fun i : impltel s => s) (fun i : impltel s => i).


Definition flatimpl :
  forall (l1 : list A) (s1 : sigtel l1) (i : impltel s1) 
    (l2 : list A) (f : impltel s1 -> sigtel l2),
  impltel (f i) -> impltel (flatsig f).
intros l1 s1 i; pattern l1, s1, i in |- *; apply impltel_rect with (A := A);
 simpl in |- *; clear i s1 l1.
intros l2 F G; exact G.
intros a l T f x i HR l2 F G;
 exact
  (Build_dpairT
     (f:=fun x : T =>
         impltel
           (flatsig
              (fun i : impltel (f x) =>
               F (Build_dpairT (f:=fun x : T => impltel (f x)) a i)))) a
     (HR _
        (fun i : impltel (f x) =>
         F (Build_dpairT (f:=fun x : T => impltel (f x)) a i)) G)).
Defined.

Definition flat_curry_sig :
  forall (l1 : list A) (s1 : sigtel l1) (i : impltel s1) 
    (l2 l3 : list A) (f : impltel s1 -> sigtel l2),
  (impltel (f i) -> sigtel l3) -> Type.
  intros l1 s1; pattern l1, s1 in |- *; apply sigtel_rect with (A := A);
   simpl in |- *; clear s1 l1.
  intro i; case i; intros l2 l3 f F; exact (curry_sig F).
  intros a l T f HR i; case i; intros x j l2 l3 F G.
  exact (HR _ _ _ _ (fun k : impltel (f x) => F (Cimpl a k)) G).
Defined.

Definition flat_curry_impl :
  forall (l1 : list A) (s1 : sigtel l1) (i : impltel s1) 
    (l2 l3 : list A) (f : impltel s1 -> sigtel l2)
    (g : impltel (f i) -> sigtel l3),
  (forall j : impltel (f i), impltel (g j)) -> flat_curry_sig (i:=i) g.
  intros l1 s1; pattern l1, s1 in |- *; apply sigtel_rect with (A := A);
   simpl in |- *; clear s1 l1.
  intro i; case i; intros l2 l3 f F G; exact (curry_impl G).
  intros a l T f HR i; case i; intros x j l2 l3 F G H.
  exact (HR _ _ _ _ (fun k : impltel (f x) => F (Cimpl a k)) G H).
Defined.

Definition Buildflat (l1 l2 : list A) (s1 : sigtel l1)
  (f : impltel s1 -> sigtel l2) (i : impltel s1) :=
  flat_curry_impl (i:=i) (f:=f) (g:=fun _ : impltel (f i) => flatsig f)
    (fun j : impltel (f i) => flatimpl (f:=f) j).

End build.





