Section Infer_Application.
Let le_type_prod_l := inv_prod_l _ (pa_inv_prod the_algos).
Let le_type_prod_r := inv_prod_r _ (pa_inv_prod the_algos).
Definition app_chk_err (u tu : term) (e : type_error) :=
match e with
| Expected_type v tv _ => Apply_err u tu v tv
| e => e
end.
(* Lemma app_chk_expln: (e:env)(u,a,b:term)(err:type_error) (typ_ppal e u (Prod a b))->(expln e err) ->(expln e (app_chk_err u (Prod a b) err)). Intros. (Inversion_clear H0; Simpl; Try Constructor; Trivial). Apply (pp_ok H).  Intros. Apply (pp_least H) with 1:=H0.  Simpl. *)
(*Realizer [e:env][u,v:term] Cases (fix_inference u e) of (inl y)  => Cases (pa_least_prod the_algos e y) of (inleft (dom,rng)) => Cases (fix_chk_wk e v dom) of Chk_ok => (inl ? type_error (pa_subst the_algos v rng)) | (Chk_fail err) => (inr term ? (app_chk_err u (Prod dom rng) err)) end | _  => (inr term ? (Not_a_fun u y)) end | (inr err) => (inr term ? err) end.*)
intros.
case (fix_inference u e); trivial;
[ intros (y, ppty_u) | intros (err, expl, is_err) ].
case (pa_least_prod the_algos e y).
apply type_correctness with (1 := pp_ok ppty_u).
intros ((dom, rng), (wfprd, (leprd, lstprd))).
case (fix_chk_wk e v dom); intros; trivial.
apply wf_type_prod_l with (1 := wfprd).
left.
case (pa_subst the_algos v rng); intros x eqx.
exists x; subst x.
split; intros.
apply type_app with dom; auto with pts.
apply typ_conv_wf with y; auto with pts.
apply (pp_ok ppty_u).
Inversion_typ H0.
apply le_type_trans with (subst v Ur); auto with pts.
apply le_type_subst0 with V.
apply le_type_prod_r with dom; auto with pts.
apply lstprd.
apply (pp_least ppty_u) with (1 := H2).
right.
exists (app_chk_err u (Prod dom rng) err).
generalize e0.
inversion_clear c; simpl in |- *; trivial.
elim H0; simpl in |- *; intros; auto.
pattern dom at 0, err in |- *.
elim H0; simpl in |- *; intros; auto.
intros.
inversion_clear e1.
constructor; intros; auto.
apply typ_conv_wf with y; trivial.
apply (pp_ok ppty_u).
apply lstprd.
apply (pp_least ppty_u) with (1 := H3); trivial.
generalize e0.
inversion_clear c; simpl in |- *; intros.
generalize H0.
case err; simpl in |- *; intros;
try (apply Infe_subt with v; auto with pts; fail).
elim inf_no_exp with (1 := H1).
inversion_clear wfprd.
Inversion_typ H2.
elim inf_error_no_type with (1 := H0) (2 := e0) (3 := H4).
apply False_ind.
inversion_clear wfprd.
Inversion_typ H1.
inversion_clear e1.
elim H7 with s1; trivial.
constructor.
right.
exists (Not_a_fun u y); auto with pts.
constructor.
apply (pp_ok ppty_u).
red in |- *; intros.
elim n with (1 := pp_least ppty_u H0).
right.
exists err; auto with pts.
apply Infe_subt with u; trivial with pts.
Defined.
End Infer_Application.
unfold infer_ppal_type in |- *.
intros.
elim (pa_infer_axiom the_algos) with s; intros.
left.
inversion_clear a.
split with (Srt x).
split; intros.
constructor; auto with pts.
apply (pp_ok H0).
generalize (pp_least H0); intros.
red in H2.
Inversion_typ H1.
apply le_type_trans with (2 := H4); auto with pts.
right.
split with (Topsort s).
constructor; trivial.
red in |- *; intros.
Inversion_typ H0.
elim b with s2; trivial.
constructor.
Defined.
(*Realizer [e:env; A,M:term] Cases (fix_add_typ e A) of Dcl_ok => Cases (fix_inference M (cons ? (Ax A) e)) of (inl TM) => Cases (not_topsort TM) of (inleft s) => (inr term ? (Lambda_topsort (Abs A M) s)) | _ => (inl ? type_error (Prod A TM)) end | (inr err) => (inr term ? (Under A err)) end | (Dcl_fail err) => (inr term ? err) end. *)
intros.
case (fix_add_typ e A); trivial; intros.
case (fix_inference M (Ax A :: e)); trivial;
[ intros (TM, ppty_M) | intros (err, expl, is_err) ].
case (not_topsort TM); [ intros (s, is_s, tops) | intros ].
right.
exists (Lambda_topsort (Abs A M) s); auto with pts.
constructor.
rewrite <- is_s; trivial.
red in |- *; intros.
apply tops.
Inversion_typ H0.
split with s2; trivial.
left.
exists (Prod A TM).
split; intros.
elimtype (exists s' : sort, typ (Ax A :: e) TM (Srt s')); intros.
inversion_clear w.
elim (pa_infer_rule the_algos) with s x; intros.
apply type_abs with x0; auto with pts.
apply type_prod_sat with s x; auto with pts.
apply (pp_ok p).
apply (pp_ok ppty_M).
generalize t.
elim type_correctness with (1 := pp_ok ppty_M); intros.
split with s; trivial with pts.
elim t0 with s; trivial with pts; intros.
split with x.
constructor; auto with pts.
Inversion_typ H0.
apply le_type_trans with (2 := H3).
apply (pa_le_type_prod the_algos); auto with pts.
apply (pp_least ppty_M) with (1 := H1).
right.
split with (Under A err).
constructor; trivial.
apply Infe_under with M; trivial with pts.
right.
exists err; auto with pts.
inversion_clear d.
apply Infe_subt with A; trivial with pts.
constructor.
Defined.

Theorem infer_prod :
forall (e : env) (A B : term), wf e -> infer_ppal_type e (Prod A B).