Section FOL_SYNTAX. (* Reference: "https://github.com/ernius/formalmetatheory-stoughton" *)
#[local] Hint Unfold compose : simplication_hints.
#[local] Open Scope program_scope.
Definition renaming : Set :=
ivar -> ivar.
Definition subst (L : language) : Set :=
ivar -> trm L.
Context {L : language}.
Fixpoint fvs_trm (t : trm L) : list ivar :=
match t with
| Var_trm x => [x]
| Fun_trm f ts => fvs_trms ts
| Con_trm c => []
end
with fvs_trms {n : nat} (ts : trms L n) : list ivar :=
match ts with
| O_trms => []
| S_trms n t ts => fvs_trm t ++ fvs_trms ts
end.
Fixpoint fvs_frm (p : frm L) : list ivar :=
match p with
| Rel_frm r ts => fvs_trms ts
| Eqn_frm t1 t2 => fvs_trm t1 ++ fvs_trm t2
| Neg_frm p1 => fvs_frm p1
| Imp_frm p1 p2 => fvs_frm p1 ++ fvs_frm p2
| All_frm y p1 => List.remove eq_dec y (fvs_frm p1)
end.
#[local] Hint Rewrite fv_is_free_in_trm fv_is_free_in_trms : simplication_hints.
#[local] Hint Rewrite fv_is_free_in_frm : simplication_hints.
Definition is_not_free_in_trm (x : ivar) (t : trm L) : Prop :=
is_free_in_trm x t = false.
Definition is_not_free_in_trms {n : nat} (x : ivar) (ts : trms L n) : Prop :=
is_free_in_trms x ts = false.
Definition is_not_free_in_frm (x : ivar) (p : frm L) : Prop :=
is_free_in_frm x p = false.
#[local] Hint Unfold is_not_free_in_frm is_free_in_trms is_not_free_in_frm : simplication_hints.
Definition fvs_frms (ps : ensemble (frm L)) : ensemble ivar :=
ps >>= E.fromList ∘ fvs_frm.
#[local] Hint Rewrite fvs_is_free_in_frms : simplication_hints.
Definition is_not_free_in_frms (x : ivar) (ps : ensemble (frm L)) : Prop :=
forall p, p \in ps -> is_free_in_frm x p = false.
#[local] Hint Unfold is_not_free_in_frms : simplication_hints.
Definition last_ivar_trm (t : trm L) : ivar :=
maxs (fvs_trm t).
Fixpoint last_ivar_trms {n : nat} (ts : trms L n) : ivar :=
match ts with
| O_trms => 0
| S_trms n t ts => max (last_ivar_trm t) (last_ivar_trms (n := n) ts)
end.
Definition last_ivar_frm (p : frm L) : ivar :=
maxs (fvs_frm p).
#[local] Hint Unfold last_ivar_trm last_ivar_frm : simplication_hints.
#[local] Hint Rewrite <- last_ivar_trms_eq_maxs_fvs : simplication_hints.
Definition chi_frm (s : subst L) (p : frm L) : ivar :=
1 + maxs (List.map (last_ivar_trm ∘ s) (fvs_frm p)).
Definition nil_subst : subst L :=
fun z : ivar => Var_trm z.
Definition cons_subst (y : ivar) (t : trm L) (s : subst L) : subst L :=
fun z : ivar => if eq_dec z y then t else s z.
Definition one_subst (x1 : ivar) (t1 : trm L) : subst L :=
cons_subst x1 t1 nil_subst.
#[local] Hint Unfold nil_subst cons_subst one_subst : simplication_hints.
Fixpoint subst_trm (s : subst L) (t : trm L) : trm L :=
match t with
| Var_trm x => s x
| Fun_trm f ts => Fun_trm f (subst_trms s ts)
| Con_trm c => Con_trm c
end
with subst_trms {n : nat} (s : subst L) (ts : trms L n) : trms L n :=
match ts with
| O_trms => O_trms
| S_trms n t ts => S_trms n (subst_trm s t) (subst_trms (n := n) s ts)
end.
Fixpoint subst_frm (s : subst L) (p : frm L) : frm L :=
let chi : ivar := chi_frm s p in
match p with
| Rel_frm R ts => Rel_frm R (subst_trms s ts)
| Eqn_frm t1 t2 => Eqn_frm (subst_trm s t1) (subst_trm s t2)
| Neg_frm p1 => Neg_frm (subst_frm s p1)
| Imp_frm p1 p2 => Imp_frm (subst_frm s p1) (subst_frm s p2)
| All_frm y p1 => All_frm chi (subst_frm (cons_subst y (Var_trm chi) s) p1)
end.
Definition subst_compose (s : subst L) (s' : subst L) : subst L :=
fun z : ivar => subst_trm s' (s z).
#[local] Hint Unfold subst_compose : simplication_hints.
Definition equiv_subst_in_frm (s1 : subst L) (s2 : subst L) (p : frm L) : Prop :=
forall z : ivar, forall FREE : is_free_in_frm z p = true, s1 z = s2 z.
Definition free_in_trm_wrt (x : ivar) (s : subst L) (t : trm L) : Prop :=
exists y : ivar, is_free_in_trm y t = true /\ is_free_in_trm x (s y) = true.
Definition free_in_trms_wrt {n : nat} (x : ivar) (s : subst L) (ts : trms L n) : Prop :=
exists y : ivar, is_free_in_trms y ts = true /\ is_free_in_trm x (s y) = true.
Definition free_in_frm_wrt (x : ivar) (s : subst L) (p : frm L) : Prop :=
exists y : ivar, is_free_in_frm y p = true /\ is_free_in_trm x (s y) = true.
#[local] Hint Rewrite <- free_in_trm_wrt_iff free_in_trms_wrt_iff : simplication_hints.
#[local] Hint Rewrite <- subst_compose_trm_spec subst_compose_trms_spec : simplication_hints.
#[local] Hint Rewrite <- subst_compose_frm_spec : simplication_hints.
Definition rename_trm (eta : renaming) : trm L -> trm L :=
subst_trm (Var_trm ∘ eta)%prg.
Definition rename_trms {n : nat} (eta : renaming) : trms L n -> trms L n :=
subst_trms (Var_trm ∘ eta)%prg.
Definition rename_frm (eta : renaming) : frm L -> frm L :=
subst_frm (Var_trm ∘ eta)%prg.
Definition fvs_eq_trm (t1 : trm L) (t2 : trm L) : Prop :=
forall x : ivar, is_free_in_trm x t1 = true <-> is_free_in_trm x t2 = true.
Definition fvs_eq_frm (p1 : frm L) (p2 : frm L) : Prop :=
forall x : ivar, is_free_in_frm x p1 = true <-> is_free_in_frm x p2 = true.
Inductive alpha_equiv : frm L -> frm L -> Prop :=
| alpha_Rel_frm R ts ts'
(EQ : ts = ts')
: Rel_frm R ts ≡ Rel_frm R ts'
| alpha_Eqn_frm t1 t2 t1' t2'
(EQ1 : t1 = t1')
(EQ2 : t2 = t2')
: Eqn_frm t1 t2 ≡ Eqn_frm t1' t2'
| alpha_Neg_frm p1 p1'
(ALPHA1 : p1 ≡ p1')
: Neg_frm p1 ≡ Neg_frm p1'
| alpha_Imp_frm p1 p2 p1' p2'
(ALPHA1 : p1 ≡ p1')
(ALPHA2 : p2 ≡ p2')
: Imp_frm p1 p2 ≡ Imp_frm p1' p2'
| alpha_All_frm z y y' p1 p1'
(ALPHA1 : subst_frm (one_subst y (Var_trm z)) p1 ≡ subst_frm (one_subst y' (Var_trm z)) p1')
(LFRESH : is_free_in_frm z (All_frm y p1) = false)
(RFRESH : is_free_in_frm z (All_frm y' p1') = false)
: All_frm y p1 ≡ All_frm y' p1'
where " p ≡ p' " := (alpha_equiv p p') : type_scope.
#[local] Hint Constructors alpha_equiv : core.
#[global]
Instance alpha_equiv_Reflexive
: Reflexive alpha_equiv.
#[global]
Instance alpha_equiv_Symmetric
: Symmetric alpha_equiv.
#[global]
Instance alpha_equiv_Transitive
: Transitive alpha_equiv.
#[global]
Instance alpha_equiv_Equivalence : Equivalence alpha_equiv :=
{ Equivalence_Reflexive := alpha_equiv_Reflexive
; Equivalence_Symmetric := alpha_equiv_Symmetric
; Equivalence_Transitive := alpha_equiv_Transitive
}.
#[global]
Add Parametric Morphism
: subst_frm with signature (eq ==> alpha_equiv ==> eq) as subst_frm_alpha_equiv_returns_eq.
#[global]
Add Parametric Morphism
: subst_frm with signature (eq ==> alpha_equiv ==> alpha_equiv) as subst_frm_alpha_equiv_returns_alpha_equiv.
#[global]
Add Parametric Morphism
: Neg_frm with signature (alpha_equiv ==> alpha_equiv)
as Neg_frm_alpha_equiv_alpha_equiv.
#[global]
Add Parametric Morphism
: Imp_frm with signature (alpha_equiv ==> alpha_equiv ==> alpha_equiv)
as Neg_frm_alpha_equiv_alpha_equiv_alpha_equiv.
#[global]
Add Parametric Morphism
: All_frm with signature (eq ==> alpha_equiv ==> alpha_equiv)
as All_frm_eq_alpha_equiv_alpha_equiv.
Definition fresh_var (x : ivar) (t : trm L) (p : frm L) : ivar :=
1 + maxs ([x] ++ fvs_trm t ++ fvs_frm p).
#[local] Hint Rewrite fresh_var_ne_x fresh_var_is_not_free_in_trm fresh_var_is_not_free_in_frm : simplication_hints.
Inductive subst1_spec (x : ivar) (t : trm L) : frm L -> frm L -> Prop :=
| subst1_All_EQ y p
(EQ : x = y)
: subst1_spec x t (All_frm y p) (All_frm y p)
| subst1_All_FRESH y p1 p1'
(NE : x <> y)
(NOT_OCCUR : is_free_in_trm y t = false)
(SUBST1 : subst1_spec x t p1 p1')
: subst1_spec x t (All_frm y p1) (All_frm y p1')
| subst1_All_RENAME y z p1 p1' p1''
(NEW_IVAR : z = fresh_var x t p1)
(NE : x <> y)
(NOT_OCCUR : is_free_in_trm y t = true)
(SUBST1 : subst1_spec y (Var_trm z) p1 p1')
(SUBST2 : subst1_spec x t p1' p1'')
: subst1_spec x t (All_frm y p1) (All_frm z p1'')
| subst1_Atomic p p'
(RANK_ZERO : frm_depth p = 0)
(EQ : p' = subst_frm (one_subst x t) p)
: subst1_spec x t p p'
| subst1_Neg p1 p1'
(SUBST1 : subst1_spec x t p1 p1')
: subst1_spec x t (Neg_frm p1) (Neg_frm p1')
| subst1_Imp p1 p2 p1' p2'
(SUBST1 : subst1_spec x t p1 p1')
(SUBST2 : subst1_spec x t p2 p2')
: subst1_spec x t (Imp_frm p1 p2) (Imp_frm p1' p2').
Definition subst1 (x : ivar) (t : trm L) (p : frm L) : frm L :=
proj1_sig (subst1_uniquely_exists x t p).

Lemma subst1_preserves_rank (x : ivar) (t : trm L) (p : frm L)
: frm_depth (subst1 x t p) = frm_depth p.