(* Autor(s): Andrej Dudenhefner (1) Affiliation(s): (1) Saarland University, Saarbrücken, Germany  Related Work: [1] Giannini, Paola, and Simona Ronchi Della Rocca. "Characterization of typings in polymorphic type discipline." Proceedings Third Annual Symposium on Logic in Computer Science. IEEE Computer Society, 1988. *)
From Undecidability.SystemF.Util Require Import Facts poly_type_facts pure_term_facts term_facts typing_facts iipc2_facts.
Arguments funcomp {X Y Z} _ _ / _.
Arguments fresh_in _ _ /.
(* ∀x.t contains_step t[x:= s] *)
Inductive contains_step : poly_type -> poly_type -> Prop :=
| contains_step_subst {s t} : contains_step (poly_abs t) (subst_poly_type (scons s poly_var) t).
Definition contains := clos_refl_trans poly_type contains_step.
(* system F type erased derivability predicate cf. containment type assignment [1] *)
Inductive pure_typing : environment -> pure_term -> poly_type -> Prop :=
| pure_typing_pure_var n {Gamma x t t'} :
nth_error (map (ren_poly_type (Nat.add n)) Gamma) x = Some t ->
contains t t' ->
pure_typing Gamma (pure_var x) (many_poly_abs n t')
| pure_typing_pure_app n {Gamma M N s t t'} :
pure_typing (map (ren_poly_type (Nat.add n)) Gamma) M (poly_arr s t) ->
pure_typing (map (ren_poly_type (Nat.add n)) Gamma) N s ->
contains t t' ->
pure_typing Gamma (pure_app M N) (many_poly_abs n t')
| pure_typing_pure_abs n {Gamma M s t} :
pure_typing (s :: map (ren_poly_type (Nat.add n)) (Gamma)) M t ->
pure_typing Gamma (pure_abs M) (many_poly_abs n (poly_arr s t)).
Definition pure_typable Gamma M := exists t, pure_typing Gamma M t.
Arguments pure_typable : simpl never.
(* constructs a ∀I (cf. λI) type expression *)
Fixpoint tidy (t: poly_type) :=
match t with
| poly_var _ => t
| poly_arr s t => poly_arr (tidy s) (tidy t)
| poly_abs t => if fresh_inb 0 t then ren_poly_type (scons 0 id) (tidy t) else (poly_abs (tidy t))
end.

(* weaken an assumption wrt. derivability *)
Lemma pure_typing_weaken_closed {s s' Gamma1 Gamma2 M t} :
allfv_poly_type (fun=> False) s ->
pure_typing [s] (pure_var 0) s' ->
pure_typing (Gamma1 ++ s' :: Gamma2) M t ->
pure_typing (Gamma1 ++ s :: Gamma2) M t.