Section BD_Whnf.
Fixpoint whnf_bd (e : env) (t : term) {struct t} : Prop :=
match t with
| Ref n =>
match delta_reduce n e with
| inleft _ => False
| _ => True
end
| App u v => whnf_bd e u /\ (forall T t : term, u <> Abs T t)
| _ => True
end.
Hint Unfold whnf_bd: pts.
simple induction 1; simpl in |- *; intros; auto with arith pts.
generalize H1.
elim H0; simpl in |- *; auto with arith pts.
simple destruct 1.
simple induction 1; simpl in |- *; intros.
inversion_clear H4.
elim H6 with T M; auto with arith pts.
simple induction 1; simpl in |- *.
do 5 intro.
elim (delta_reduce n e1); intros.
elim H5.
elim b with (lift (S n) d).
apply delta_intro with T; auto with arith pts.
intros.
inversion_clear H4.
split; auto with arith pts.
red in |- *; intros.
clear H3.
inversion_clear H4 in H2.
generalize H5 H6.
clear H5 H6.
inversion_clear H2; simpl in |- *.
inversion_clear H3.
inversion_clear H2; simpl in |- *; intros.
inversion_clear H5.
elim H3 with T0 M; auto with arith pts.
inversion_clear H2.
simpl in |- *.
elim (delta_reduce n e0); intros.
auto with arith pts.
elim b with (lift (S n) d).
apply delta_intro with T0; auto with arith pts.
intros.
elim H6 with M t0; auto with arith pts.
intros.
elim H6 with T M; auto with arith pts.
Qed.
red in |- *; intros.
generalize H.
elim H0.
simple induction 1.
simple destruct 1.
simple induction 1; simpl in |- *; intros.
inversion_clear H4.
elim H6 with T M; auto with arith pts.
simple destruct 1.
simpl in |- *.
do 5 intro.
elim (delta_reduce n e1); intros.
elim H5.
elim b with (lift (S n) d).
apply delta_intro with T; auto with arith pts.
red in |- *; red in |- *; intros.
inversion_clear H5.
inversion_clear H6.
inversion_clear H6.
red in |- *; red in |- *; intros.
inversion_clear H5; inversion_clear H6.
red in |- *; red in |- *; intros.
generalize H2.
inversion_clear H5; inversion_clear H6.
intros.
generalize H4.
inversion_clear H5; simpl in |- *; intros.
inversion_clear H5.
generalize H7.
inversion_clear H6.
inversion_clear H5.
simpl in |- *; intros.
inversion_clear H5.
elim H9 with T0 M0; auto with arith pts.
inversion_clear H5.
simpl in |- *.
elim (delta_reduce n e0); intros.
auto with arith pts.
elim b with (lift (S n) d).
apply delta_intro with T0; auto with arith pts.
inversion H5.
elim H8 with M0 M; auto with arith pts.
inversion H5.
elim H8 with T M0; auto with arith pts.
red in |- *; red in |- *; intros.
generalize H4.
inversion_clear H5; inversion_clear H6; simpl in |- *; intros.
inversion_clear H5.
elim H7 with T M; auto with arith pts.
red in |- *; red in |- *; intros.
inversion_clear H5; inversion_clear H6.
red in |- *; red in |- *; intros.
inversion_clear H5; inversion_clear H6.
red in |- *; red in |- *; intros.
generalize H1.
inversion_clear H2.
inversion_clear H3; simpl in |- *; intros.
inversion_clear H2.
elim H4 with T M; auto with arith pts.
inversion_clear H3.
simpl in |- *.
elim (delta_reduce n e); intros.
auto with arith pts.
elim b with (lift (S n) d).
apply delta_intro with T; auto with arith pts.
intros.
apply H4.
apply bd_red_whnf with x; auto with arith pts.
Qed.
simple induction args; simpl in |- *; intros; auto with arith pts.
apply whnf_bd_head_normal; auto with arith pts.
apply H; intros.
simpl in |- *; auto with arith pts.
discriminate.
Qed.
Let f1 (a : approx) :=
match a with
| (e, (t, args)) => existT (fun _ => value) (e, app_list args t) (e, t)
end.
Definition whnf_bd_ord (x y : approx) :=
lexprod value (fun _ : value => value) (R_exp beta_delta)
(fun _ : value => subterm) (f1 x) (f1 y).
simple induction l; simpl in |- *; intros; auto with arith pts.
Qed.
Hint Resolve bd_app_list_ctxt: pts.
intros.
pattern e, t, args in |- *.
apply (Acc3_rec (R:=whnf_bd_ord)).
clear H e t args.
intros e t args.
case t; intros.
exists (app_list args (Srt s)); auto with arith pts.
apply whnf_bd_app_list; simpl in |- *; intros; auto with arith pts.
discriminate.
elim delta_reduce with n e; intros.
inversion_clear a.
elim H with e x args; intros; auto with arith pts.
exists x0; auto with arith pts.
apply red_trans with (app_list args x); auto with arith pts.
red in |- *; red in |- *.
apply rt_step.
apply bd_app_list_ctxt.
apply ctx_rule.
right; auto with arith pts.
red in |- *; simpl in |- *.
left.
apply Rex_intro.
apply bd_app_list_ctxt.
apply ctx_rule.
right; auto with arith pts.
exists (app_list args (Ref n)); auto with arith pts.
apply whnf_bd_app_list; simpl in |- *; intros; auto with arith pts.
elim delta_reduce with n e; intros.
inversion_clear a.
elim b with x; auto with arith pts.
auto with arith pts.
discriminate.
generalize H.
case args; simpl in |- *; intros.
exists (Abs t0 t1); simpl in |- *; auto with arith pts.
apply whnf_bd_head_normal; auto with arith pts.
simpl in |- *; auto with arith pts.
elim H0 with e (subst t2 t1) l; simpl in |- *; intros; auto with arith pts.
exists x; auto with arith pts.
apply red_trans with (app_list l (subst t2 t1)); auto with arith pts.
red in |- *; red in |- *.
apply rt_step.
apply bd_app_list_ctxt.
apply ctx_rule; left; auto with arith pts.
red in |- *; simpl in |- *.
left.
apply Rex_intro.
apply bd_app_list_ctxt.
apply ctx_rule; left; auto with arith pts.
elim H with e t0 (t1 :: args); intros; auto with arith pts.
exists x; auto with arith pts.
red in |- *; simpl in |- *; right; auto with arith pts.
exists (app_list args (Prod t0 t1)); simpl in |- *; auto with arith pts.
apply whnf_bd_app_list; simpl in |- *; intros; auto with arith pts.
discriminate.
apply Acc_Acc3.
unfold whnf_bd_ord in |- *.
apply (Acc_inverse_image approx {x_ : value &  value}).
simpl in |- *.
apply acc_A_B_lexprod; intros.
elim H; intros.
apply Acc_intro; intros; auto with arith pts.
inversion_clear H2; auto with arith pts.
exact wf_subterm.
apply wf_subterm.
Qed.

Theorem beta_delta_whnf :
forall (e : env) (t : term),
sn (ctxt beta_delta) e t ->
{u : term | red beta_delta e t u &  head_normal beta_delta e u}.