Require Import basic.
Require Import Sublogic.
Require Import Models GenModelSyntax.
Require Import ZF ZFcoc.

(** Set-theoretical model of the Classical Calculus of Constructions in IZF *)

(** * Instantiation of the abstract model of CC *)

Module ClassicCCM <: CC_Model.

Definition X := set.
Definition inX : X -> X -> Prop := in_set.
Definition eqX : X -> X -> Prop := eq_set.
Definition inclX : X -> X -> Prop := incl_set.
Definition eqX_equiv : Equivalence eqX := eq_set_equiv.
Notation "x ∈ y" := (inX x y).
Notation "x == y" := (eqX x y).

Lemma in_ext: Proper (eqX ==> eqX ==> iff) inX.
Proof in_set_morph.

Definition props : X := cl_props.
Definition app : X -> X -> X := cc_app.
Definition lam : X -> (X -> X) -> X := cc_lam.
Definition prod : X -> (X -> X) -> X := cc_prod.

Definition eq_fun (x:X) (f1 f2:X->X) :=
  forall y1 y2, y1 ∈ x -> y1 == y2 -> f1 y1 == f2 y2.

Lemma lam_ext :
  forall x1 x2 f1 f2,
  x1 == x2 ->
  eq_fun x1 f1 f2 ->
  lam x1 f1 == lam x2 f2.
Proof.
intros.
apply cc_lam_ext; intros; trivial.
Qed.

Lemma app_ext:
  forall x1 x2 : X, x1 == x2 ->
  forall x3 x4 : X, x3 == x4 ->
  app x1 x3 == app x2 x4.
Proof cc_app_morph.

Lemma prod_ext :
  forall x1 x2 f1 f2,
  x1 == x2 ->
  eq_fun x1 f1 f2 ->
  prod x1 f1 == prod x2 f2.
Proof.
intros.
apply cc_prod_ext; intros; trivial.
Qed.

Lemma prod_intro : forall dom f F,
  eq_fun dom f f ->
  eq_fun dom F F ->
  (forall x, x ∈ dom -> f x ∈ F x) ->
  lam dom f ∈ prod dom F.
Proof cc_prod_intro.

Lemma prod_elim : forall dom f x F,
  eq_fun dom F F ->
  f ∈ prod dom F ->
  x ∈ dom ->
  app f x ∈ F x.
Proof fun dom f x F _ H H0 => cc_prod_elim dom f x F H H0.

Lemma impredicative_prod : forall dom F,
  eq_fun dom F F ->
  (forall x, x ∈ dom -> F x ∈ props) ->
  prod dom F ∈ props.
Proof cc_cl_impredicative_prod.

Lemma beta_eq:
  forall dom F x,
  eq_fun dom F F ->
  x ∈ dom ->
  app (lam dom F) x == F x.
Proof cc_beta_eq.

End ClassicCCM.

(** * Instantiating the generic model construction *)

Module BuildModel := MakeModel(ClassicCCM).

Import BuildModel T J R.

Lemma El_int_arr T U i :
  int (Prod T (lift 1 U)) i == cc_arr (int T i) (int U i).
simpl.
apply cc_prod_ext.
 reflexivity.

 red; intros.
 rewrite simpl_int_lift.
 rewrite lift0_term; reflexivity.
Qed.

(** The model in ZF implies the consistency of CC *)

Require Import Term Env.
Require Import TypeJudge.
Load "template/Library.v".

Lemma mt_cl_props: empty ∈ cl_props.
Proof.
apply subset_intro.
 unfold props; apply empty_in_power.
 unfold p2P.

 intros [ ].
 intro in_mt.
 apply empty_ax in in_mt; trivial.
Qed.
Hint Resolve mt_cl_props.

Lemma em_consistent :
  let FF := T.Prod T.prop (T.Ref 0) in
  let N p := T.Prod p FF in
  let EM := T.Prod T.prop (T.Prod (N (N (T.Ref 0))) (T.Ref 1)) in
  val_ok (EM::nil) (fun _ => empty).
intros; red; intros.
destruct n as [ | [|?]]; try discriminate.
injection H; clear H; intros; subst T.
simpl. unfold ClassicCCM.prod, ClassicCCM.props.
red.
apply cc_forall_intro.
 do 2 red; intros.
 apply cc_arr_morph; trivial.
 apply cc_arr_morph; [|reflexivity].
 apply cc_arr_morph; [trivial|reflexivity].
intros P Pty.
assert (Pty' := Pty).
apply subset_ax in Pty'; destruct Pty' as (Pty',(P',eqP,Pcl)).
rewrite <- eqP in Pcl.
apply cc_forall_intro; [auto with *|].
intros prf nnpty.
apply Pcl.
intro.
apply cc_prod_elim with (x:=empty) in nnpty.
 apply cc_prod_elim with (2:=mt_cl_props) in nnpty.
 apply empty_ax in nnpty; trivial.

 apply cc_forall_intro; auto with *.
 intros p pty.
 elim H.
 rewrite props_proof_irrelevance with (P:=P) (x:=p) in pty; trivial.
Qed.

Lemma cl_cc_consistency M M': ~ eq_typ (EM::nil) M M' FALSE.
Proof.
unfold FALSE; red in |- *; intros.
specialize BuildModel.int_sound with (1 := H); intro.
destruct H0 as (H0,_).
simpl in H0.
apply abstract_theory_consistency with (1:=mt_cl_props) (4:=H0).
 exists (fun _ => empty).
 apply em_consistent.

 red; intros.
 apply empty_ax with (1:=H1).
Qed.


From Forcing Require Import Forcing.
Require Import List.
Require Import Program.

Import ListNotations.

Inductive form :=
  | Atom : nat -> form
  | And : form -> form -> form
  | Implies : form -> form -> form.

Definition context := list form.

Inductive extend : context -> context -> Prop :=
  | extend_nil : extend nil nil
  | extend_cons_no : forall A ctx ctx', extend ctx ctx' -> extend (cons A ctx) ctx'
  | extend_cons_yes : forall A ctx ctx', extend ctx ctx' -> extend (cons A ctx) (cons A ctx').

Inductive In (A : form) : context -> Prop :=
  | In_cons_yes : forall ctx, In A (cons A ctx)
  | In_cons_no : forall ctx, In A ctx -> forall B, In A (cons B ctx).

Inductive provable : context -> form -> Prop :=
  | Ax { ctx A } : In A ctx -> provable ctx A
  | AndI { ctx A B } : provable ctx A -> provable ctx B -> provable ctx (And A B)
  | AndE1 { ctx A B } : provable ctx (And A B) -> provable ctx A
  | AndE2 { ctx A B } : provable ctx (And A B) -> provable ctx B
  | ImpliesI { ctx A B } : provable (cons A ctx) B -> provable ctx (Implies A B)
  | ImpliesE { ctx A B } : provable ctx (Implies A B) -> provable ctx A -> provable ctx B.

Lemma compatibility_extend_in :
  forall A ctx ctx', extend ctx' ctx -> In A ctx -> In A ctx'.
Proof.
  intros A ctx ctx'. intros Hextend Hin.
  induction Hextend.
  - assumption.
  - apply IHHextend in Hin. apply In_cons_no. assumption.
  - dependent induction Hin.
    * apply In_cons_yes.
    * apply In_cons_no. apply IHHextend. assumption.
Qed.

Lemma compatibility_extend_provable :
  forall { A ctx ctx' }, extend ctx' ctx -> provable ctx A -> provable ctx' A.
Proof.
  intros A ctx ctx' Hextend Hprovable.
  induction Hprovable in ctx', Hextend.
  - apply Ax. apply compatibility_extend_in with (ctx:=ctx) ; assumption.
  - apply AndI.
    * apply IHHprovable1. assumption.
    * apply IHHprovable2. assumption.
  - apply IHHprovable in Hextend. apply AndE1 in Hextend. assumption.
  - apply IHHprovable in Hextend. apply AndE2 in Hextend. assumption.
  - apply ImpliesI. specialize IHHprovable with (cons A ctx').
    apply IHHprovable. apply extend_cons_yes. assumption.
  - assert (HextendBis : extend ctx' ctx). assumption.
    apply IHHprovable1 in Hextend. apply IHHprovable2 in HextendBis.
    apply @ImpliesE with (A:=A) ; assumption.
Qed.

Fixpoint semK (K : context -> nat -> Prop) (ctx : context) (A : form) :=
  match A with
    | Atom n   => K ctx n
    | And A1 A2 => ((semK K ctx A1) * (semK K ctx A2))%type
    | Implies A1 A2 => forall ctx', extend ctx' ctx -> (semK K ctx' A1) -> (semK K ctx' A2)
  end.

Notation "p 'EXT' q" := (forall R, extend p R -> extend q R) (at level 70, q at next level).
Notation "'forallI' q 'EXT' p , P" := (forall q, q EXT p -> P q) (at level 200, q at level 69, p at level 69).

Lemma refl_incl :
  forall p, p EXT p.
Proof.
  auto.
Defined.

Lemma id_extend :
  forall p, extend p p.
Proof.
  intros. induction p.
  - apply extend_nil.
  - apply extend_cons_yes. assumption.
Qed.

Lemma trans_incl :
  forall {p q r}, p EXT q -> q EXT r -> p EXT r.
Proof.
  auto.
Defined.

Forcing Translate nat using context extend.
Forcing Translate form using context extend.

Forcing Definition sem : forall (M : nat -> Prop) (A : form), Prop using context extend.
Proof.
  exact (fun p M A =>
    (fix sem p1 Hincl1 A := (* Hincl1 : preuve de p1 INCL p *)
      match A with
      | Atomᶠ _ n   => M p1 Hincl1 n
      | Andᶠ _ A1 A2 => (sem p1 Hincl1 (A1 p1 (refl_incl p1))) /\ (sem p1 Hincl1 (A2 p1 (refl_incl p1)))
      | Impliesᶠ _ A1 A2 => (sem p1 Hincl1 (A1 p1 (refl_incl p1))) -> (sem p1 Hincl1 (A2 p1 (refl_incl p1)))
    end) p (refl_incl p) (A p (refl_incl p))
  ).
Defined.

Definition valid A := forall (M : nat -> Prop), sem M A.
Forcing Translate valid using context extend.

Forcing Translate list using context extend.
Forcing Translate context using context extend.

Forcing Translate In using context extend.
Forcing Translate provable using context extend.

Lemma psi_nat : forall { p }, (forallI p0 EXT p, natᶠ) -> nat.
Proof.
  exact (fun p n =>
    (fix psi_nat_rec n :=
      match n with
      | Oᶠ _    => O
      | Sᶠ _ m  => S (psi_nat_rec (m p (refl_incl p)))
      end
    ) (n p (refl_incl p))
  ).
Qed.

Lemma phi_nat : forall (p : context), nat -> natᶠ p.
Proof.
  exact (fun p n =>
    (fix phi_nat_rec p n :=
      match n with
      | O => Oᶠ p
      | S m => Sᶠ p (fun p0 Hp0 => (phi_nat_rec p0 m))
      end
    ) p n
  ).
Qed.

Lemma psi_form : forall { p }, (forallI p0 EXT p, formᶠ) -> form.
Proof.
  exact (fun p A =>
    (fix psi_rec A :=
      match A with
      | Atomᶠ _ n    => Atom (psi_nat n)
      | Andᶠ _ A1 A2  => And (psi_rec (A1 p (refl_incl p))) (psi_rec (A2 p (refl_incl p)))
      | Impliesᶠ _ A1 A2 => Implies (psi_rec (A1 p (refl_incl p))) (psi_rec (A2 p (refl_incl p)))
      end) (A p (refl_incl p))
  ).
Defined.

Lemma phi_form : forall { p }, form -> formᶠ p.
Proof.
  exact (fun p A =>
    (fix phi_form_rec p A :=
      match A with
      | Atom n => Atomᶠ p (fun p0 _ => phi_nat p0 n)
      | And A1 A2 => Andᶠ p (fun p0 _ => phi_form_rec p0 A1) (fun p0 _ => phi_form_rec p0 A2)
      | Implies A1 A2 => Impliesᶠ p (fun p0 _ => phi_form_rec p0 A1) (fun p0 _ => phi_form_rec p0 A2)
      end) p A
  ).
Defined.

(* Modèle universel *)
Definition K0 ctx n := provable ctx (Atom n).

Fixpoint reify p A : semK K0 p A -> provable p A :=
  match A with
    | Atom n   => (fun v => v)
    | And A1 A2 => (fun '(v1, v2) => AndI (reify p A1 v1) (reify p A2 v2))
    | Implies A1 A2 => (fun v => ImpliesI (reify (A1 :: p) A2 (v (A1 :: p) (extend_cons_no A1 p p (id_extend p)) (reflect (A1 :: p) A1 (Ax (In_cons_yes A1 p))))))
  end
with reflect p A : provable p A -> semK K0 p A :=
  match A with
    | Atom n   => (fun t => t)
    | And A1 A2 => (fun t => (reflect p A1 (AndE1 t), reflect p A2 (AndE2 t)))
    | Implies A1 A2 => (fun t => (fun p0 Hinclp0 a => reflect p0 A2 (ImpliesE (compatibility_extend_provable Hinclp0 t) (reify p0 A1 a))))
  end.

(*
Lemma psi_model : forall { p : context } (M : forall p0 : context, p0 EXT p ->
  (forallI p1 EXT p0, natᶠ) -> Prop), context -> nat -> Prop.
Proof.
  exact (fun p M ctx n => M p (refl_incl p) (fun p0 _ => (phi_nat p0 n))).
Qed.
*)

Lemma phi_model : forall (M : context -> nat -> Prop),
  forall { p : context }, forall p0 : context, p0 EXT p ->
    (forallI p1 EXT p0, natᶠ) -> Prop.
Proof.
  exact (fun M p (p0 : context) Hinclp0 (n : forallI p EXT p0, natᶠ)
      => M p0 (psi_nat n) ).
Defined.

Lemma psi_sem : forall { p M A }, semᶠ p (phi_model M) A -> semK M nil (psi_form A).
Proof.
Admitted.

Lemma phi_context : forall { p }, context -> contextᶠ p.
Proof.
  exact (fun p ctx =>
    (fix phi_ctx_rec p ctx : contextᶠ p :=
      match ctx with
      | [] => nilᶠ p _
      | A :: ctx' => consᶠ p _ (fun p1 _ => phi_form A) (fun p1 _ => phi_ctx_rec p1 ctx')
      end
    ) p ctx
  ).
Defined.

Lemma phi_provable : forall { ctx A }, provable ctx (psi_form A) -> provableᶠ nil (fun p0 Hincl => (phi_context ctx) ) A.
Proof.
Admitted.

Forcing Definition completeness : forall A, valid A -> provable nil A using context extend from nil.
Proof.
  intros.

  specialize H with (p := nil) (α := refl_incl nil).
  unfold validᶠ in H.
  specialize H with (M := phi_model K0).

  apply psi_sem, reify, phi_provable in H . assumption.
Qed.


Require Import Coq.Lists.List
        Coq.Strings.String
        Coq.Arith.Arith
        Coq.Logic.Eqdep_dec
        Fiat.Common.ilist
        Fiat.Common.ilist2.

Require Coq.Vectors.Vector.
Global Set Asymmetric Patterns.

(* Typeclasses for ensuring that a string is included
   in a list (i.e. a set of method names). This allows
   us to omit a default case (method not found) for method
   lookups. *)

Section BoundedIndex.

  Context {A : Type}.

  Class IndexBound n
        (a : A)
        (Bound : Vector.t A n)
    :=
      { ibound : Fin.t n;
        boundi : Vector.nth Bound ibound = a
      }.

  Global Arguments ibound {n a Bound} IndexBound.
  Global Arguments IndexBound {n} a Bound.

  Record BoundedIndex
         (n : nat)
         (Bound : Vector.t A n) :=
    { bindex : A;
      indexb : IndexBound bindex Bound
    }.

  Import Vectors.Vector.VectorNotations.

  Definition BoundedIndex_nil
             (AnyT : Type)
             (idx : @BoundedIndex 0 [])
  : AnyT.
  Proof.
    destruct idx as [idx [n nth_n] ].
    inversion n.
  Qed.

  Global Arguments indexb {n Bound} b.
  Global Arguments bindex {n Bound} b.
  Global Arguments BoundedIndex {n} Bound%vector_scope.

  Lemma indexb_ibound_eq :
    forall n Bound (bidx bidx' : BoundedIndex (n := n) Bound),
      ibound (indexb bidx) = ibound (indexb bidx') ->
      bindex bidx = bindex bidx'.
  Proof.
    intros; induction Bound; simpl in *.
    - apply BoundedIndex_nil; auto.
    - destruct bidx as [bindex [n' nth_n] ];
      destruct bidx' as [bindex' [n'' nth_n'] ]; simpl in *; subst.
      congruence.
  Qed.

  Section Bounded_Index_Dec_Eq.
  (* If equality on A is decideable, so is equality
     on bounded indices in A. *)
    Variable A_eq_dec :
      forall a a' : A, {a = a'} + {a <> a'}.

    Program Definition Opt_A_eq_dec (a a' : option A) :
      {a = a'} + {a <> a'} :=
      match a as a, a' as a' return {a = a'} + {a <> a'} with
          | Some a, Some a' => if A_eq_dec a a' then left _ else right _
          | None, None => left _
          | _, _ => right _
      end.

    (*Definition K_Opt_A :
      forall (a : option A) (P: a = a -> Prop),
          P (refl_equal a) -> forall p : a = a, P p :=
      K_dec_set Opt_A_eq_dec.

    Definition UIP_Opt_A  :
      forall (a : option A) (Q : option A -> Type)
             (x : Q a) (h : a = a),
        x = eq_rect a Q x a h.
      intros; eapply K_Opt_A with (p := h); reflexivity.
    Defined.

    Lemma eq_proofs_unicity_Opt_A
      : forall (a a' : option A) (p1 p2 : a = a'), p1 = p2.
      apply eq_proofs_unicity; intros.
      destruct (Opt_A_eq_dec x y); auto.
    Defined. *)

    Corollary idx_ibound_eq
    : forall n Bound (idx idx' : BoundedIndex (n := n) Bound),
        ibound (indexb idx) = ibound (indexb idx') ->
        idx = idx'.
    Proof.
      intros; generalize (@indexb_ibound_eq _ _ idx idx' H);
      destruct idx as [idx [n' In_n'] ];
        destruct idx' as [idx' [n'' In_n'' ] ]; intros;
        simpl in *; subst; f_equal.
    Qed.

    Corollary idx_ibound_neq
    : forall n Bound (idx idx' : BoundedIndex (n := n) Bound),
        ibound (indexb idx) <> ibound (indexb idx') ->
        idx <> idx'.
    Proof.
      intros; destruct idx as [idx [n' In_n' ] ];
        destruct idx' as [idx' [n'' In_n'' ] ]; intros;
        simpl in *; subst.
      unfold not; intros; apply H; injection H0; auto.
    Qed.

    Definition fin_eq_dec {m} (n n' : Fin.t m)
      : {n = n'} + {n <> n'}.
    Proof.
      eapply Fin.rect2 with (P := fun m (n n' : Fin.t m)
                                  => {n = n'} + {n <> n'}).
      - left; reflexivity.
      - right; intro; discriminate.
      - right; intro; discriminate.
      - destruct 1; subst.
        + left; reflexivity.
        + right; intro H; apply Fin.FS_inj in H; eauto.
    Defined.

    Corollary BoundedIndex_eq_dec n Bound :
      forall idx idx' : BoundedIndex (n := n) Bound,
        {idx = idx'} + {idx <> idx'}.
    Proof.
      intros; destruct (fin_eq_dec (ibound (indexb idx)) (ibound (indexb idx'))).
      - left; auto using idx_ibound_eq.
      - right; auto using idx_ibound_neq.
    Defined.

    Fixpoint fin_beq {m n} (p : Fin.t m) (q : Fin.t n) :=
      match p, q with
      | @Fin.F1 m', @Fin.F1 n' => EqNat.beq_nat m' n'
      | Fin.FS _ _, Fin.F1 _ => false
      | Fin.F1 _, Fin.FS _ _ => false
      | Fin.FS _ p', Fin.FS _ q' => fin_beq p' q'
      end.

    Lemma fin_beq_dec {n}
      : forall (p : Fin.t n) (q : Fin.t n),
        fin_beq p q = true <-> p = q.
    Proof.
      intros; pattern n, p, q; eapply Fin.rect2; simpl;
        intuition; try (congruence || discriminate).
      - symmetry; eapply beq_nat_refl.
      - eauto using Fin.FS_inj.
    Qed.

    Corollary fin_beq_neq_dec {n}
      : forall (p : Fin.t n) (q : Fin.t n),
        fin_beq p q = false <-> p <> q.
    Proof.
      intros; setoid_rewrite <- fin_beq_dec; split;
        intros; destruct (fin_beq p q); congruence.
    Qed.

    Corollary fin_beq_refl {m}
      : forall (p : Fin.t m),
        fin_beq p p = true.
    Proof.
      intros; eapply fin_beq_dec; reflexivity.
    Qed.

    Corollary fin_beq_sym {n}
      : forall (p : Fin.t n) (q : Fin.t n),
        fin_beq p q = fin_beq q p.
    Proof.
      intros; case_eq (fin_beq p q); case_eq (fin_beq q p);
        intros; eauto.
      - apply fin_beq_neq_dec in H; apply fin_beq_dec in H0;
          congruence.
      - apply fin_beq_neq_dec in H0; apply fin_beq_dec in H;
          congruence.
    Qed.

    Corollary fin_beq_trans {n}
      : forall (p q r : Fin.t n),
        fin_beq p q = true ->
        fin_beq q r = true ->
        fin_beq p q = true.
    Proof.
      repeat setoid_rewrite fin_beq_dec; congruence.
    Qed.

    Definition BoundedIndex_beq {n Bound}
               (idx idx' : BoundedIndex (n := n) Bound)
      : bool := fin_beq (ibound (indexb idx)) (ibound (indexb idx')).

    Corollary BoundedIndex_beq_dec {n Bound}
      : forall (idx idx' : BoundedIndex (n := n) Bound),
        BoundedIndex_beq idx idx' = true <-> idx = idx'.
    Proof.
      intros; setoid_rewrite fin_beq_dec; split; intros.
      - eauto using idx_ibound_eq.
      - subst; reflexivity.
    Qed.

    Corollary BoundedIndex_beq_neq_dec {n Bound}
      : forall (idx idx' : BoundedIndex (n := n) Bound),
        BoundedIndex_beq idx idx' = false <-> idx <> idx'.
    Proof.
      intros; setoid_rewrite <- BoundedIndex_beq_dec; split;
        intros; destruct (BoundedIndex_beq idx idx'); congruence.
    Qed.

    Corollary BoundedIndex_beq_refl {m Bound}
      : forall (p : BoundedIndex (n := m) Bound),
        BoundedIndex_beq p p = true.
    Proof.
      intros; eapply BoundedIndex_beq_dec; reflexivity.
    Qed.

    Corollary BoundedIndex_beq_sym {n Bound}
      : forall (p q : BoundedIndex (n := n) Bound),
        BoundedIndex_beq p q = BoundedIndex_beq q p.
    Proof.
      intros; case_eq (BoundedIndex_beq p q); case_eq (BoundedIndex_beq q p);
        intros; eauto.
      - apply BoundedIndex_beq_neq_dec in H; apply BoundedIndex_beq_dec in H0;
          congruence.
      - apply BoundedIndex_beq_neq_dec in H0; apply BoundedIndex_beq_dec in H;
          congruence.
    Qed.

    Corollary BoundedIndex_beq_trans {n Bound}
      : forall (p q r : BoundedIndex (n := n) Bound),
        BoundedIndex_beq p q = true ->
        BoundedIndex_beq q r = true ->
        BoundedIndex_beq p q = true.
    Proof.
      repeat setoid_rewrite BoundedIndex_beq_dec; congruence.
    Qed.

  End Bounded_Index_Dec_Eq.

End BoundedIndex.

Section BoundedIndexExtensions.
  (* Helper functions for extending the set of Bounded Indexes *)

  Lemma IndexBound_AppendR {A n m}
  : forall (Bound : Vector.t A n)
           (Bound' : Vector.t A m)
           (idx : Fin.t n),
    Vector.nth (Vector.append Bound Bound') (Fin.L m idx) =
    Vector.nth Bound idx.
  Proof.
    induction Bound; intros.
    - inversion idx.
    - revert Bound IHBound; pattern n, idx; apply Fin.caseS;
        simpl; intros; eauto.
  Qed.

  Definition BoundedIndex_injR {A n Bound m Bound'}
             (idx : BoundedIndex (A := A) (n := n) Bound)
    : BoundedIndex (n := n + m) (Vector.append Bound Bound').
    refine {| bindex := bindex idx;
              indexb :=  {| ibound := Fin.L _ (ibound (indexb idx))|}
           |}.
    (* Abstract Proof Term. *)
    abstract (rewrite <- (boundi (IndexBound := indexb idx));
              eapply IndexBound_AppendR).
  Defined.

  Lemma IndexBound_AppendL {A n m}
    : forall (Bound : Vector.t A n)
             (Bound' : Vector.t A m)
             (idx : Fin.t n),
      Vector.nth (Vector.append Bound' Bound) (Fin.R m idx) =
      Vector.nth Bound idx.
  Proof.
    induction Bound'; intros.
    - reflexivity.
    - simpl; eauto.
  Qed.

  Definition BoundedIndex_injL {A n Bound m Bound'}
             (idx : BoundedIndex (A := A) (n := n) Bound)
    : BoundedIndex (n := m + n) (Vector.append Bound' Bound).
    refine {| bindex := bindex idx;
              indexb :=  {| ibound := Fin.R _ (ibound (indexb idx))|}
           |}.
    (* Abstract Proof Term. *)
    abstract (rewrite <- (boundi (IndexBound := indexb idx));
              eapply IndexBound_AppendL).
  Defined.

End BoundedIndexExtensions.

Ltac Build_nth_IndexBound n A a As As' m :=
  match n with
  | S ?n' =>
    (let check := constr:(eq_refl : a = Vector.hd As') in (* Check if the terms match *)
     exact (@Build_IndexBound A _ a As (Fin.R m (@Fin.F1 n'))
                              (@eq_refl A a)))
      ||
      let As'' := eval simpl in (Vector.tl As') in
          Build_nth_IndexBound n' A a As As'' (S m)
  end.

#[global]
Hint Extern 0 (@IndexBound ?A ?n ?a ?As) =>
let n' := eval compute in n in
    Build_nth_IndexBound n' A a As As 0 : typeclass_instances.

(*
Import Vectors.Vector.VectorNotations.

Fixpoint foo (n : nat) : Vector.t nat (S n) :=
  match n with
  | 0 => 0 :: []
  | S n' => (S n') * (S n') * (S n') :: (foo n')
  end.

Definition foo100 := Eval simpl in foo 20.

Definition baz := Eval simpl in 3 * 3 * 3.

Definition bar : IndexBound baz foo100.
Proof.
  Unset Ltac Debug.
  Time eauto with typeclass_instances.
Defined. *)

Definition BoundedString {n} := @BoundedIndex string n.
Definition BoundedString_eq_dec
           {n}
           {Bound}
           (bidx bidx' : BoundedString Bound)
: {bidx = bidx'} + {bidx <> bidx'} :=
  @BoundedIndex_eq_dec _ n Bound bidx bidx'.

Notation "x ++ y" := (Vector.append x y) : vector_scope.

Notation "`` A" :=
  ({| bindex := A%string |}) (at level 0, format "`` A").

Arguments BoundedString {n} _%vector_scope.

Section ithIndexBound.

  Import Vectors.Vector.VectorNotations.

  (* Given a bounded index [BoundedIndex Bound], we can wrap
     various lookup functions over lists indexed over [Bound].
   *)

  Context {A : Type}.

  Lemma None_neq_Some
  : forall (AnyT AnyT' : Type) (a : AnyT),
      None = Some a -> AnyT'.
  Proof.
    intros; discriminate.
  Qed.

  Definition nth_Bounded
             {n}
             (Bound : Vector.t A n)
             (idx : BoundedIndex Bound)
    : A := Vector.nth Bound (ibound (indexb idx)).

  Definition ith_Bounded
             {m}
             {B : A -> Type}
             {Bound : Vector.t A m}
             (il : ilist Bound)
             (idx : BoundedIndex Bound)
    : B (Vector.nth Bound (ibound (indexb idx))) :=
    ith il (ibound (indexb idx)) .

  Lemma ith_Bounded_imap
        {m}
        {B B' : A -> Type}
  : forall (f : forall idx, B idx -> B' idx)
           (Bound : Vector.t A m)
           (idx : BoundedIndex Bound)
           (il : ilist Bound),
      f _ (ith_Bounded il idx) =
      ith_Bounded (imap _ _ f Bound il) idx.
  Proof.
    unfold ith_Bounded; simpl; intros; eapply ith_imap.
  Qed.

  Definition replace_BoundedIndex
             {m}
           {B : A -> Type}
           (Bound : Vector.t A m)
           (il : ilist Bound)
           (idx : BoundedIndex Bound)
           (new_b : B (nth_Bounded idx))
  : ilist Bound :=
    replace_Index Bound il (ibound (indexb idx)) new_b.

  Lemma ith_replace_BoundIndex_neq
        {m}
        {B : A -> Type}
  : forall
      (Bound : Vector.t A m)
      (il : ilist Bound)
      (idx idx' : BoundedIndex Bound)
      (new_b : B (nth_Bounded idx')),
      idx <> idx'
      -> ith_Bounded (replace_BoundedIndex il idx' new_b) idx =
         ith_Bounded il idx.
  Proof.
    unfold ith_Bounded; simpl; intros; eapply ith_replace_Index_neq.
    eauto using idx_ibound_eq.
  Qed.

  Lemma ith_replace_BoundIndex_eq
        {m}
        {B : A -> Type}
  : forall
      (Bound : Vector.t A m)
      (il : ilist Bound)
      (idx : BoundedIndex Bound)
      (new_b : B (nth_Bounded idx)),
      ith_Bounded (replace_BoundedIndex il idx new_b) idx = new_b.
  Proof.
    unfold ith_Bounded; simpl; intros; eapply ith_replace_Index_eq.
  Qed.

  Lemma ilist_eq {m} {B : A -> Type}
  : forall (Bound : Vector.t A m)
           (il il' : ilist (B := B) Bound),
      (forall idx, ith_Bounded il idx = ith_Bounded il' idx) -> il = il'.
  Proof.
    induction Bound; intros.
    - rewrite (ilist_invert _ il), (ilist_invert _ il'); reflexivity.
    - destruct il; destruct il'; simpl in *.
      f_equal.
      + generalize (H {| bindex := h |});
        unfold ith_Bounded; simpl; auto.
      + apply IHBound; intros.
        exact (H {| bindex := bindex idx;
                   indexb := @Build_IndexBound
                               _
                               (S n)
                               (bindex idx)
                               (h :: Bound)
                               (Fin.FS (ibound (indexb idx)))
                               (@boundi _ _ _ _ (indexb idx))
                |}).
  Qed.

  Global Arguments imap {A B B'} f {n} {As} il.
  Global Arguments BoundedIndex_eq_dec {_ _ _} _ _.

  Lemma imap_replace_BoundedIndex
        {m}
        {B B' : A -> Type}
  : forall (f : forall idx'', B idx'' -> B' idx'')
           (Bound : Vector.t A m)
           (idx : BoundedIndex Bound)
           (il : ilist Bound)
           b,
      imap f (replace_BoundedIndex il idx b) =
      replace_BoundedIndex (imap f il) idx (f _ b).
  Proof.
    intros; apply ilist_eq; intros.
    destruct (BoundedIndex_eq_dec idx idx0); subst;
    rewrite <- ith_Bounded_imap.
    - repeat rewrite ith_replace_BoundIndex_eq; reflexivity.
    - repeat rewrite ith_replace_BoundIndex_neq; auto.
      rewrite <- ith_Bounded_imap; auto.
  Qed.

End ithIndexBound.

Section ithIndexBound2.

  Import Vectors.Vector.VectorNotations.

  (* Given a bounded index [BoundedIndex Bound], we can wrap
     various lookup functions over lists indexed over [Bound].
   *)

  Context {A : Type}.

  Definition ith_Bounded2
             {m}
             {B : A -> Type}
             {Bound : Vector.t A m}
             (il : ilist2 Bound)
             (idx : BoundedIndex Bound)
    : B (Vector.nth Bound (ibound (indexb idx))) :=
    ith2 il (ibound (indexb idx)) .

  Lemma ith_Bounded_imap2
        {m}
        {B B' : A -> Type}
  : forall (f : forall idx, B idx -> B' idx)
           (Bound : Vector.t A m)
           (idx : BoundedIndex Bound)
           (il : ilist2 Bound),
      f _ (ith_Bounded2 il idx) =
      ith_Bounded2 (imap2 _ _ f Bound il) idx.
  Proof.
    unfold ith_Bounded2; simpl; intros; eapply ith_imap2.
  Qed.

  Definition replace_BoundedIndex2
             {m}
           {B : A -> Type}
           (Bound : Vector.t A m)
           (il : ilist2 Bound)
           (idx : BoundedIndex Bound)
           (new_b : B (nth_Bounded idx))
  : ilist2 Bound :=
    replace_Index2 Bound il (ibound (indexb idx)) new_b.

  Lemma ith_replace_BoundIndex2_neq
        {m}
        {B : A -> Type}
  : forall
      (Bound : Vector.t A m)
      (il : ilist2 Bound)
      (idx idx' : BoundedIndex Bound)
      (new_b : B (nth_Bounded idx')),
      idx <> idx'
      -> ith_Bounded2 (replace_BoundedIndex2 il idx' new_b) idx =
         ith_Bounded2 il idx.
  Proof.
    unfold ith_Bounded2; simpl; intros; eapply ith_replace2_Index_neq.
    eauto using idx_ibound_eq.
  Qed.

  Lemma ith_replace_BoundIndex2_eq
        {m}
        {B : A -> Type}
  : forall
      (Bound : Vector.t A m)
      (il : ilist2 Bound)
      (idx : BoundedIndex Bound)
      (new_b : B (nth_Bounded idx)),
      ith_Bounded2 (replace_BoundedIndex2 il idx new_b) idx = new_b.
  Proof.
    unfold ith_Bounded2; simpl; intros; eapply ith_replace2_Index_eq.
  Qed.

  Lemma ilist2_eq {m} {B : A -> Type}
  : forall (Bound : Vector.t A m)
           (il il' : ilist2 (B := B) Bound),
      (forall idx, ith_Bounded2 il idx = ith_Bounded2 il' idx) -> il = il'.
  Proof.
    induction Bound; intros.
    - rewrite (ilist2_invert _ il), (ilist2_invert _ il'); reflexivity.
    - destruct il; destruct il'; simpl in *.
      f_equal.
      + generalize (H {| bindex := h |});
        unfold ith_Bounded2; simpl; auto.
      + apply IHBound; intros.
        exact (H {| bindex := bindex idx;
                   indexb := @Build_IndexBound
                               _
                               (S n)
                               (bindex idx)
                               (h :: Bound)
                               (Fin.FS (ibound (indexb idx)))
                               (@boundi _ _ _ _ (indexb idx))
                |}).
  Qed.

  Global Arguments imap2 {A B B'} f {n} {As} il.

  Lemma imap_replace2_BoundedIndex
        {m}
        {B B' : A -> Type}
  : forall (f : forall idx'', B idx'' -> B' idx'')
           (Bound : Vector.t A m)
           (idx : BoundedIndex Bound)
           (il : ilist2 Bound)
           b,
      imap2 f (replace_BoundedIndex2 il idx b) =
      replace_BoundedIndex2 (imap2 f il) idx (f _ b).
  Proof.
    intros; apply ilist2_eq; intros.
    destruct (BoundedIndex_eq_dec idx idx0); subst;
    rewrite <- ith_Bounded_imap2.
    - repeat rewrite ith_replace_BoundIndex2_eq; reflexivity.
    - repeat rewrite ith_replace_BoundIndex2_neq; auto.
      rewrite <- ith_Bounded_imap2; auto.
  Qed.

End ithIndexBound2.

(*Section i2thIndexBound.

  Require Import Fiat.Common.i2list.

  (* Given a bounded index [BoundedIndex Bound], we can wrap
     various lookup functions over lists indexed over [Bound].
   *)

  Context {A : Type} {D : Set}.
  Variable (projAD : A -> D).

  (* Given a [BoundedIndex] for a list [Bound], we can always return
     an element of a list indexed by [Bound]. *)

  Definition i2th_Bounded
          {B : A -> Type}
          {C : forall a, B a -> Type}
          {As}
          (Bs : ilist B As)
          (Cs : i2list C Bs)
          (idx : BoundedIndex (map projAD As))
  : C (nth_Bounded _ As idx) (ith_Bounded projAD Bs idx) :=
    ith_Bounded_rect projAD (fun _ _ _ => C) idx Bs
                           (i2th_error' Cs (ibound idx)).

  (*Lemma ith_Bounded_imap
        {B B' : A -> Type}
  : forall (f : forall idx, B idx -> B' idx)
           (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist B Bound),
      f _ (ith_Bounded il idx) =
      ith_Bounded (imap B' f il) idx.
  Proof.
    intros.
    eapply ith_Bounded_ind2 with (idx0 := idx) (il0 := il) (il' := imap B' f il).
    destruct idx as [idx [n nth_n] ]; simpl in *; subst.
    revert Bound nth_n il;
      induction n; destruct Bound; simpl; eauto;
    intros; icons_invert; simpl; auto.
  Qed. *)

  (* We can lift [C (ith_Bounded idx)] to a dependent option. *)
  Definition Some_Dep_Option_elim_P
             {B : A -> Type}
             {C : forall a, B a -> Type}
             (As : list A)
             (Bs : ilist B As)
             (idx : BoundedIndex (map projAD As))
             (c_opt : C (nth_Bounded projAD As idx) (ith_Bounded projAD Bs idx))
  : Dep_Option_elim_P C (ith_error Bs (ibound idx)) :=
    match (nth_error As (ibound idx)) as e return
          forall nth_n
                 (b : B (@nth_Bounded' _ _ _ _ _ e nth_n))
                 b_opt,
            ith_error_eq_P projAD As idx
                           b_opt
                           nth_n
                           b
            -> C _ b
            -> Dep_Option_elim_P C (a_opt := e) b_opt with
      | Some a => fun nth_n b b_opt b_eq c =>
                    match b_eq in _ = b'
                          return C _ b' -> _ with
                      | eq_refl => fun c => c
                    end c
      | None => fun nth_n b b_opt b_eq c => I
    end (nth_error_map _ _ _ (boundi idx))
        _ _ (ith_error_eq _ _ _) c_opt.

  Definition replace_BoundedIndex2
           {B : A -> Type}
           {C : forall a, B a -> Type}
           {As}
           (Bs : ilist B As)
           (Cs : i2list C Bs)
           (idx : BoundedIndex (map projAD As))
           (new_c : C _ (ith_Bounded projAD Bs idx))
  : i2list C Bs :=
    replace_Index2' (ibound idx) Cs
                   (Some_Dep_Option_elim_P Bs idx new_c).

  Definition Dep_Option_elim2_P2
             {B : A -> Type}
             {C C' : forall a, B a -> Type}
             (P : forall a b, C a b -> C' a b -> Prop)
             (a_opt : option A)
    := match a_opt return
             forall (b : Dep_Option B a_opt),
               Dep_Option_elim_P C (a_opt := a_opt) b
               -> Dep_Option_elim_P C' (a_opt := a_opt) b -> Prop with
         | Some a => fun b => P a (Dep_Option_elim b)
         | None => fun _ _ _ => True
       end .

  Lemma Dep_Option_elim2_P2_refl
        {B : A -> Type}
        {C : forall a, B a -> Type}
  : forall a_opt b_opt c_opt,
      Dep_Option_elim2_P2 (fun (a : A) (b : B a) (c c' : C a b) => c = c')
                          (a_opt := a_opt) b_opt c_opt c_opt.
    unfold Dep_Option_elim2_P2; destruct a_opt; eauto.
  Qed.

  Definition i2th_error_eq_P
             {B : A -> Type}
             {C : forall a, B a -> Type}
             (As : list A)
             (idx : BoundedIndex (map projAD As))
             (a_opt : option A)
             (b_opt : Dep_Option B a_opt)
             (c_opt : Dep_Option_elim_P C b_opt)
             (e_eq : option_map projAD a_opt = Some (bindex idx))
             (c_opt' : C (nth_Bounded' projAD As a_opt e_eq)
                         (ith_Bounded' projAD As e_eq b_opt))
  : Type :=
      match a_opt as a_opt'
        return
        forall (b_opt : Dep_Option B a_opt')
               (e_eq : option_map projAD a_opt' = Some (bindex idx)),
          Dep_Option_elim_P C b_opt ->
          C (nth_Bounded' projAD As a_opt' e_eq)
            (ith_Bounded' projAD As e_eq b_opt)
          -> Type
      with
        | Some a =>
          fun b_opt e_eq c_opt c_opt' => c_opt = c_opt'
        | None => fun b_opt e_eq c_opt c_opt' => True
      end b_opt e_eq c_opt c_opt'.

    Lemma ilist_invert' {B} (As : list A) (il : ilist B As) :
      match As as As' return ilist B As' -> Type with
        | a :: As' => fun il => { b : _ & {il' : _ & il = icons a b il'}}
        | nil => fun il => il = inil _
      end il.
    Proof.
      destruct il; eauto.
    Qed.

    Lemma i2th_error_eq
          {B : A -> Type}
          {C : forall a, B a -> Type}
    : forall (As : list A)
             (idx : BoundedIndex (map projAD As))
             (Bs : ilist B As)
             (Cs : i2list C Bs),
        i2th_error_eq_P As idx
        (ith_error Bs (ibound idx))
        (i2th_error' Cs (ibound idx))
        (nth_error_map _ _ _ (boundi idx))
        (i2th_Bounded Cs idx).
    Proof.
      unfold i2th_error_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert As idx In_n.
      induction n; destruct Cs; simpl; eauto.
      intros; generalize (IHn As idx In_n (ilist_tl Bs) Cs); intro H';
      unfold i2th_Bounded, ith_Bounded_rect; simpl; eauto.
    Qed.

    Definition i2th_error_eq'
               {B : A -> Type}
               {C : forall a, B a -> Type}
    : forall (As : list A)
             (idx : BoundedIndex (map projAD As))
             (Bs : ilist B As)
             (c : C (nth_Bounded _ As idx) (ith_Bounded _ Bs idx)),
        i2th_error_eq_P As idx (ith_error Bs (ibound idx))
                        (Some_Dep_Option_elim_P Bs idx c)
                        (nth_error_map projAD (ibound idx) As (boundi idx)) c.
    Proof.
      unfold i2th_error_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert As idx In_n.
      induction n; destruct Bs; simpl; eauto.
      generalize (IHn As idx In_n Bs);
      unfold i2th_Bounded, ith_Bounded_rect; simpl; eauto.
    Qed.

    Program Definition i2th_Bounded_ind
            {B : A -> Type}
            {C C' : forall a, B a -> Type}
            (P : forall As (Bs : ilist B As) (Cs : i2list C Bs),
                   BoundedIndex (map projAD As)
                   -> forall (a : A) (b : B a), C a b -> C' a b -> Prop)
    : forall (As : list A)
           (idx : BoundedIndex (map projAD As))
           (Bs : ilist B As)
           (Cs : i2list C Bs)
           (c : C' (nth_Bounded _ As idx) (ith_Bounded _ Bs idx)),
        Dep_Option_elim2_P2 (P As Bs Cs idx)
                          (ith_error Bs (ibound idx))
                          (i2th_error' Cs (ibound idx))
                          (Some_Dep_Option_elim_P Bs idx c)
        -> P As Bs Cs idx _ (ith_Bounded _ Bs idx) (i2th_Bounded Cs idx) c
      := fun As idx Bs Cs c H =>
         match (nth_error As (ibound idx)) as e
               return
               forall (b_opt : Dep_Option B e) (c_opt : Dep_Option_elim_P C b_opt)
                       (c'_opt : Dep_Option_elim_P C' b_opt)
                       (e_eq : option_map projAD e = Some (bindex idx))
                       (d : C (nth_Bounded' projAD As e e_eq)
                              (ith_Bounded' projAD As e_eq b_opt))
                       (d' : C' (nth_Bounded' projAD As e e_eq)
                                (ith_Bounded' projAD As e_eq b_opt)),
                 i2th_error_eq_P As idx b_opt c_opt e_eq d ->
                 i2th_error_eq_P As idx b_opt c'_opt e_eq d' ->
                 Dep_Option_elim2_P2 (P As Bs Cs idx) b_opt c_opt c'_opt ->
                  P As Bs Cs idx (nth_Bounded' projAD _ e e_eq)
                    (ith_Bounded' projAD _ e_eq _) d d'
         with
           | Some a => fun b_opt c_opt c'_opt e_eq d d' c_eq c_eq' => _
           | None => fun b_opt c_opt c'_opt e_eq d d' => None_neq_Some _ e_eq
         end (ith_error Bs (ibound idx))
             (i2th_error' Cs (ibound idx))
             (Some_Dep_Option_elim_P _ _ c)
             (nth_error_map projAD (ibound idx) As (boundi idx))
             _ _ (i2th_error_eq _ _) (i2th_error_eq' _ _ _) H.

    Program Definition i2th_Bounded_ind2
            {B : A -> Type}
            {C C' : forall a, B a -> Type}
            (P : forall As (Bs : ilist B As) (Cs : i2list C Bs),
                   BoundedIndex (map projAD As)
                   -> forall (a : A) (b : B a), C a b -> C' a b -> Prop)
  : forall (As : list A)
           (idx : BoundedIndex (map projAD As))
           (Bs : ilist B As)
           (Cs : i2list C Bs)
           (Cs' : i2list C' Bs),
      Dep_Option_elim2_P2 (P As Bs Cs idx)
                          (ith_error Bs (ibound idx))
                          (i2th_error' Cs (ibound idx))
                          (i2th_error' Cs' (ibound idx))
      -> P As Bs Cs idx _ (ith_Bounded _ Bs idx)
           (i2th_Bounded Cs idx)
           (i2th_Bounded Cs' idx)
      := fun As idx Bs Cs Cs' H =>
         match (nth_error As (ibound idx)) as e
               return
               forall (b_opt : Dep_Option B e) (c_opt : Dep_Option_elim_P C b_opt)
                       (c'_opt : Dep_Option_elim_P C' b_opt)
                       (e_eq : option_map projAD e = Some (bindex idx))
                       (d : C (nth_Bounded' projAD As e e_eq)
                              (ith_Bounded' projAD As e_eq b_opt))
                       (d' : C' (nth_Bounded' projAD As e e_eq)
                                (ith_Bounded' projAD As e_eq b_opt)),
                 i2th_error_eq_P As idx b_opt c_opt e_eq d ->
                 i2th_error_eq_P As idx b_opt c'_opt e_eq d' ->
                 Dep_Option_elim2_P2 (P As Bs Cs idx) b_opt c_opt c'_opt ->
                  P As Bs Cs idx (nth_Bounded' projAD _ e e_eq)
                    (ith_Bounded' projAD _ e_eq _) d d'
         with
           | Some a => fun b_opt c_opt c'_opt e_eq d d' c_eq c_eq' => _
           | None => fun b_opt c_opt c'_opt e_eq d d' => None_neq_Some _ e_eq
         end (ith_error Bs (ibound idx))
             (i2th_error' Cs (ibound idx))
             (i2th_error' Cs' (ibound idx))
             (nth_error_map projAD (ibound idx) As (boundi idx))
             _ _ (i2th_error_eq _ _) (i2th_error_eq _ _) H.

    Definition Dep_Option_elim2_T2
             {B : A -> Type}
             {C C' : forall a, B a -> Type}
             (P : forall a b, C a b -> C' a b -> Type)
             (a_opt : option A)
    := match a_opt return
             forall (b : Dep_Option B a_opt),
               Dep_Option_elim_P C (a_opt := a_opt) b
               -> Dep_Option_elim_P C' (a_opt := a_opt) b -> Type with
         | Some a => fun b => P a (Dep_Option_elim b)
         | None => fun _ _ _ => True
       end .

    Program Definition i2th_Bounded_rect
            {B : A -> Type}
            {C C' : forall a, B a -> Type}
            (P : forall As (Bs : ilist B As) (Cs : i2list C Bs),
                   BoundedIndex (map projAD As)
                   -> forall (a : A) (b : B a), C a b -> C' a b -> Type)
    : forall (As : list A)
           (idx : BoundedIndex (map projAD As))
           (Bs : ilist B As)
           (Cs : i2list C Bs)
           (c : C' (nth_Bounded _ As idx) (ith_Bounded _ Bs idx)),
        Dep_Option_elim2_T2 (P As Bs Cs idx)
                          (ith_error Bs (ibound idx))
                          (i2th_error' Cs (ibound idx))
                          (Some_Dep_Option_elim_P Bs idx c)
        -> P As Bs Cs idx _ (ith_Bounded _ Bs idx) (i2th_Bounded Cs idx) c
      := fun As idx Bs Cs c H =>
         match (nth_error As (ibound idx)) as e
               return
               forall (b_opt : Dep_Option B e) (c_opt : Dep_Option_elim_P C b_opt)
                       (c'_opt : Dep_Option_elim_P C' b_opt)
                       (e_eq : option_map projAD e = Some (bindex idx))
                       (d : C (nth_Bounded' projAD As e e_eq)
                              (ith_Bounded' projAD As e_eq b_opt))
                       (d' : C' (nth_Bounded' projAD As e e_eq)
                                (ith_Bounded' projAD As e_eq b_opt)),
                 i2th_error_eq_P As idx b_opt c_opt e_eq d ->
                 i2th_error_eq_P As idx b_opt c'_opt e_eq d' ->
                 Dep_Option_elim2_T2 (P As Bs Cs idx) b_opt c_opt c'_opt ->
                  P As Bs Cs idx (nth_Bounded' projAD _ e e_eq)
                    (ith_Bounded' projAD _ e_eq _) d d'
         with
           | Some a => fun b_opt c_opt c'_opt e_eq d d' c_eq c_eq' => _
           | None => fun b_opt c_opt c'_opt e_eq d d' => None_neq_Some _ e_eq
         end (ith_error Bs (ibound idx))
             (i2th_error' Cs (ibound idx))
             (Some_Dep_Option_elim_P _ _ c)
             (nth_error_map projAD (ibound idx) As (boundi idx))
             _ _ (i2th_error_eq _ _) (i2th_error_eq' _ _ _) H.

  Variable D_eq_dec : forall d d' : D, {d = d'} + {d <> d'}.

  Lemma i2th_replace_BoundIndex_neq
        {B : A -> Type}
        {C : forall a, B a -> Type}
  : forall
      {As}
      (Bs : ilist B As)
      (Cs : i2list C Bs)
      (idx idx' : BoundedIndex (map projAD As))
      (new_c : C _ (ith_Bounded projAD Bs idx')),
      idx <> idx'
      -> i2th_Bounded (replace_BoundedIndex2 Cs idx' new_c) idx =
         i2th_Bounded Cs idx.
  Proof.
    intros.
    eapply (i2th_Bounded_ind2
              (fun As Bs Cs idx a b c c' => c = c')).
    unfold replace_BoundedIndex2.
    rewrite i2th_replace_Index'_neq; eauto using idx_ibound_eq, Dep_Option_elim2_P2_refl.
  Qed.

  Lemma i2th_replace_BoundIndex_eq
        {B : A -> Type}
        {C : forall a, B a -> Type}
  : forall
      {As}
      (Bs : ilist B As)
      (Cs : i2list C Bs)
      (idx : BoundedIndex (map projAD As))
      (new_c : C _ (ith_Bounded projAD Bs idx)),
      i2th_Bounded (replace_BoundedIndex2 Cs idx new_c) idx =
      new_c.
  Proof.
    intros.
    eapply (i2th_Bounded_ind
              (fun As Bs Cs idx a b c c' => c = c')).
    unfold replace_BoundedIndex2.
    rewrite i2th_replace_Index'_eq; eauto using idx_ibound_eq, Dep_Option_elim2_P2_refl.
  Qed.

End i2thIndexBound.

Section ith2IndexBound.

  Require Import Fiat.Common.ilist2.

  (* Given a bounded index [BoundedIndex Bound], we can wrap
     various lookup functions over lists indexed over [Bound].
   *)

  Context {A : Type} {C : Set}.
  Variable (projAC : A -> C).

  (* Given a [BoundedIndex] for a list [Bound], we can always return
     an element of a list indexed by [Bound]. *)

  Definition ith2_Bounded'
          {B : A -> Type}
          (As : list A)
          (d : C)
          (a_opt : option A)
  : forall (nth_n : option_map projAC a_opt = Some d),
      Dep_Option B a_opt
      -> B (nth_Bounded' projAC As a_opt nth_n) :=
    match a_opt as a'
          return
          forall (f : option_map projAC a' = Some d),
            Dep_Option B a' ->
            B (nth_Bounded' projAC As _ f) with
      | Some a => fun nth_n b => Dep_Option_elim b
      | None => fun nth_n b => None_neq_Some _ nth_n
    end.

  Definition ith2_Bounded
          {B : A -> Type}
          {Bound}
          (il : ilist2 B Bound)
          (idx : BoundedIndex (map projAC Bound))
  : B (nth_Bounded projAC Bound idx) :=
    ith2_Bounded' Bound (nth_error_map _ _ _ (boundi idx))
                 (ith2_error il (ibound idx)).

  (*match (nth_error Bound (ibound idx)) as a'
                  return
                  Dep_Option B a' ->
                  forall (f : option_map _ a' = Some (bindex idx)),
                    B (nth_Bounded' Bound _ f) with
        | Some a => fun b _ => Dep_Option_elim b
        | None => fun _ f => None_neq_Some _ f
    end (ith2_error il (ibound idx)) (nth_error_map _ _ (boundi idx)). *)

  (* To build a reasoning principle for ith2_Bounded, we need to
     show that option types are shuffled around by [Dep_Option_elim] *)
    Definition ith2_error_eq_P
               {B : A -> Type}
               (Bound : list A)
               (idx : BoundedIndex (map projAC Bound))
               e' b c d :=
      match e' as e'
        return
        (Dep_Option B e' ->
         forall c : option_map _ e' = Some (bindex idx),
           B (nth_Bounded' projAC Bound _ c) -> Type)
      with
        | Some e =>
          fun b c d => Dep_Option_elim b = d
        | None => fun b c d => True
      end b c d.

    Lemma ith2_error_eq
          {B : A -> Type}
    : forall (Bound : list A)
             (idx : BoundedIndex (map projAC Bound))
              (il : ilist2 B Bound),
        ith2_error_eq_P Bound idx
        (ith2_error il (ibound idx))
        (nth_error_map _ _ _ (boundi idx))
        (ith2_Bounded il idx).
    Proof.
      unfold ith2_error_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert n In_n; induction Bound; destruct n;
      simpl; eauto; intros.
      eapply IHBound.
    Defined.

    (* [ith2_Bounded_rect] builds a function whose type depends
     on [ith2_Bounded] by reducing to a case with [ith2_error],
     which is easier to work/reason with. *)

    Definition ith2_Bounded_rect
            {B : A -> Type}
        (P : forall As, BoundedIndex (map projAC As)
                        -> ilist2 B As -> forall a : A, B a -> Type)
  : forall (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound),
      Dep_Option_elim_P (P Bound idx il) (ith2_error il (ibound idx))
      -> P Bound idx il _ (ith2_Bounded il idx) :=
      fun Bound idx il =>
                match (nth_error Bound (ibound idx)) as e
                      return
                      forall (b : Dep_Option B e)
                             (c : option_map _ e = Some (bindex idx))
                             d,
                        (ith2_error_eq_P Bound idx b c d)
                        -> Dep_Option_elim_P (P Bound idx il) b ->
                        P _ _ _ (@nth_Bounded' _ _ projAC _ _ e c) d with
                  | Some a => fun b e_eq d c_eq =>
                                match c_eq with
                                  | eq_refl => fun b_opt => b_opt
                                end
                  | None => fun _ e_eq _ _ _ => None_neq_Some _ e_eq
                end (ith2_error il (ibound idx))
                    _
                    (ith2_Bounded il idx)
                    (ith2_error_eq idx il).

    Definition ith2_Bounded_rect2
               {B B' : A -> Type}
        (P : forall As, BoundedIndex (map projAC As)
                        -> ilist2 B As
                        -> ilist2 B' As
                        -> forall a : A, B a -> B' a -> Type)
        (Bound : list A)
        (idx : BoundedIndex (map projAC Bound))
        (il : ilist2 B Bound)
        (il' : ilist2 B' Bound)
    : Dep_Option_elim_T2 (P Bound idx il il')
                         (ith2_error il (ibound idx))
                         (ith2_error il' (ibound idx))
      -> P Bound idx il il' _
           (ith2_Bounded il idx)
           (ith2_Bounded il' idx) :=
      match (nth_error Bound (ibound idx)) as e
                 return
                 forall (b : Dep_Option B e)
                        (b' : Dep_Option B' e)
                        (c : option_map _ e = Some (bindex idx))
                        d d',
                   (ith2_error_eq_P Bound idx b c d)
                   -> (ith2_error_eq_P Bound idx b' c d')
                   -> Dep_Option_elim_T2 (P Bound idx il il') b b' ->
                   P _ _ _ _ (@nth_Bounded' _ _ projAC _ _ _ c) d d' with
        | Some a => fun b b' e_eq d d' d_eq d'_eq =>
                      match d_eq, d'_eq with
                        | eq_refl, eq_refl => fun b_opt => b_opt
                      end
        | None => fun b b' e_eq d d' d_eq d'_eq => None_neq_Some _ e_eq
           end (ith2_error il (ibound idx))
               (ith2_error il' (ibound idx) )
               _
               (ith2_Bounded il idx)
               (ith2_Bounded il' idx)
               (ith2_error_eq idx il)
               (ith2_error_eq idx il').

    (* [ith2_Bounded_ind] builds a proof whose type depends
     on both [nth_Bounded] and an occurence of [ith2_Bounded] by reducing
     it to a case with an [ith2_error], which is easier to reason with. *)

    Program Definition ith2_Bounded_ind
            {B B' : A -> Type}
            (P : forall As, BoundedIndex (map projAC As)
                        -> ilist2 B As
                        -> forall a : A, B a -> B' a -> Prop)
  : forall (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound)
           (b : B' (nth_Bounded projAC Bound idx)),
      Dep_Option_elim_P2 (P Bound idx il) (ith2_error il (ibound idx))
                      (Some_Dep_Option projAC Bound idx b)
      -> P Bound idx il _ (ith2_Bounded il idx) b :=
      fun Bound idx il b =>
        match (nth_error Bound (ibound idx)) as e
              return
              forall (b : Dep_Option B e)
                     (b' : Dep_Option B' e)
                     (c : option_map _ e = Some (bindex idx))
                     d d',
                (ith2_error_eq_P Bound idx b c d)
                -> (ith2_error_eq_P Bound idx b' c d')
                -> Dep_Option_elim_P2 (P Bound idx il) b b' ->
                P _ _ _ (@nth_Bounded' _ _ projAC _ _ _ c) d d' with
          | Some a => _
          | None => _
        end (ith2_error il (ibound idx))
            (Some_Dep_Option projAC Bound idx b)
            _
            (ith2_Bounded il idx)
            b
            (ith2_error_eq idx il)
            _.
    Next Obligation.
      unfold ith2_error_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert n In_n b; clear.
      induction Bound; destruct n; simpl; intros; eauto.
      unfold Some_Dep_Option; simpl.
      intros; eapply IHBound.
    Qed.

    (* [ith2_Bounded_ind2] builds a proof whose type depends
     on *two* occurences of [ith2_Bounded] by reducing  it to a case
     with two [ith2_error]s, which is easier to reason with. *)

    Program Definition ith2_Bounded_ind2
            {B B' : A -> Type}
            (P : forall As, BoundedIndex (map projAC As)
                        -> ilist2 B As
                        -> forall a : A, B a -> B' a -> Prop)
  : forall (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound)
           (il' : ilist2 B' Bound),
      Dep_Option_elim_P2 (P Bound idx il)
                      (ith2_error il (ibound idx))
                      (ith2_error il' (ibound idx) )
      -> P Bound idx il _ (ith2_Bounded il idx) (ith2_Bounded il' idx) :=
    fun Bound idx il il' =>
      match (nth_error Bound (ibound idx)) as e
                 return
                 forall (b : Dep_Option B e)
                        (b' : Dep_Option B' e)
                        (c : option_map _ e = Some (bindex idx))
                        d d',
                   (ith2_error_eq_P Bound idx b c d)
                   -> (ith2_error_eq_P Bound idx b' c d')
                   -> Dep_Option_elim_P2 (P Bound idx il) b b' ->
                   P _ _ _ (@nth_Bounded' _ _ projAC _ _ _ c) d d' with
          | Some a => _
          | None => _
           end (ith2_error il (ibound idx))
               (ith2_error il' (ibound idx) )
               _
               (ith2_Bounded il idx)
               (ith2_Bounded il' idx)
               (ith2_error_eq idx il)
               (ith2_error_eq idx il').

    Program Definition ith2_Bounded_ind3
            {B B' B'' : A -> Type}
            (P : forall As,
                   BoundedIndex (map projAC As)
                   -> ilist2 B As
                   -> ilist2 B' As
                   -> ilist2 B'' As
                   -> forall a : A,
                        B a -> B' a -> B'' a -> Prop)
  : forall (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound)
           (il' : ilist2 B' Bound)
           (il'' : ilist2 B'' Bound),
      Dep_Option_elim_P3 (P Bound idx il il' il'')
                      (ith2_error il (ibound idx))
                      (ith2_error il' (ibound idx))
                      (ith2_error il'' (ibound idx))
      -> P Bound idx il il' il'' _
           (ith2_Bounded il idx)
           (ith2_Bounded il' idx)
           (ith2_Bounded il'' idx) :=
    fun Bound idx il il' il'' =>
      match (nth_error Bound (ibound idx)) as e
                 return
                 forall (b : Dep_Option B e)
                        (b' : Dep_Option B' e)
                        (b'' : Dep_Option B'' e)
                        (c : option_map _ e = Some (bindex idx))
                        d d' d'',
                   (ith2_error_eq_P Bound idx b c d)
                   -> (ith2_error_eq_P Bound idx b' c d')
                   -> (ith2_error_eq_P Bound idx b'' c d'')
                   -> Dep_Option_elim_P3 (P Bound idx il il' il'') b b' b'' ->
                   P Bound idx il il' il''
                     (@nth_Bounded' _ _ _ _ _ _ c)
                     d d' d'' with
          | Some a => _
          | _  => _
           end (ith2_error il (ibound idx))
               (ith2_error il' (ibound idx) )
               (ith2_error il'' (ibound idx) )
               _
               (ith2_Bounded il idx)
               (ith2_Bounded il' idx)
               (ith2_Bounded il'' idx)
               (ith2_error_eq idx il)
               (ith2_error_eq idx il')
               (ith2_error_eq idx il'').

  Lemma ith2_Bounded_imap
        {B B' : A -> Type}
  : forall (f : forall idx, B idx -> B' idx)
           (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound),
      f _ (ith2_Bounded il idx) =
      ith2_Bounded (imap2 B' f il) idx.
  Proof.
    intros.
    eapply ith2_Bounded_ind2 with (idx0 := idx) (il0 := il) (il' := imap2 B' f il).
    destruct idx as [idx [n nth_n] ]; simpl in *; subst.
    revert Bound nth_n il;
      induction n; destruct Bound; simpl; eauto;
    intros; icons2_invert; simpl; auto.
  Qed.

  Definition replace2_BoundedIndex
           {B : A -> Type}
           (Bound : list A)
           (il : ilist2 B Bound)
           (idx : BoundedIndex (map projAC Bound))
           (new_b : B (nth_Bounded projAC Bound idx))
  : ilist2 B Bound :=
    replace_Index2 (ibound idx) il (Dep_Option_elim (Some_Dep_Option _ _ _ new_b)).

  Variable C_eq_dec : forall c c' : C, {c = c'} + {c <> c'}.

  Lemma ith2_replace_BoundIndex_neq
        {B : A -> Type}
  : forall
      (Bound : list A)
      (il : ilist2 _ Bound)
      (idx idx' : BoundedIndex (map projAC Bound))
      (new_b : B (nth_Bounded projAC Bound idx')),
      idx <> idx'
      -> ith2_Bounded (replace2_BoundedIndex il idx' new_b) idx =
         ith2_Bounded il idx.
  Proof.
    intros.
    eapply ith2_Bounded_ind2 with (idx0 := idx) (il0 := replace2_BoundedIndex il idx' new_b)
                                                (il' := il).
    eapply ith2_replace_Index2_neq; eauto using idx_ibound_eq.
  Qed.

  Lemma ith2_replace_BoundIndex_eq
        {B : A -> Type}
  : forall
      (Bound : list A)
      (il : ilist2 _ Bound)
      (idx : BoundedIndex (map projAC Bound))
      (new_b : B (nth_Bounded projAC Bound idx)),
      ith2_Bounded (replace2_BoundedIndex il idx new_b) idx = new_b.
  Proof.
    intros.
    eapply ith2_Bounded_ind with (idx0 := idx)
                                  (il0 := replace2_BoundedIndex il idx new_b)
                                  (P := fun Bound idx il a il' b => il' = b).
    eapply ith2_replace_Index2_eq; eauto.
  Qed.

  Lemma ith2_replace_BoundedIndex_ind
        {B : A -> Type}
        (P : forall As (idx : BoundedIndex (map projAC As)),
               B (nth_Bounded projAC As idx)
               -> B (nth_Bounded projAC As idx) -> Prop)
  : forall (Bound : list A)
           (idx idx' : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound)
           (new_b : B (nth_Bounded projAC Bound idx')),
      (forall idx :  BoundedIndex (map projAC Bound),
         ibound idx <> ibound idx'
         -> P _ idx (ith2_Bounded il idx)
              (ith2_Bounded il idx))
      -> P _ idx' (ith2_Bounded il idx') new_b
      -> P _ idx
           (ith2_Bounded il idx)
           (ith2_Bounded (replace2_BoundedIndex il idx' new_b) idx).
  Proof.
    intros.
    destruct (BoundedIndex_eq_dec C_eq_dec idx idx'); subst.
    + rewrite ith2_replace_BoundIndex_eq; assumption.
    + rewrite ith2_replace_BoundIndex_neq;
      unfold not; eauto using idx_ibound_eq.
  Qed.

  Lemma ilist2_eq {B : A -> Type}
  : forall (Bound : list A)
           (il il' : ilist2 B Bound),
      (forall idx, ith2_Bounded il idx = ith2_Bounded il' idx) -> il = il'.
  Proof.
    induction Bound; intros.
    - rewrite (ilist2_invert il), (ilist2_invert il'); reflexivity.
    - icons2_invert; f_equal.
      generalize (H {| bindex := projAC a;
                       indexb := IndexBound_head _ _  |}).
      unfold ith2_Bounded; simpl; auto.
      apply IHBound; intros.
      generalize (H  {| bindex := bindex idx;
                       indexb := @IndexBound_tail _ _ _ _ (indexb idx) |}).
      unfold ith2_Bounded; simpl; auto.
  Qed.

  Lemma imap2_replace2_BoundedIndex
        {B B' : A -> Type}
  : forall (f : forall idx'', B idx'' -> B' idx'')
           (Bound : list A)
           (idx : BoundedIndex (map projAC Bound))
           (il : ilist2 B Bound)
           b,
      imap2 B' f (replace2_BoundedIndex il idx b) =
      replace2_BoundedIndex (imap2 B' f il) idx (f _ b).
  Proof.
    intros; apply ilist2_eq; intros.
    destruct (BoundedIndex_eq_dec C_eq_dec idx idx0); subst;
    rewrite <- ith2_Bounded_imap.
    - repeat rewrite ith2_replace_BoundIndex_eq; reflexivity.
    - repeat rewrite ith2_replace_BoundIndex_neq; auto.
      rewrite <- ith2_Bounded_imap; auto.
  Qed.

End ith2IndexBound.

Section i2th2IndexBound.

  Require Import Fiat.Common.i2list2.

  (* Given a bounded index [BoundedIndex Bound], we can wrap
     various lookup functions over lists indexed over [Bound].
   *)

  Context {A : Type} {D : Set}.
  Variable (projAD : A -> D).

  (* Given a [BoundedIndex] for a list [Bound], we can always return
     an element of a list indexed by [Bound]. *)

  Definition i2th2_Bounded
          {B B' : A -> Type}
          {C : forall a, B a -> B' a -> Type}
          {As}
          (Bs : ilist B As)
          (Bs' : ilist B' As)
          (Cs : i2list2 C Bs Bs')
          (idx : BoundedIndex (map projAD As))
  : C (nth_Bounded _ As idx)
      (ith_Bounded projAD Bs idx)
      (ith_Bounded projAD Bs' idx) :=
    ith_Bounded_rect2 projAD (fun _ _ _ _ => C) idx Bs Bs'
                       (i2th_error2' Cs (ibound idx)).

  (*Definition Some_Dep_Option_elim_P2
             {B : A -> Type}
             {C : forall a, B a -> Type}
             (As : list A)
             (Bs : ilist2 B As)
             (idx : BoundedIndex (map projAD As))
             (c_opt : C (nth_Bounded projAD As idx) (ith2_Bounded projAD Bs idx))
  : Dep_Option_elim_P C (ith2_error Bs (ibound idx)) :=
    match (nth_error As (ibound idx)) as e return
          forall nth_n
                 (b : B (@nth_Bounded' _ _ _ _ _ e nth_n))
                 b_opt,
            ith_error_eq_P projAD As idx
                           b_opt
                           nth_n
                           b
            -> C _ b
            -> Dep_Option_elim_P C (a_opt := e) b_opt with
      | Some a => fun nth_n b b_opt b_eq c =>
                    match b_eq in _ = b'
                          return C _ b' -> _ with
                      | eq_refl => fun c => c
                    end c
      | None => fun nth_n b b_opt b_eq c => I
    end (nth_error_map _ _ _ (boundi idx))
        _ _ (ith2_error_eq _ _ _) c_opt.

  Definition replace2_BoundedIndex2
           {B : A -> Type}
           {C : forall a, B a -> Type}
           {As}
           (Bs : ilist2 B As)
           (Cs : i2list2 C Bs)
           (idx : BoundedIndex (map projAD As))
           (new_c : C _ (ith2_Bounded projAD Bs idx))
  : i2list2 C Bs :=
    replace_2Index2' (ibound idx) Cs
                   (Some_Dep_Option_elim_P2 Bs idx new_c).

  Definition Dep_Option_2elim2_P2
             {B : A -> Type}
             {C C' : forall a, B a -> Type}
             (P : forall a b, C a b -> C' a b -> Prop)
             (a_opt : option A)
    := match a_opt return
             forall (b : Dep_Option B a_opt),
               Dep_Option_elim_P C (a_opt := a_opt) b
               -> Dep_Option_elim_P C' (a_opt := a_opt) b -> Prop with
         | Some a => fun b => P a (Dep_Option_elim b)
         | None => fun _ _ _ => True
       end .

  Lemma Dep_Option_2elim2_P2_refl
        {B : A -> Type}
        {C C' : forall a, B a -> Type}
  : forall a_opt b_opt c_opt,
      Dep_Option_2elim2_P2 (fun (a : A) (b : B a) (c c' : C a b) => c = c')
                          (a_opt := a_opt) b_opt c_opt c_opt.
    unfold Dep_Option_2elim2_P2; destruct a_opt; eauto.
  Qed.

  Definition i2th_error2_eq_P
             {B : A -> Type}
             {C : forall a, B a -> Type}
             (As : list A)
             (idx : BoundedIndex (map projAD As))
             (a_opt : option A)
             (b_opt : Dep_Option B a_opt)
             (c_opt : Dep_Option_elim_P C b_opt)
             (e_eq : option_map projAD a_opt = Some (bindex idx))
             (c_opt' : C (nth_Bounded' projAD As a_opt e_eq)
                         (ith2_Bounded' projAD As e_eq b_opt))
  : Type :=
      match a_opt as a_opt'
        return
        forall (b_opt : Dep_Option B a_opt')
               (e_eq : option_map projAD a_opt' = Some (bindex idx)),
          Dep_Option_elim_P C b_opt ->
          C (nth_Bounded' projAD As a_opt' e_eq)
            (ith2_Bounded' projAD As e_eq b_opt)
          -> Type
      with
        | Some a =>
          fun b_opt e_eq c_opt c_opt' => c_opt = c_opt'
        | None => fun b_opt e_eq c_opt c_opt' => True
      end b_opt e_eq c_opt c_opt'.

    Lemma i2th_error2_eq
          {B : A -> Type}
          {C : forall a, B a -> Type}
    : forall (As : list A)
             (idx : BoundedIndex (map projAD As))
             (Bs : ilist2 B As)
             (Cs : i2list2 C Bs),
        i2th_error2_eq_P As idx
        (ith2_error Bs (ibound idx))
        (i2th_error2' Cs (ibound idx))
        (nth_error_map _ _ _ (boundi idx))
        (i2th2_Bounded Cs idx).
    Proof.
      unfold i2th_error2_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert As idx In_n.
      induction n; destruct Cs; simpl; eauto.
      intros; generalize (IHn As idx In_n (ilist2_tl Bs) Cs); intro H';
      unfold i2th_Bounded, ith2_Bounded_rect; simpl; eauto.
    Qed.

    Definition i2th_error2_eq'
               {B : A -> Type}
               {C : forall a, B a -> Type}
    : forall (As : list A)
             (idx : BoundedIndex (map projAD As))
             (Bs : ilist2 B As)
             (c : C (nth_Bounded _ As idx) (ith2_Bounded _ Bs idx)),
        i2th_error2_eq_P As idx (ith2_error Bs (ibound idx))
                        (Some_Dep_Option_elim_P2 Bs idx c)
                        (nth_error_map projAD (ibound idx) As (boundi idx)) c.
    Proof.
      unfold i2th_error2_eq_P; simpl.
      destruct idx as [idx [n In_n ]]; simpl in *.
      revert As idx In_n.
      induction n; destruct Bs; simpl; eauto.
      generalize (IHn As idx In_n Bs);
      unfold i2th_Bounded, ith2_Bounded_rect; simpl; eauto.
    Qed.

    Program Definition i2th_Bounded2_ind
            {B : A -> Type}
            {C C' : forall a, B a -> Type}
            (P : forall As (Bs : ilist2 B As) (Cs : i2list2 C Bs),
                   BoundedIndex (map projAD As)
                   -> forall (a : A) (b : B a), C a b -> C' a b -> Prop)
    : forall (As : list A)
           (idx : BoundedIndex (map projAD As))
           (Bs : ilist2 B As)
           (Cs : i2list2 C Bs)
           (c : C' (nth_Bounded _ As idx) (ith2_Bounded _ Bs idx)),
        Dep_Option_elim2_P2 (P As Bs Cs idx)
                          (ith2_error Bs (ibound idx))
                          (i2th_error2' Cs (ibound idx))
                          (Some_Dep_Option_elim_P2 Bs idx c)
        -> P As Bs Cs idx _ (ith2_Bounded _ Bs idx) (i2th2_Bounded Cs idx) c
      := fun As idx Bs Cs c H =>
         match (nth_error As (ibound idx)) as e
               return
               forall (b_opt : Dep_Option B e) (c_opt : Dep_Option_elim_P C b_opt)
                       (c'_opt : Dep_Option_elim_P C' b_opt)
                       (e_eq : option_map projAD e = Some (bindex idx))
                       (d : C (nth_Bounded' projAD As e e_eq)
                              (ith2_Bounded' projAD As e_eq b_opt))
                       (d' : C' (nth_Bounded' projAD As e e_eq)
                                (ith2_Bounded' projAD As e_eq b_opt)),
                 i2th_error2_eq_P As idx b_opt c_opt e_eq d ->
                 i2th_error2_eq_P As idx b_opt c'_opt e_eq d' ->
                 Dep_Option_elim2_P2 (P As Bs Cs idx) b_opt c_opt c'_opt ->
                  P As Bs Cs idx (nth_Bounded' projAD _ e e_eq)
                    (ith2_Bounded' projAD _ e_eq _) d d'
         with
           | Some a => fun b_opt c_opt c'_opt e_eq d d' c_eq c_eq' => _
           | None => fun b_opt c_opt c'_opt e_eq d d' => None_neq_Some _ e_eq
         end (ith2_error Bs (ibound idx))
             (i2th_error2' Cs (ibound idx))
             (Some_Dep_Option_elim_P2 _ _ c)
             (nth_error_map projAD (ibound idx) As (boundi idx))
             _ _ (i2th_error2_eq _ _) (i2th_error2_eq' _ _ _) H.

    Program Definition i2th_Bounded2_ind2
            {B : A -> Type}
            {C C' : forall a, B a -> Type}
            (P : forall As (Bs : ilist2 B As) (Cs : i2list2 C Bs),
                   BoundedIndex (map projAD As)
                   -> forall (a : A) (b : B a), C a b -> C' a b -> Prop)
  : forall (As : list A)
           (idx : BoundedIndex (map projAD As))
           (Bs : ilist2 B As)
           (Cs : i2list2 C Bs)
           (Cs' : i2list2 C' Bs),
      Dep_Option_elim2_P2 (P As Bs Cs idx)
                          (ith2_error Bs (ibound idx))
                          (i2th_error2' Cs (ibound idx))
                          (i2th_error2' Cs' (ibound idx))
      -> P As Bs Cs idx _ (ith2_Bounded _ Bs idx)
           (i2th2_Bounded Cs idx)
           (i2th2_Bounded Cs' idx)
      := fun As idx Bs Cs Cs' H =>
         match (nth_error As (ibound idx)) as e
               return
               forall (b_opt : Dep_Option B e) (c_opt : Dep_Option_elim_P C b_opt)
                       (c'_opt : Dep_Option_elim_P C' b_opt)
                       (e_eq : option_map projAD e = Some (bindex idx))
                       (d : C (nth_Bounded' projAD As e e_eq)
                              (ith2_Bounded' projAD As e_eq b_opt))
                       (d' : C' (nth_Bounded' projAD As e e_eq)
                                (ith2_Bounded' projAD As e_eq b_opt)),
                 i2th_error2_eq_P As idx b_opt c_opt e_eq d ->
                 i2th_error2_eq_P As idx b_opt c'_opt e_eq d' ->
                 Dep_Option_elim2_P2 (P As Bs Cs idx) b_opt c_opt c'_opt ->
                  P As Bs Cs idx (nth_Bounded' projAD _ e e_eq)
                    (ith2_Bounded' projAD _ e_eq _) d d'
         with
           | Some a => fun b_opt c_opt c'_opt e_eq d d' c_eq c_eq' => _
           | None => fun b_opt c_opt c'_opt e_eq d d' => None_neq_Some _ e_eq
         end (ith2_error Bs (ibound idx))
             (i2th_error2' Cs (ibound idx))
             (i2th_error2' Cs' (ibound idx))
             (nth_error_map projAD (ibound idx) As (boundi idx))
             _ _ (i2th_error2_eq _ _) (i2th_error2_eq _ _) H.

  Variable D_eq_dec : forall d d' : D, {d = d'} + {d <> d'}.

  Lemma i2th_replace2_BoundIndex_neq
        {B : A -> Type}
        {C : forall a, B a -> Type}
  : forall
      {As}
      (Bs : ilist2 B As)
      (Cs : i2list2 C Bs)
      (idx idx' : BoundedIndex (map projAD As))
      (new_c : C _ (ith2_Bounded projAD Bs idx')),
      idx <> idx'
      -> i2th2_Bounded (replace2_BoundedIndex2 Cs idx' new_c) idx =
         i2th2_Bounded Cs idx.
  Proof.
    intros.
    pose (i2th_Bounded2_ind2 (B := B) (C' := C)
              (fun As Bs Cs idx a b c c' => c = c')).
    unfold replace2_BoundedIndex2.
    unfold i2th2_Bounded.
    rewrite i2th_replace_2Index2'_neq; eauto using idx_ibound_eq, Dep_Option_elim2_P2_refl.
  Qed.

  Lemma i2th_replace2_BoundIndex_eq
        {B : A -> Type}
        {C : forall a, B a -> Type}
  : forall
      {As}
      (Bs : ilist2 B As)
      (Cs : i2list2 C Bs)
      (idx : BoundedIndex (map projAD As))
      (new_c : C _ (ith2_Bounded projAD Bs idx)),
      i2th2_Bounded (replace2_BoundedIndex2 Cs idx new_c) idx =
      new_c.
  Proof.
    intros.
    eapply (i2th_Bounded2_ind
              (fun As Bs Cs idx a b c c' => c = c')).
    unfold replace2_BoundedIndex2.
    rewrite i2th_replace_2Index2'_eq; eauto using idx_ibound_eq, Dep_Option_elim2_P2_refl.
  Qed. *)

End i2th2IndexBound. *)

Ltac subst_strings :=
  repeat match goal with
           | [ H : string |- _ ] => subst H
           | [ H : BoundedIndex _ |- _ ] => subst H
         end.

Ltac pose_string_ids :=
  subst_strings;
  repeat match goal with
           | |- context [String ?R ?R'] =>
             let str := fresh "StringId" in
             set (String R R') as str in *
           (*| |- context [ ``(?R) ] =>
             let idx := fresh in
             set ``(R) as fresh in * *)
         end.

Arguments BoundedString [_] _.