I have spent a lot of time on the notion of well founded induction and thought it was time to apply it to a simple case. So I wanted to use it do define the factorial function and came up with:
Definition fac : nat -> nat := Fix LtWellFounded (fun _ => nat) (* 'LtWellFounded' is some proof *)
(fun (n:nat) =>
match n as n' return (forall (m:nat), m < n' -> nat) -> nat with
| 0 => fun _ => 1
| S m => fun (g : forall (k:nat), k < S m -> nat) => S m * g m (le_n (S m))
end).
but then of course immediately arises the question of correctness. And when attempting to
prove that my function coincided everywhere with a usual implementation of fac, I realized things were far from trivial. In fact simply showing that fac 0 = 1:
Lemma fac0 : fac 0 = 1.
Proof.
unfold fac, Fix, Fix_F.
Show.
appears to be difficult. I am left with a goal:
1 subgoal
============================
(fix Fix_F (x : nat) (a : Acc lt x) {struct a} : nat :=
match x as n' return ((forall m : nat, m < n' -> nat) -> nat) with
| 0 => fun _ : forall m : nat, m < 0 -> nat => 1
| S m =>
fun g : forall k : nat, k < S m -> nat => S m * g m (le_n (S m))
end (fun (y : nat) (h : y < x) => Fix_F y (Acc_inv a h))) 0
(LtWellFounded' 0) = 1
and I cannot see how to reduce it further. Can anyone suggest a way foward ?
An application of a fixpoint only reduces when the argument it's recursing on has a constructor at its head. destruct (LtWellFounded' 0) to reveal the constructor, and then this will reduce to 1 = 1. Or, better, make sure LtWellFounded' is transparent (its proof should end with Defined., not Qed.), and then this entire proof is just reflexivity..
Some of the types that you give can actually be inferred by Coq, so you can also write
your fib in a slightly more readable form. Use dec to not forget which if branch your are in, and make the recursive function take a recursor fac as argument. It can be called with smaller arguments. By using refine, you can put in holes (a bit like in Agda), and get a proof obligation later.
Require Import Wf_nat PeanoNat Psatz. (* for lt_wf, =? and lia *)
Definition dec b: {b=true}+{b=false}.
now destruct b; auto.
Defined.
Definition fac : nat -> nat.
refine (Fix lt_wf _
(fun n fac =>
if dec (n =? 0)
then 1
else n * (fac (n - 1) _))).
clear fac. (* otherwise proving fac_S becomes impossible *)
destruct n; [ inversion e | lia].
Defined.
Lemma fac_S n: fac (S n) = (S n) * fac n.
unfold fac at 1; rewrite Fix_eq; fold fac.
now replace (S n - 1) with n by lia.
now intros x f g H; case dec; intros; rewrite ?H.
Defined.
Compute fac 8.
gives
Compute fac 8.
= 40320
: nat
Related
Task: write a function to convert natural numbers to binary numbers.
Inductive bin : Type :=
| Z
| A (n : bin)
| B (n : bin).
(* Division by 2. Returns (quotient, remainder) *)
Fixpoint div2_aux (n accum : nat) : (nat * nat) :=
match n with
| O => (accum, O)
| S O => (accum, S O)
| S (S n') => div2_aux n' (S accum)
end.
Fixpoint nat_to_bin (n: nat) : bin :=
let (q, r) := (div2_aux n 0) in
match q, r with
| O, O => Z
| O, 1 => B Z
| _, O => A (nat_to_bin q)
| _, _ => B (nat_to_bin q)
end.
The 2-nd function gives an error, because it is not structurally recursive:
Recursive call to nat_to_bin has principal argument equal to
"q" instead of a subterm of "n".
What should I do to prove that it always terminates because q is always less then n.
Prove that q is (almost always) less than n:
(* This condition is sufficient, but a "better" one is n <> 0
That makes the actual function slightly more complicated, though *)
Theorem div2_aux_lt {n} (prf : fst (div2_aux n 0) <> 0) : fst (div2_aux n 0) < n.
(* The proof is somewhat involved...
I did it by proving
forall n k, n <> 0 ->
fst (div2_aux n k) < n + k /\ fst (div2_aux (S n) k) < S n + k
by induction on n first *)
Then proceed by well-founded induction on lt:
Require Import Arith.Wf_nat.
Definition nat_to_bin (n : nat) : bin :=
lt_wf_rec (* Recurse down a chain of lts instead of structurally *)
n (fun _ => bin) (* Starting from n and building a bin *)
(fun n rec => (* At each step, we have (n : nat) and (rec : forall m, m < n -> bin) *)
match div2_aux n 0 as qr return (fst qr <> 0 -> fst qr < n) -> _ with (* Take div2_aux_lt as an argument; within the match the (div2_aux_lt n 0) in its type is rewritten in terms of the matched variables *)
| (O, r) => fun _ => if r then Z else B Z (* Commoning up cases for brevity *)
| (S _ as q, r) => (* note: O is "true" and S _ is "false" *)
fun prf => (if r then A else B) (rec q (prf ltac:(discriminate)))
end div2_aux_lt).
I might suggest making div2_aux return nat * bool.
Alternatively, Program Fixpoint supports these kinds of induction, too:
Require Import Program.
(* I don't like the automatic introing in program_simpl and
now/easy can solve some of our obligations. *)
#[local] Obligation Tactic := (now program_simpl) + cbv zeta.
(* {measure n} is short for {measure n lt}, which can replace the
core language {struct arg} when in a Program Fixpoint
(n can be any expression and lt can be any well-founded relation
on the type of that expression) *)
#[program] Fixpoint nat_to_bin (n : nat) {measure n} : bin :=
match div2_aux n 0 with
| (O, O) => Z
| (O, _) => B Z
| (q, O) => A (nat_to_bin q)
| (q, _) => B (nat_to_bin q)
end.
Next Obligation.
intros n _ q [_ mem] prf%(f_equal fst).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
Next Obligation.
intros n _ q r [mem _] prf%(f_equal fst).
specialize (mem r).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
I'm trying to reason on a TRS, and I have ran into the following proof obligation:
infinite_sequence : forall t' : Term,
transitive_closure R t t' ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
With transitive_closure defined as follows:
Definition transitive_closure (trs : TRS) (x y : Term) :=
exists f: nat -> Term,
f 0 = x
/\
exists l: nat,
f l = y
/\
forall n: nat,
n < l
->
trs (f n) (f (n + 1))
.
So when I unfold:
infinite_sequence : forall t' : Term,
(exists f : nat -> Term,
f 0 = t /\
(exists l : nat,
f l = t' /\
(forall n : nat, n < l -> R (f n) (f (n + 1))))) ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
Is this proof obligation possible to fulfill? I am not married this exact definition of transitive_closure, so if it becomes much easier by choosing a different definition for that, I'm open to that.
Since your goal starts with exists f : nat -> Term, you have to explicitly build such a function. The easiest way to do so is to first build a function with a slightly richer return type ({ u: Term | transitive_closure R t u } instead of Term) and then to project pointwise its first component to finish the proof. This would give the following script:
simple refine (let f : nat -> { u: Term | transitive_closure R t u } := _ in _).
- fix f 1.
intros [|n].
{ exists t. exists (fun _ => t). admit. }
destruct (f n) as [t' H].
destruct (infinite_sequence t' H) as [t'' H']. (* ISSUE *)
exists t''.
destruct H as [f' [H1 [l [H2 H3]]]].
exists (fun m => if Nat.ltb m l then f' m else t'').
admit.
- exists (fun n => proj1_sig (f n)).
intros n.
rewrite Nat.add_1_r.
simpl.
destruct (f n) as [fn Hn].
now destruct infinite_sequence as [t'' H'].
The two admit are just there to keep the code simple; there is nothing difficult about them. The real issue comes from the line destruct (infinite_sequence t' H), since Coq will complain that "Case analysis on sort Set is not allowed for inductive definition ex." Indeed, infinite_sequence states that there exists t'' such that R t' t'', but it does so in a non-informative way (i.e., in Prop), while you need it to build a function that lives in the concrete world (i.e., in Set).
There are only two axiom-free solutions, but both might be incompatible with the remaining of your development. The easiest one is to put infinite_sequence in Set, which means its type is changed to forall t', transitive_closure R t t' -> { t'' | R t' t'' }.
The second solution requires R to be a decidable relation and Term to be an enumerable set. That way, you can still build a concrete t'' by enumerating all the terms until you find one that satisfies R t' t''. In that case, infinite_sequence is only used to prove that this process terminates, so it can be non-informative.
I have been frequently running into an error in Coq when attempting to destruct a term of a dependent type. I am aware that there are two questions on Stack Overflow related to this issue, but neither of them are general enough for me to grasp in the context of my own proofs.
Here is a simple example of where the error occurs.
We define a type family t:
Inductive t: nat -> Set :=
| t_S: forall (n: nat), t (S n).
We will now try to prove that every member t (S n) of this type family is inhabited by a single term, namely t_S n.
Goal forall (n: nat) (p: t (S n)), p = t_S n.
We start with:
intros n p.
The next step to me would be to destruct p:
destruct p.
…but this runs into the following error:
Abstracting over the terms "n0" and "p" leads to a term fun (n1 : nat) (p0 : t n1) => p0 = t_S n
which is ill-typed.
Reason is: Illegal application:
The term "#eq" of type "forall A : Type, A -> A -> Prop"
cannot be applied to the terms
"t n1" : "Set"
"p0" : "t n1"
"t_S n" : "t (S n)"
The 3rd term has type "t (S n)" which should be coercible to "t n1".
It seems to me that it is trying to convert p into t_S n1, but somehow fails to reconcile the fact that n1 must be equal to n, thus causing opposite sides of = to have mismatching types.
Why does this occur and how does one get around this?
A simple proof of that fact is
Goal forall (n: nat) (p: t (S n)), p = t_S n.
Proof.
intros n p.
refine (
match p with
| t_S n => _
end
).
reflexivity.
Qed.
To understand how this works, it'll help to see the proof term that Coq constructs here.
Goal forall (n: nat) (p: t (S n)), p = t_S n.
Proof.
intros n p.
refine (
match p with
| t_S n => _
end
).
reflexivity.
Show Proof.
(fun (n : nat) (p : t (S n)) =>
match
p as p0 in (t n0)
return
(match n0 as x return (t x -> Type) with
| 0 => fun _ : t 0 => IDProp
| S n1 => fun p1 : t (S n1) => p1 = t_S n1
end p0)
with
| t_S n0 => eq_refl
end)
So the proof term isn't a simple match on p. Instead, Coq cleverly generalizes the S n in p: t (S n) while changing the type of the goal to that it still matches in the S n case.
Specifically, the proof term above uses the type
match (S n) as n' return (t n' -> Type) with
| 0 => fun p => IDProp (* Basically the same as `unit`; a singleton type *)
| S n' => fun p => p = t_S n'
end p
So obviously this is the same as p = t_S n, but it allows S n to be generalized. Every instance of n is now of the form S n, so it can be universally replaced with some n'. Here's how it would be written in individual tactics.
Goal forall (n: nat) (p: t (S n)), p = t_S n.
Proof.
intro n.
change (
forall p: t (S n),
match (S n) as n' return (t n' -> Type) with
| 0 => fun p => Empty_set (* This can actually be any type. We may as well use the simplest possible type. *)
| S n' => fun p => p = t_S n'
end p
).
generalize (S n); clear n.
intros n p.
(* p: t n, not t (S n), so we can destruct it *)
destruct p.
reflexivity.
Qed.
So why is all this necessary? Induction (and as a special case, case matching) requires that any indices in the inductive type be general. This can be seen by looking at the induction principle for t: t_rect: forall (P: forall n: nat, t n -> Type), (forall n: nat, P (S n) (t_S n)) -> forall (n: nat) (x: t n), P n x.
When using induction, we need P to be defined for all natural numbers. Even though the other hypothesis for the induction, forall n: nat, P (S n) (t_S n), only uses P (S n), it still needs to have a value at zero. For the goal you had, P (S n) p := (p = t_S n), but P wasn't defined for 0. What the clever trick of changing the goal does is extend P to 0 in a way that agrees with the definition at S n.
I have a list with a known value and want to induct on it, keeping track of what the original list was, and referring to it by element. That is, I need to refer to it by l[i] with varying i instead of just having (a :: l).
I tried to make an induction principle to allow me to do that. Here is a program with all of the unnecessary Theorems replaced with Admitted, using a simplified example. The objective is to prove allLE_countDown using countDown_nth, and have list_nth_rect in a convenient form. (The theorem is easy to prove directly without any of those.)
Require Import Arith.
Require Import List.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Admitted.
Definition allLE := fix f l m := match l with
| nil => true
| a :: l0 => if Nat.leb a m then f l0 m else false
end.
Definition drop {A} := fix f (l : list A) n := match n with
| 0 => l
| S a => match l with
| nil => nil
| _ :: l2 => f l2 a
end
end.
Theorem list_nth_rect_aux {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s i (size : length l = i + length s) (sub : s = drop l i) : P l s i.
Admitted.
Theorem list_nth_rect {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s (leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as l.
refine (list_nth_rect (fun l s _ => l = countDown a b -> allLE s a = true) _ _ l l eq_refl Heql);
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H0.
apply leb_correct in H0.
simpl; rewrite H0; clear H0.
apply (H eq_refl).
Qed.
So, I have list_nth_rect and was able to use it with refine to prove the theorem by referring to the nth element, as desired. However, I had to construct the Proposition P myself. Normally, you'd like to use induction.
This requires distinguishing which elements are the original list l vs. the sublist s that is inducted on. So, I can use remember.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
This puts me at
a, b : nat
s, l : list nat
Heql : l = s
Heqs : l = countDown a b
============================
allLE s a = true
However, I can't seem to pass the equality as I just did above. When I try
induction l, s, Heql using list_nth_rect.
I get the error
Error: Abstracting over the terms "l", "s" and "0" leads to a term
fun (l0 : list ?X133#{__:=a; __:=b; __:=s; __:=l; __:=Heql; __:=Heqs})
(s0 : list ?X133#{__:=a; __:=b; __:=s; __:=l0; __:=Heql; __:=Heqs})
(_ : nat) =>
(fun (l1 l2 : list nat) (_ : l1 = l2) =>
l1 = countDown a b -> allLE l2 a = true) l0 s0 Heql
which is ill-typed.
Reason is: Illegal application:
The term
"fun (l l0 : list nat) (_ : l = l0) =>
l = countDown a b -> allLE l0 a = true" of type
"forall l l0 : list nat, l = l0 -> Prop"
cannot be applied to the terms
"l0" : "list nat"
"s0" : "list nat"
"Heql" : "l = s"
The 3rd term has type "l = s" which should be coercible to
"l0 = s0".
So, how can I change the induction principle
such that it works with the induction tactic?
It looks like it's getting confused between
the outer variables and the ones inside the
function. But, I don't have a way to talk
about the inner variables that aren't in scope.
It's very strange, since invoking it with
refine works without issues.
I know for match, there's as clauses, but
I can't figure out how to apply that here.
Or, is there a way to make list_nth_rect use
P l l 0 and still indicate which variables correspond to l and s?
First, you can prove this result much more easily by reusing more basic ones. Here's a version based on definitions of the ssreflect library:
From mathcomp
Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Definition countDown n m := rev (iota m (n - m)).
Lemma allLE_countDown n m : all (fun k => k <= n) (countDown n m).
Proof.
rewrite /countDown all_rev; apply/allP=> k; rewrite mem_iota.
have [mn|/ltnW] := leqP m n.
by rewrite subnKC //; case/andP => _; apply/leqW.
by rewrite -subn_eq0 => /eqP ->; rewrite addn0 ltnNge andbN.
Qed.
Here, iota n m is the list of m elements that counts starting from n, and all is a generic version of your allLE. Similar functions and results exist in the standard library.
Back to your original question, it is true that sometimes we need to induct on a list while remembering the entire list we started with. I don't know if there is a way to get what you want with the standard induction tactic; I didn't even know that it had a multi-argument variant. When I want to prove P l using this strategy, I usually proceed as follows:
Find a predicate Q : nat -> Prop such that Q (length l) implies P l. Typically, Q n will have the form n <= length l -> R (take n l) (drop n l), where R : list A -> list A -> Prop.
Prove Q n for all n by induction.
I do not know if this answers your question, but induction seems to accept with clauses. Thus, you can write the following.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction l, s, Heql using list_nth_rect
with (P:=fun l s _ => l = countDown a b -> allLE s a = true).
But the benefit is quite limited w.r.t. the refine version, since you need to specify manually the predicate.
Now, here is how I would have proved such a result using objects from the standard library.
Require Import List. Import ListNotations.
Require Import Omega.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown1_nth a i k d (boundi : k < i) :
nth k (countDown1 a i) d = a + i -k - 1.
Proof.
revert k boundi.
induction i; intros.
- inversion boundi.
- simpl. destruct k.
+ omega.
+ rewrite IHi; omega.
Qed.
Lemma countDown1_length a i : length (countDown1 a i) = i.
Proof.
induction i.
- reflexivity.
- simpl. rewrite IHi. reflexivity.
Qed.
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Proof.
unfold countDown in *.
rewrite countDown1_length in boundi.
rewrite countDown1_nth.
replace (b+(a-b)) with a by omega. reflexivity. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_forall. intros.
apply In_nth with (d:=0) in H.
destruct H as (n & H & H0).
rewrite countDown_nth in H0 by assumption. omega.
Qed.
EDIT:
You can state an helper lemma to make an even more concise proof.
Lemma Forall_nth : forall {A} (P:A->Prop) l,
(forall d i, i < length l -> P (nth i l d)) ->
Forall P l.
Proof.
intros. apply Forall_forall.
intros. apply In_nth with (d:=x) in H0.
destruct H0 as (n & H0 & H1).
rewrite <- H1. apply H. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_nth.
intros. rewrite countDown_nth. omega. assumption.
Qed.
The issue is that, for better or for worse, induction seems to assume that its arguments are independent. The solution, then, is to let induction automatically infer l and s from Heql:
Theorem list_nth_rect {A : Type} {l s : list A} (P : list A -> list A -> nat -> Type)
(Pnil : P l nil (length l))
(Pcons : forall i s d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
(leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction Heql using list_nth_rect;
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H.
apply leb_correct in H.
simpl; rewrite H; clear H.
assumption.
Qed.
I had to change around the type of list_nth_rect a bit; I hope I haven't made it false.
I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.