Require Export nlist_syn.
Require Export SO_semantics.

Lemma alt_Ip_list_cons : forall (D:Set) (Ip: predicate -> D -> Prop) (l_pa : list (D -> Prop))
                      (l_pred : list (predicate)) (P : predicate) (pa : D -> Prop),
            alt_Ip_list Ip (cons pa l_pa) (cons P l_pred)
               = alt_Ip (alt_Ip_list Ip l_pa l_pred) pa P.
Proof. firstorder. Qed.

Lemma alt_Ip_list_nil : forall (D:Set) (Ip: predicate -> D -> Prop) (l_pa : list (D -> Prop)) ,
  alt_Ip_list Ip l_pa nil = Ip.
Proof. intros. destruct l_pa; firstorder. Qed.

Lemma alt_Ip_list_tail : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l : nlist_pa W (length l))
                            (pa: W -> Prop),
         alt_Ip_list (alt_Ip Ip pa P) (nlist_list_pa W (length l) pa_l) l
            = alt_Ip_list Ip (app (nlist_list_pa W (length l) pa_l) (cons pa nil) ) (app l (cons P nil)).
Proof.
  intros.
  induction l.
    simpl.
    simpl length in pa_l.
    assert (pa_l = niln_pa W).
      apply nlist_nil.
    rewrite H.
    simpl.
    reflexivity.

    assert (exists (pa1 : W -> Prop) (pa_l1 : nlist_pa W (length l)),
              (pa_l = consn_pa W (length l) pa1 pa_l1)).
      apply nlist_cons.
    destruct H as [pa1 [pa_l1 H]].
    rewrite H.
    simpl.
    rewrite IHl.
    reflexivity.
Qed.

Lemma alt_Ip_list_app : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l : nlist_pa W (length l))
                            (pa : W -> Prop),
       (alt_Ip_list Ip (app (nlist_list_pa W (length l) pa_l) (cons pa nil)) (l ++ P :: nil))
     = (alt_Ip_list (alt_Ip_list Ip (nlist_list_pa W 1 (consn_pa W 0 pa (niln_pa W)))
          (P :: nil)) (nlist_list_pa W (length l) pa_l) l).
Proof.
  intros.
  induction l.
    simpl in pa_l.
    assert (pa_l = (niln_pa W)).
      apply nlist_nil.
    rewrite H.
    simpl.
    reflexivity.

    simpl.
    assert (exists (pa1 : W -> Prop) (pa_l1 : nlist_pa W (length l)),
              (pa_l = consn_pa W (length l) pa1 pa_l1)).
       apply nlist_cons.
    destruct H as [pa1 [pa_l1 H]].
    rewrite H.
    specialize (IHl pa_l1).
    simpl.
    rewrite IHl.
    simpl.
    reflexivity.
Qed.

(* ----------------------------------------------------------------------------- *)

Lemma alt_alt_list_1 : forall (W : Set) (l : list predicate) (pa_l_hat : nlist_pa W (length l))
                            (pa_hat : W -> Prop) (P : predicate) (Ip : predicate -> W -> Prop) ,
      exists (pa : W -> Prop) (pa_l : nlist_pa W (length l)),
          (alt_Ip (alt_Ip_list Ip (nlist_list_pa W (length l) pa_l_hat) l) pa_hat P)
        = (alt_Ip_list (alt_Ip Ip pa P) (nlist_list_pa W (length l) pa_l) l).
Proof.
  intros W l.
  induction l.
    intros.
    simpl.
    simpl in pa_l_hat.
    assert (pa_l_hat = niln_pa W).
      apply nlist_nil.
    rewrite H.
    simpl.
    exists pa_hat.
    exists (niln_pa W).
    simpl.
    reflexivity.

    intros.
    simpl in pa_l_hat.
    assert (exists (pa : W -> Prop) (pa_l' : nlist_pa W (length l)),
              (pa_l_hat = consn_pa W (length l) pa pa_l')).
       apply nlist_cons.
    destruct H as [pa1 [pa_l1 H]].
    destruct a as [Qm]; destruct P as [Pn].
    case_eq (EqNat.beq_nat Qm Pn).
      intros.
      pose proof ((EqNat.beq_nat_true Qm Pn) H0).
      rewrite <- H1.
      rewrite H.
      simpl nlist_list_pa.
      rewrite alt_Ip_list_cons.
      rewrite alt_Ip_rem.
      specialize (IHl pa_l1 pa_hat (Pred Qm) Ip).
      destruct IHl as [pa2 [pa_l2 IHl']].

      exists pa2.
      exists (consn_pa W (length l) pa_hat pa_l2).
      simpl nlist_list_pa.
      rewrite alt_Ip_list_cons.
      rewrite <- IHl'.
      rewrite alt_Ip_rem.
      reflexivity.

      intros.
      pose proof ((EqNat.beq_nat_false Qm Pn) H0).
      rewrite H.
      simpl nlist_list_pa.
      rewrite alt_Ip_list_cons.
      rewrite <- alt_Ip_switch.
      specialize (IHl pa_l1 pa_hat (Pred Pn) Ip).
      destruct IHl as [pa2 [pa_l2 IHl']].
      rewrite IHl'.
      assert (S (length l) = length (cons (Pred Pn) l)).
        simpl; reflexivity.
      rewrite <- alt_Ip_list_cons.
      exists pa2.
      exists (consn_pa W (length l) pa1 pa_l2).
      reflexivity.

      intros HH. inversion HH. subst. firstorder.
Qed.

Lemma alt_alt_list_2 : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l_hat : nlist_pa W (length l))
                            (pa_hat : W -> Prop),
   exists (pa : W -> Prop) (pa_l : nlist_pa W (length l)),
     (alt_Ip (alt_Ip_list Ip (nlist_list_pa W (length l) pa_l) l) pa P) =
        (alt_Ip_list (alt_Ip Ip pa_hat P) (nlist_list_pa W (length l) pa_l_hat) l).
Proof.
  intros.
  rewrite alt_Ip_list_tail.
  induction l.
    simpl length in *.
    assert (pa_l_hat = niln_pa W).
      apply nlist_nil.
    rewrite H.
    simpl.
    exists pa_hat.
    exists (niln_pa W).
    simpl.
    reflexivity.

    assert (exists (pa1 : W -> Prop) (pa_l1 : nlist_pa W (length l)),
              (pa_l_hat = consn_pa W (length l) pa1 pa_l1)).
      apply nlist_cons.
    destruct H as [pa1 [pa_l1 H']].
    rewrite H'.
    simpl.
    destruct a as [Qm].
    destruct P as [Pn].
    rewrite alt_Ip_list_app.
    specialize (IHl pa_l1).
    destruct IHl as [pa2 [pa_l2 IHl']].
    case_eq (EqNat.beq_nat Qm Pn).
      intros.
      pose proof ((EqNat.beq_nat_true Qm Pn) H).
      rewrite <- H0.
      assert (nlist_list_pa W (length (cons (Pred Pn) nil))
                    (consn_pa W (length (nil: list predicate)) pa_hat (niln_pa W))
               = cons pa_hat (nlist_list_pa W (length (nil:list predicate)) (niln_pa W)))
              as list_cons.
        apply nlist_list_cons.
      simpl length in list_cons.
      rewrite list_cons.
      rewrite alt_Ip_list_cons.
      rewrite alt_Ip_list_app in IHl'.
      rewrite list_cons in IHl'.
      rewrite alt_Ip_list_cons in IHl'.
      rewrite alt_Ip_list_nil.
      rewrite alt_Ip_list_nil in IHl'.
      rewrite H0.
      rewrite <- IHl'.
      exists pa1.
      exists (consn_pa W (length l) pa2 pa_l2).
      assert ((nlist_list_pa W (length (cons (Pred Pn) l)) (consn_pa W (length l) pa2 pa_l2))
                 =  cons pa2 (nlist_list_pa W (length l) pa_l2) ) as list_cons2.
        apply nlist_list_cons.
      simpl length in list_cons2.
      rewrite list_cons2.
      rewrite alt_Ip_list_cons.
      reflexivity.

      intros.
      exists pa2.
      exists (consn_pa W (length l) pa1 pa_l2).
      assert ((nlist_list_pa W (length (cons (Pred Pn) l)) (consn_pa W (length l) pa1 pa_l2))
               = cons pa1 (nlist_list_pa W (length l) pa_l2)) as list_cons.
        apply nlist_list_cons.
      simpl length in list_cons.
      rewrite list_cons.
      rewrite alt_Ip_list_app in IHl'.
      simpl nlist_list_pa in IHl'.
      rewrite alt_Ip_list_cons in IHl'.
      simpl alt_Ip_list in IHl' at 3.
      rewrite alt_Ip_list_cons.
      assert ((nlist_list_pa W (length (cons (Pred Pn) nil))
              (consn_pa W (length (nil: list predicate)) pa_hat (niln_pa W)))
                 = cons pa_hat (nlist_list_pa W (length (nil:list predicate)) (niln_pa W)))
              as list_cons2.
        apply nlist_list_cons.
      simpl length in list_cons2.
      rewrite list_cons2.
      rewrite alt_Ip_list_cons.
      unfold nlist_list_pa at 2.
      unfold alt_Ip_list at 3.
      rewrite <- IHl'.
      apply alt_Ip_switch.
      pose proof ((EqNat.beq_nat_false Qm Pn) H).
      unfold not; intros.
      symmetry in H1.
      inversion H1. subst. firstorder.
Qed.

Lemma alt_Ip_list_tail' : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l : nlist (length l))
                            (pa: W -> Prop),
         alt_Ip_list (alt_Ip Ip pa P) (nlist_list (length l) pa_l) l
            = alt_Ip_list Ip (app (nlist_list (length l) pa_l) (cons pa nil) ) (app l (cons P nil)).
Proof.
  induction l; intros pa_l pa; simpl.
  + assert (pa_l = niln).  apply nlist_nil2. subst. auto.
  + assert (exists (pa1 : W -> Prop) (pa_l1 : nlist (length l)),
              (pa_l = consn (length l) pa1 pa_l1)).
    apply nlist_cons2.
    destruct H as [pa1 [pa_l1 H]]. subst.
    simpl. rewrite IHl. auto.
Qed.

Lemma alt_Ip_list_app' : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l : nlist (length l))
                            (pa : W -> Prop),
       (alt_Ip_list Ip (app (nlist_list (length l) pa_l) (cons pa nil)) (l ++ P :: nil))
     = (alt_Ip_list (alt_Ip_list Ip (nlist_list 1 (consn 0 pa (niln)))
          (P :: nil)) (nlist_list (length l) pa_l) l).
Proof.
  induction l; intros pa_l pa. simpl.
  + assert (pa_l = (niln)).  apply nlist_nil2. subst. auto.
  + simpl. assert (exists (pa1 : W -> Prop) (pa_l1 : nlist (length l)),
              (pa_l = consn (length l) pa1 pa_l1)).
       apply nlist_cons2.
    destruct H as [pa1 [pa_l1 H]].
    rewrite H. simpl. rewrite IHl. auto.
Qed.

Lemma nlist_list_cons' : forall (W : Set) (pa : W -> Prop) (l : list predicate)
                               (t : nlist (length l)),
      (nlist_list (S (length l) ) (consn (length l) pa t))
         = cons pa (nlist_list (length l) t).
Proof. auto. Qed.

Lemma alt_alt_list_1' : forall (W : Set) (l : list predicate) (pa_l_hat : nlist (length l))
                            (pa_hat : W -> Prop) (P : predicate) (Ip : predicate -> W -> Prop) ,
      exists (pa : W -> Prop) (pa_l : nlist (length l)),
          (alt_Ip (alt_Ip_list Ip (nlist_list (length l) pa_l_hat) l) pa_hat P)
        = (alt_Ip_list (@alt_Ip W Ip pa P) (nlist_list (length l) pa_l) l).
Proof.
  induction l; intros; simpl in *.
  + assert (pa_l_hat = niln) as H.
      apply nlist_nil2.
    rewrite H. simpl. exists pa_hat, niln. auto.
  + assert (exists (pa : W -> Prop) (pa_l' : nlist (length l)),
              (pa_l_hat = consn (length l) pa pa_l')).
       apply nlist_cons2.
    destruct H as [pa1 [pa_l1 H]].
    destruct (predicate_dec a P); subst.
    ++ simpl. rewrite alt_Ip_rem.
       specialize (IHl pa_l1 pa_hat P Ip).
       destruct IHl as [pa2 [pa_l2 IHl']].
       exists pa2, (consn (length l) pa_hat pa_l2).
       simpl. rewrite <- IHl'. rewrite alt_Ip_rem. auto.
    ++ intros. simpl. rewrite <- alt_Ip_switch.
       specialize (IHl pa_l1 pa_hat P Ip).
       destruct IHl as [pa2 [pa_l2 IHl']].
       rewrite IHl'.
       assert (S (length l) = length (cons P l)) by auto.
       exists pa2, (consn (length l) pa1 pa_l2). all: auto.
Qed.

Lemma alt_alt_list_2' : forall (W : Set) (Ip : predicate -> W -> Prop) (P : predicate)
                            (l : list predicate) (pa_l_hat : nlist (length l))
                            (pa_hat : W -> Prop),
   exists (pa : W -> Prop) (pa_l : nlist (length l)),
     (alt_Ip (alt_Ip_list Ip (nlist_list (length l) pa_l) l) pa P) =
        (alt_Ip_list (alt_Ip Ip pa_hat P) (nlist_list (length l) pa_l_hat) l).
Proof.
  intros. rewrite alt_Ip_list_tail'.
  induction l; simpl in *.
  + exists pa_hat, niln. simpl.
    assert (pa_l_hat = niln). apply nlist_nil2.
    subst. auto.
  + assert (exists (pa1 : W -> Prop) (pa_l1 : nlist (length l)),
              (pa_l_hat = consn (length l) pa1 pa_l1)) as H.
      apply nlist_cons2.
    destruct H as [pa1 [pa_l1 H']]. subst.
    simpl. rewrite alt_Ip_list_app'.
    destruct (IHl pa_l1) as [pa2 [pa_l2 IHl']].
    destruct (predicate_dec a P); subst.
    ++ simpl. exists pa1, (consn (length l) pa2 pa_l2).
       simpl. rewrite IHl'. rewrite alt_Ip_list_tail'. auto.
    ++ exists pa2, (consn (length l) pa1 pa_l2).
       simpl. rewrite alt_Ip_switch. rewrite IHl'.
       rewrite alt_Ip_list_tail'. auto. auto.
Qed.

(* Checks whether Ip and Ip' agree on given predicate values in list l. *)
Inductive same_Ip_list {W : Set} (Ip Ip' : predicate -> W -> Prop) : list predicate -> Prop :=
| same_Ip_list_nil : same_Ip_list Ip Ip' nil
| same_Ip_list_cons l' P : Ip P = Ip' P -> same_Ip_list Ip Ip' l' ->
                           same_Ip_list Ip Ip' (P :: l').

Lemma same_cons : forall (W : Set) (Ip Ip' : predicate -> W -> Prop) (l : list predicate)
                          (P : predicate),
     ( same_Ip_list Ip Ip' (cons P l)) <-> (Ip P = Ip' P /\ (same_Ip_list Ip Ip' l)).
Proof.
  intros. split; intros HH. inversion HH. subst. firstorder.
  constructor; firstorder.
Qed.

Lemma same_comm : forall  (W : Set) (Ip Ip' : predicate -> W -> Prop) (l : list predicate),
    same_Ip_list Ip Ip' l <-> same_Ip_list Ip' Ip l.
Proof.
  induction l. split; intros; constructor.
  split; intros H; inversion H; subst;
    constructor; firstorder.
Qed.

Lemma same_app2 : forall (W : Set) (Ip Ip' : predicate -> W -> Prop)
                         (l1 l2 : list predicate),
        same_Ip_list Ip Ip' (app l1 l2) <->
          (same_Ip_list Ip Ip' l1 /\ same_Ip_list Ip Ip' l2).
Proof.
  induction l1; intros l2; simpl.
  split; intros HH. split. constructor. 1-2:firstorder.
  split; intros HH. inversion HH; subst.
  split. constructor; firstorder.  apply IHl1 in H2; firstorder.
  destruct HH as [H1 H2]. inversion H1. subst.
  constructor; firstorder.
Qed.

(* Removes nth predicate from list l if it is in it. *)
Fixpoint list_pred_rem (l : list predicate) (P : predicate) : list predicate :=
  match l with
  | nil => nil
  | cons Q l' => if predicate_dec P Q then list_pred_rem l' P
                                       else cons Q (list_pred_rem l' P)
  end.

(* List l1 without the elements of list l2. *)
Fixpoint list_pred_without (l1 l2 : list predicate) : list predicate :=
  match l2 with
  | nil => l1
  | cons P l2' => list_pred_without (list_pred_rem l1 P) l2'
  end.

Lemma list_pred_rem_switch : forall (l : list predicate) (P Q : predicate),
       (list_pred_rem (list_pred_rem l P) Q)
     = (list_pred_rem (list_pred_rem l Q) P).
Proof.
  induction l; intros P Q. auto.
  simpl. destruct (predicate_dec P a) as [H1 | H1];
  destruct (predicate_dec Q a) as [H2 | H2].
  apply IHl. simpl. subst. rewrite predicate_dec_refl.
  apply IHl. simpl. subst. rewrite predicate_dec_refl.
  apply IHl. simpl. rewrite predicate_dec_r.
  rewrite predicate_dec_r. rewrite IHl. all : auto.
Qed.

Lemma list_pred_without_rem : forall (l2 l1 : list predicate) P,
         (list_pred_without (list_pred_rem l1 P) l2)
       = (list_pred_rem (list_pred_without l1 l2) P).
Proof.
  induction l2. auto.
  intros. simpl.
  rewrite list_pred_rem_switch.  auto.
Qed.

Lemma list_pred_without_id : forall (l : list predicate),
        list_pred_without l l = nil.
Proof.
  induction l. auto.
  simpl. rewrite predicate_dec_refl.
  rewrite list_pred_without_rem.
  rewrite IHl. auto.
Qed.

(* --------------------------------------------------------------------------*)

Lemma same_rem : forall (W:Set) (l : list predicate)
                        (Ip Ip': predicate -> W -> Prop) (n : predicate) ,
      same_Ip_list Ip Ip' l -> same_Ip_list Ip Ip' (list_pred_rem l n).
Proof.
  induction l; intros ? ? P H; auto.
  simpl in *. destruct (predicate_dec P a) as [H1 | H1].
  subst. apply IHl. inversion H; auto.
  inversion H. subst. constructor; auto.
Qed.

Lemma same_alt_rem : forall (W:Set) (l : list predicate)
                            (Ip Ip': predicate -> W -> Prop)
                            P (pred_asgmt : W -> Prop) ,
  same_Ip_list Ip Ip' (list_pred_rem l P) <->
    same_Ip_list (alt_Ip Ip pred_asgmt P)
                   (alt_Ip Ip' pred_asgmt P) l.
Proof.
  intros W l. induction l; intros Ip Ip' n pa.
  simpl. split; intros HH; constructor.
  rewrite same_cons. simpl.
  destruct (predicate_dec n a). subst.
  do 2 rewrite alt_Ip_eq.
  split; intros HH. apply conj. auto. apply IHl. auto.
  eapply IHl. apply HH.
  rewrite same_cons. do 2 (rewrite alt_Ip_neq; auto).
  split; intros [H1 H2]; apply conj; auto.
  apply IHl. auto. apply IHl in H2. auto.
Qed.

(* A specific choice of pa_l that doesn't alter Ip, as proved below in Lemmas ineffective_Ip
   and ineffective_Ip - used later in proof of correctness_ST *)
Fixpoint ineffective_pa_l (W : Set) (Ip : predicate -> W -> Prop) (n : nat)
                     (l : nlist n) : nlist_pa W n :=
  match l with
  | niln => niln_pa W
  | consn m P l' => consn_pa W m (Ip P) (ineffective_pa_l W Ip m l')
  end.

Lemma  ineffective_Ip2 : forall (W : Set) (l : list predicate) (Ip : predicate -> W -> Prop) ,
   alt_Ip_list Ip (nlist_list_pa W (length l)
       (ineffective_pa_l W Ip (length l) (list_nlist l))) l
   = Ip.
Proof.
  intros W l.
  induction l.
    intros.
    simpl.
    reflexivity.

    intros.
    simpl.
    rewrite (IHl Ip).
    rewrite unalt_fun.
    reflexivity.
Qed.


From Usuba Require Import usuba_AST collect.
From Coq Require Import String.
From Coq Require Import PeanoNat.
From Coq Require Import MSetFacts.
Require Import Lia.

Fixpoint fill (name : string) (size : nat) : string :=
    match size with
    | 0 => name ++ "'"
    | S size => fill (name ++ "'") size
    end.

Fixpoint fresh_name_inner (fuel : nat) (size : nat) (name : ident) (s : iset.t) : (ident * nat * iset.t) :=
    match fuel with
    | 0 =>
        let name2 := fill name (size - String.length name) in
        (name2, max (String.length name + 1) (size + 1), iset.add name2 s)
    | S fuel' => match iset.mem name s with
        | true => fresh_name_inner fuel' size (name ++ "'")%string s
        | false => (name, Nat.max (String.length name) size, iset.add name s)
        end
    end.

Definition var_set : Type := nat * iset.t.

Definition var_set_ok (vs : var_set) : Prop :=
    let (size, vars) := vs in
        forall name, iset.mem name vars = true -> String.length name <= size.

Definition fresh_name (name : ident) (vs : var_set) : (ident * var_set):=
    let (size, vars) := vs in
    let (name_size, vars') := fresh_name_inner 1000 size name vars in
    let (name', size') := name_size in
    (name', (size', vars')).

Lemma fill_soundness:
    forall s name,
        String.length (fill name s) = String.length name + s + 1.
Proof.
    induction s as [|s HRec]; simpl; intro.
    + rewrite String_append_length; simpl; lia.
    + rewrite HRec; rewrite String_append_length; simpl; lia.
Qed.

Theorem fresh_name_inner_soundness:
    forall fuel size s name s2 name2 size2,
        var_set_ok (size, s) ->
        fresh_name_inner fuel size name s = (name2, size2, s2) ->
            iset.mem name2 s = false /\ iset.mem name2 s2 = true /\
            var_set_ok (size2, s2).
Proof.
    unfold var_set_ok.
    induction fuel as [|fuel' HRec]; simpl.
    all: intros size s name s2 name2 size2 HLength.
    {
        intro HEq; inversion HEq.
        rewrite <- not_true_iff_false.
        repeat split.
        + intro Hmem; apply HLength in Hmem; rewrite fill_soundness in Hmem; lia.
        + rewrite iset.mem_spec; rewrite iset.add_spec; auto.
        + intros n H; rewrite iset.mem_spec in H; rewrite iset.add_spec in H; destruct H as [H|].
            - rewrite H; rewrite fill_soundness. lia.
            - rewrite <- iset.mem_spec in H; apply HLength in H; lia.
    }
    case_eq (iset.mem name s); simpl.
    all: intros Hmem HEq.
    {
        apply HRec in HEq; trivial.
    }
    {
        generalize Hmem; clear Hmem.
        inversion HEq; repeat split; auto.
        + rewrite iset.mem_spec; rewrite iset.add_spec; auto.
        + intro; rewrite iset.mem_spec; rewrite iset.add_spec.
            intro H; destruct H as [H|H].
            - destruct H; lia.
            - rewrite <-iset.mem_spec in H; apply HLength in H; lia.
    }
Qed.


(*|
###########################################################
Incorrect elimination of ``X`` in the inductive type ``or``
###########################################################

:Link: https://stackoverflow.com/q/32261254
|*)

(*|
Question
********

I am trying to define a relatively simple function on Coq:
|*)

(* Preliminaries *)
Require Import Vector.
Definition Vnth {A : Type} {n} (v : Vector.t A n) : forall i, i < n -> A.
Admitted.

(* Problematic definition below *)
Fail Definition VnthIndexMapped {A : Type}
           {i o : nat}
           (x : Vector.t (option A) i)
           (f' : nat -> option nat)
           (f'_spec : forall x,
               x < o -> (forall z, f' x = Some z -> z < i) \/ f' x = None)
           (n : nat)
           (np : n < o) : option A :=
  match f' n as fn, f'_spec n np return f' n = fn -> option A with
  | None, _ => fun _ => None
  | Some z, or_introl zc1 => fun p => Vnth x z (zc1 z p)
  | Some z, or_intror _ => fun _ => None (* impossible case *)
  end. (* .unfold *)

(*|
I think I understand the reason for this limitation, but I am having
difficulty coming up with a workaround. How something like this could
be implemented? Basically I have a function ``f'`` for which I have a
separate proof that values less than ``o`` it either returns ``None``
or a ``Some z`` where ``z`` is less than ``i`` and I am trying to use
it in my definition.
|*)

(*|
Answer (Vinz)
*************

The issue is that you want to build a term by inspecting the content
of ``f'_spec``. This disjunction lives in ``Prop``, so it can only
build other ``Prop``. You want to build more, something in ``Type``.
Therefore you need a version of disjunction that lives at least in
``Set`` (more generally in ``Type``). I advise you replace your ``Foo
\/ Bar`` statement with the usage of ``sumbool``, which uses the
notation ``{Foo} + {Bar}``.

----

**Q:** What would be the other implications of using ``sumbool``
instead of ``\/``? Any potential problems?

**A:** Basically if I give you ``P : A \/ B``, you can't tell if it
``A`` or ``B`` that its true. You just know one of them is. With ``{A}
+ {B}``, you also get to know which one is true (because you can
destruct the term).
|*)

(*|
Answer (Arthur Azevedo De Amorim)
*********************************

There are two approaches to a problem like this: the *easy way* and
the *hard way*.

The easy way is to think whether you're doing anything more
complicated than you have to. In this case, if you look carefully, you
will see that your ``f'_spec`` is equivalent to the following
statement, which avoids ``\/``:
|*)

Lemma f'_spec_equiv i o (f' : nat -> option nat) :
  (forall x, x < o -> (forall z, f' x = Some z -> z < i) \/ f' x = None)
  <-> (forall x, x < o -> forall z, f' x = Some z -> z < i).
Proof.
  split.
  - intros f'_spec x Hx z Hf.
    destruct (f'_spec _ Hx); eauto; congruence.
  - intros f'_spec x Hx.
    left. eauto.
Qed.

(*|
Thus, you could have rephrased the type of ``f'_spec`` in
``VnthIndexedMapped`` and used the proof directly.

Of course, sometimes there's no way of making things simpler. Then you
need to follow the hard way, and try to understand the nitty-gritty
details of Coq to make it accept what you want.

As Vinz pointed out, you *usually* (there are exceptions) can't
eliminate the proof of proposition to construct something
computational. However, you *can* eliminate a proof to construct
*another proof*, and maybe that proof gives you what need. For
instance, you can write this:
|*)

Definition VnthIndexMapped {A : Type}
           {i o : nat}
           (x : Vector.t (option A) i)
           (f' : nat -> option nat)
           (f'_spec : forall x,
               x < o -> (forall z, f' x = Some z -> z < i) \/ f' x = None)
           (n : nat)
           (np : n < o) : option A :=
  match f' n as fn return f' n = fn -> option A with
  | None => fun _ => None
  | Some z => fun p =>
                let p' := proj1 (f'_spec_equiv i o f') f'_spec n np z p in
                Vnth x z p'
  end eq_refl.

(*|
This definition uses the proof that both formulations of ``f'_spec``
are equivalent, but the same idea would apply if they weren't, and you
had some lemma allowing you to go from one to the other.

I personally don't like this style very much, as it is hard to use and
lends itself to programs that are complicated to read. But it can have
its uses...
|*)