From QuickChick.stlc Require Import monad.
Definition tvar := nat.
Definition var := nat.
Inductive type : Type :=
| N : type
| Arrow : type -> type -> type.
Definition type_eq_dec (t1 t2 : type) : {t1 = t2} + {t1 <> t2}.
Inductive term : Type :=
| Const : nat -> term
| Id : var -> term
| App : term -> term -> term
| Abs : term -> term.
(* Terms that do not have applications *)
Inductive app_free : term -> Prop :=
| ConsNoApp : forall n, app_free (Const n)
| IdNoApp : forall x, app_free (Id x)
| AbsNoApp : forall (t : term),
app_free t -> app_free (Abs t).
(* Number of applications in a term *)
Fixpoint app_no (t : term) : nat :=
match t with
| Const _ | Id _ => 0
| Abs t => app_no t
| App t1 t2 => 1 + (app_no t1 + app_no t2)
end.
Definition env := list type.
Inductive bind : env -> nat -> type -> Prop :=
| BindNow   : forall tau env, bind (tau :: env) 0 tau
| BindLater : forall tau tau' x env,
bind env x tau -> bind (tau' :: env) (S x) tau.
Inductive typing (e : env) : term -> type -> Prop :=
| TId :
forall x tau,
nth_error e x = Some tau ->
typing e (Id x) tau
| TConst :
forall n,
typing e (Const n) N
| TAbs :
forall t tau1 tau2,
typing (tau1 :: e) t tau2 ->
typing e (Abs t) (Arrow tau1 tau2)
| TApp :
forall t1 t2 tau1 tau2,
typing e t1 (Arrow tau1 tau2) ->
typing e t2 tau1 ->
typing e (App t1 t2) tau2.
Inductive typing' (e : env) : term -> type -> Prop :=
| TId' :
forall x tau,
bind e x tau ->
typing' e (Id x) tau
| TConst' :
forall n,
typing' e (Const n) N
| TAbs' :
forall t tau1 tau2,
typing' (tau1 :: e) t tau2 ->
typing' e (Abs t) (Arrow tau1 tau2)
| TApp' :
forall t1 t2 tau1 tau2,
typing' e t1 (Arrow tau1 tau2) ->
typing' e t2 tau1 ->
typing' e (App t1 t2) tau2.
Derive Arbitrary for type.
Instance dec_type (t1 t2 : type) : Dec (t1 = t2).

Lemma typing_max_no_app :
forall e t tau,
app_free t ->
typing e t tau ->
typing_max_tau e t tau 0.