left; exists s; auto with pts.
right; red in |- *; simple induction 1; intros.
discriminate H0.
right; red in |- *; simple induction 1; intros.
discriminate H0.
right; red in |- *; simple induction 1; intros.
discriminate H0.
right; red in |- *; simple induction 1; intros.
discriminate H0.
Qed.
Definition typed_sort (axiom : sort -> sort -> Prop)
(s : sort) : Prop := exists s2 : _, axiom s s2.
Definition typ_ppal (e : env) (m t : term) : Prop :=
ppal (typ e m) (le_type e) t.
Definition red_to_sort_dec (e : env) (t : term) : Set :=
ppal_dec (fun s => le_type e t (Srt s)) le_sort.
Definition red_to_wf_prod_dec (e : env) (t : term) : Set :=
{p : term * term |
let (C, D) := p in
wf_type e (Prod C D) /\
le_type e t (Prod C D) /\
(forall A B : term,
le_type e t (Prod A B) -> le_type e (Prod C D) (Prod A B))} +
{(forall C D : term, ~ le_type e t (Prod C D))}.
(* Algorithms and properties implying the decidability of typing *)
Record PTS_algos : Set :=
{pa_lift : forall (n : nat) (t : term), {u : term | u = lift n t};
pa_subst : forall u v : term, {t : term | t = subst u v};
pa_infer_axiom : forall s : sort, ppal_dec (axiom s) le_sort;
pa_least_sort :
forall (e : env) (t : term), wf_type e t -> red_to_sort_dec e t;
pa_infer_rule :
forall x1 x2 : sort, {x3 : sort | ppal (rule_sat x1 x2) le_sort x3};
pa_least_prod :
forall (e : env) (t : term), wf_type e t -> red_to_wf_prod_dec e t;
pa_le_type_prod :
forall (e : env) (T A B : term),
le_type (Ax T :: e) A B -> le_type e (Prod T A) (Prod T B);
pa_inv_prod : product_inversion le_type;
pa_topsort_untyped :
forall (e : env) (s s' : sort) (t : term),
le_type e (Srt s) t -> typ e t (Srt s') -> typed_sort axiom s;
pa_le_type_dec :
forall (e : env) (u v : term),
wf_type e u -> wf_type e v -> decide (le_type e u v)}.
Variable the_algos : PTS_algos.
Load "Errors".
Definition infer_ppal_type (e : env) (m : term) : Set :=
({t : term | ppal (typ e m) (le_type e) t} +
{err : type_error | expln e err &  inf_error m err})%type.
Inductive wft_dec (e : env) (t : term) : Set :=
| Wft_ok : wf_type e t -> wft_dec e t
| Wft_fail :
forall err : type_error,
expln e err ->
decl_error (Ax t) err ->
~ (exists s : sort, t = Srt s) -> wft_dec e t.
Inductive check_dec (e : env) (m t : term) : Set :=
| Chk_ok : typ e m t -> check_dec e m t
| Chk_fail :
forall err : type_error,
expln e err -> chk_error m t err -> check_dec e m t.
Inductive decl_dec (e : env) (d : decl) : Set :=
| Dcl_ok : wf (d :: e) -> decl_dec e d
| Dcl_fail :
forall err : type_error,
expln e err -> decl_error d err -> decl_dec e d.
(* The type-checking module to build *)
Record PTS_TC : Set :=
{
(* Infer command *)
ptc_inf_ppal_type :
forall (e : env) (t : term), wf e -> infer_ppal_type e t;
(* Check command *)
ptc_chk_typ : forall (e : env) (t T : term), wf e -> check_dec e t T;
(* Axiom command *)
ptc_add_typ : forall (e : env) (t : term), wf e -> decl_dec e (Ax t);
(* Definition command *)
ptc_add_def :
forall (e : env) (t T : term), wf e -> decl_dec e (Def t T);
(* Auxiliary functions. Would be useful to write tactics over the kernel. *)
ptc_chk_wk :
forall (e : env) (t T : term), wf e -> wf_type e T -> check_dec e t T;
ptc_chk_wft : forall (e : env) (t : term), wf e -> wft_dec e t}.

Lemma not_topsort :
forall t : term,
{s : sort | t = Srt s &  ~ typed_sort axiom s} +
{(forall s : sort, t = Srt s -> typed_sort axiom s)}.