Require Export Metalib.Metatheory.
Require Export Metalib.LibLNgen.
Require Export Stlc.
(** NOTE: Auxiliary theorems are hidden in generated documentation. In general, there is a [_rec] version of every lemma involving [open] and [close]. *)
(* *********************************************************************** *)
(** * Induction principles for nonterminals *)
Scheme typ_ind' := Induction for typ Sort Prop.
Definition typ_mutind :=
fun H1 H2 H3 =>
typ_ind' H1 H2 H3.
Scheme typ_rec' := Induction for typ Sort Set.
Definition typ_mutrec :=
fun H1 H2 H3 =>
typ_rec' H1 H2 H3.
Scheme exp_ind' := Induction for exp Sort Prop.
Definition exp_mutind :=
fun H1 H2 H3 H4 H5 =>
exp_ind' H1 H2 H3 H4 H5.
Scheme exp_rec' := Induction for exp Sort Set.
Definition exp_mutrec :=
fun H1 H2 H3 H4 H5 =>
exp_rec' H1 H2 H3 H4 H5.
(* *********************************************************************** *)
(** * Close *)
Fixpoint close_exp_wrt_exp_rec (n1 : nat) (x1 : var) (e1 : exp) {struct e1} : exp :=
match e1 with
| var_f x2 => if (x1 == x2) then (var_b n1) else (var_f x2)
| var_b n2 => if (lt_ge_dec n2 n1) then (var_b n2) else (var_b (S n2))
| abs e2 => abs (close_exp_wrt_exp_rec (S n1) x1 e2)
| app e2 e3 => app (close_exp_wrt_exp_rec n1 x1 e2) (close_exp_wrt_exp_rec n1 x1 e3)
end.
Definition close_exp_wrt_exp x1 e1 := close_exp_wrt_exp_rec 0 x1 e1.
(* *********************************************************************** *)
(** * Size *)
Fixpoint size_typ (T1 : typ) {struct T1} : nat :=
match T1 with
| typ_base => 1
| typ_arrow T2 T3 => 1 + (size_typ T2) + (size_typ T3)
end.
Fixpoint size_exp (e1 : exp) {struct e1} : nat :=
match e1 with
| var_f x1 => 1
| var_b n1 => 1
| abs e2 => 1 + (size_exp e2)
| app e2 e3 => 1 + (size_exp e2) + (size_exp e3)
end.
(* *********************************************************************** *)
(** * Degree *)
(** These define only an upper bound, not a strict upper bound. *)
Inductive degree_exp_wrt_exp : nat -> exp -> Prop :=
| degree_wrt_exp_var_f : forall n1 x1,
degree_exp_wrt_exp n1 (var_f x1)
| degree_wrt_exp_var_b : forall n1 n2,
lt n2 n1 ->
degree_exp_wrt_exp n1 (var_b n2)
| degree_wrt_exp_abs : forall n1 e1,
degree_exp_wrt_exp (S n1) e1 ->
degree_exp_wrt_exp n1 (abs e1)
| degree_wrt_exp_app : forall n1 e1 e2,
degree_exp_wrt_exp n1 e1 ->
degree_exp_wrt_exp n1 e2 ->
degree_exp_wrt_exp n1 (app e1 e2).
Scheme degree_exp_wrt_exp_ind' := Induction for degree_exp_wrt_exp Sort Prop.
Definition degree_exp_wrt_exp_mutind :=
fun H1 H2 H3 H4 H5 =>
degree_exp_wrt_exp_ind' H1 H2 H3 H4 H5.
Hint Constructors degree_exp_wrt_exp : core lngen.
(* *********************************************************************** *)
(** * Local closure (version in [Set], induction principles) *)
Inductive lc_set_exp : exp -> Set :=
| lc_set_var_f : forall x1,
lc_set_exp (var_f x1)
| lc_set_abs : forall e1,
(forall x1 : var, lc_set_exp (open_exp_wrt_exp e1 (var_f x1))) ->
lc_set_exp (abs e1)
| lc_set_app : forall e1 e2,
lc_set_exp e1 ->
lc_set_exp e2 ->
lc_set_exp (app e1 e2).
Scheme lc_exp_ind' := Induction for lc_exp Sort Prop.
Definition lc_exp_mutind :=
fun H1 H2 H3 H4 =>
lc_exp_ind' H1 H2 H3 H4.
Scheme lc_set_exp_ind' := Induction for lc_set_exp Sort Prop.
Definition lc_set_exp_mutind :=
fun H1 H2 H3 H4 =>
lc_set_exp_ind' H1 H2 H3 H4.
Scheme lc_set_exp_rec' := Induction for lc_set_exp Sort Set.
Definition lc_set_exp_mutrec :=
fun H1 H2 H3 H4 =>
lc_set_exp_rec' H1 H2 H3 H4.
Hint Constructors lc_exp : core lngen.
Hint Constructors lc_set_exp : core lngen.
(* *********************************************************************** *)
(** * Body *)
Definition body_exp_wrt_exp e1 := forall x1, lc_exp (open_exp_wrt_exp e1 (var_f x1)).
Hint Unfold body_exp_wrt_exp : core.
(* *********************************************************************** *)
(** * Tactic support *)
(** Additional hint declarations. *)
Hint Resolve @plus_le_compat : lngen.
(** Redefine some tactics. *)
Ltac default_case_split ::=
first
[ progress destruct_notin
| progress destruct_sum
| progress safe_f_equal
].
(* *********************************************************************** *)
(** * Theorems about [size] *)
Ltac default_auto ::= auto with arith lngen; tauto.
Ltac default_autorewrite ::= fail.
(* begin hide *)
(* end hide *)
Hint Resolve size_typ_min : lngen.
(* begin hide *)
(* end hide *)
Hint Resolve size_exp_min : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve size_exp_close_exp_wrt_exp_rec : lngen.
Hint Rewrite size_exp_close_exp_wrt_exp_rec using solve [auto] : lngen.
(* end hide *)
Hint Resolve size_exp_close_exp_wrt_exp : lngen.
Hint Rewrite size_exp_close_exp_wrt_exp using solve [auto] : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve size_exp_open_exp_wrt_exp_rec : lngen.
(* end hide *)
Hint Resolve size_exp_open_exp_wrt_exp : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve size_exp_open_exp_wrt_exp_rec_var : lngen.
Hint Rewrite size_exp_open_exp_wrt_exp_rec_var using solve [auto] : lngen.
(* end hide *)
Hint Resolve size_exp_open_exp_wrt_exp_var : lngen.
Hint Rewrite size_exp_open_exp_wrt_exp_var using solve [auto] : lngen.
(* *********************************************************************** *)
(** * Theorems about [degree] *)
Ltac default_auto ::= auto with lngen; tauto.
Ltac default_autorewrite ::= fail.
(* begin hide *)
(* end hide *)
Hint Resolve degree_exp_wrt_exp_S : lngen.
Hint Resolve degree_exp_wrt_exp_O : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve degree_exp_wrt_exp_close_exp_wrt_exp_rec : lngen.
(* end hide *)
Hint Resolve degree_exp_wrt_exp_close_exp_wrt_exp : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Immediate degree_exp_wrt_exp_close_exp_wrt_exp_rec_inv : lngen.
(* end hide *)
Hint Immediate degree_exp_wrt_exp_close_exp_wrt_exp_inv : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve degree_exp_wrt_exp_open_exp_wrt_exp_rec : lngen.
(* end hide *)
Hint Resolve degree_exp_wrt_exp_open_exp_wrt_exp : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Immediate degree_exp_wrt_exp_open_exp_wrt_exp_rec_inv : lngen.
(* end hide *)
Hint Immediate degree_exp_wrt_exp_open_exp_wrt_exp_inv : lngen.
(* *********************************************************************** *)
(** * Theorems about [open] and [close] *)
Ltac default_auto ::= auto with lngen brute_force; tauto.
Ltac default_autorewrite ::= fail.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Immediate close_exp_wrt_exp_rec_inj : lngen.
(* end hide *)
Hint Immediate close_exp_wrt_exp_inj : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve close_exp_wrt_exp_rec_open_exp_wrt_exp_rec : lngen.
Hint Rewrite close_exp_wrt_exp_rec_open_exp_wrt_exp_rec using solve [auto] : lngen.
(* end hide *)
Hint Resolve close_exp_wrt_exp_open_exp_wrt_exp : lngen.
Hint Rewrite close_exp_wrt_exp_open_exp_wrt_exp using solve [auto] : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Resolve open_exp_wrt_exp_rec_close_exp_wrt_exp_rec : lngen.
Hint Rewrite open_exp_wrt_exp_rec_close_exp_wrt_exp_rec using solve [auto] : lngen.
(* end hide *)
Hint Resolve open_exp_wrt_exp_close_exp_wrt_exp : lngen.
Hint Rewrite open_exp_wrt_exp_close_exp_wrt_exp using solve [auto] : lngen.
(* begin hide *)
(* end hide *)
(* begin hide *)
Hint Immediate open_exp_wrt_exp_rec_inj : lngen.
(* end hide *)
Hint Immediate open_exp_wrt_exp_inj : lngen.
(* *********************************************************************** *)
(** * Theorems about [lc] *)
Ltac default_auto ::= auto with lngen brute_force; tauto.
Ltac default_autorewrite ::= autorewrite with lngen.
(* begin hide *)
(* end hide *)
Hint Resolve degree_exp_wrt_exp_of_lc_exp : lngen.
(* begin hide *)
(* end hide *)
Hint Resolve lc_exp_of_degree : lngen.
Ltac typ_lc_exists_tac :=
repeat (match goal with
| H : _ |- _ =>
fail 1
end).
Ltac exp_lc_exists_tac :=
repeat (match goal with
| H : _ |- _ =>
let J1 := fresh in pose proof H as J1; apply degree_exp_wrt_exp_of_lc_exp in J1; clear H
end).
Hint Extern 1 (lc_exp (abs _)) =>
let x1 := fresh in
pick_fresh x1;
apply (lc_abs_exists x1) : core.
Hint Resolve lc_body_exp_wrt_exp : lngen.

Lemma lc_body_abs_1 :
forall e1,
lc_exp (abs e1) ->
body_exp_wrt_exp e1.