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).
Definition close_ivars (p : frm L) : list ivar -> frm L :=
@list_rec _ (fun _ => frm L) p (fun x => fun _ => fun q => All_frm x q).
Definition closed_frm (p : frm L) : frm L :=
close_ivars p (nodup eq_dec (fvs_frm p)).
Definition scoped_trm (xs : list ivar) : Set :=
{ t : trm L | forall z, is_free_in_trm z t = true -> In z xs }.
Definition scoped_trms (n : nat) (xs : list ivar) : Set :=
{ ts : trms L n | forall z, is_free_in_trms z ts = true -> In z xs }.
Definition scoped_frm (xs : list ivar) : Set :=
{ p : frm L | forall z, is_free_in_frm z p = true -> In z xs }.
#[program]
Definition sRel {xs : list ivar} (R : L.(relation_symbols)) (ts : scoped_trms (L.(relation_arity_table) R) xs) : scoped_frm xs :=
@exist _ _ (Rel_frm R (proj1_sig ts)) (fun z : ivar => fun H => _).
Next Obligation.
exact (proj2_sig ts z H).
Qed.
#[program]
Definition sEqn {xs : list ivar} (t1 : scoped_trm xs) (t2 : scoped_trm xs) : scoped_frm xs :=
@exist _ _ (Eqn_frm t1 t2) (fun z : ivar => fun H => _).
Next Obligation.
rewrite orb_true_iff in H. destruct H as [H | H].
- eapply (proj2_sig t1 z H).
- eapply (proj2_sig t2 z H).
Qed.
#[program]
Definition sNeg {xs : list ivar} (s1 : scoped_frm xs) : scoped_frm xs :=
@exist _ _ (Neg_frm (proj1_sig s1)) (fun z : ivar => fun H => _).
Next Obligation.
exact (proj2_sig s1 z H).
Qed.
#[program]
Definition sImp {xs : list ivar} (s1 : scoped_frm xs) (s2 : scoped_frm xs) : scoped_frm xs :=
@exist _ _ (Imp_frm (proj1_sig s1) (proj1_sig s2)) (fun z : ivar => fun H => _).
Next Obligation.
rewrite orb_true_iff in H. destruct H as [H | H].
- eapply (proj2_sig s1 z H).
- eapply (proj2_sig s2 z H).
Qed.
#[program]
Definition sAll {xs : list ivar} (y : ivar) (s1 : scoped_frm (y :: xs)) : scoped_frm xs :=
@exist _ _ (All_frm y (proj1_sig s1)) (fun z : ivar => fun H => _).
Next Obligation.
s!. destruct H as [FREE NE]. pose proof (proj2_sig s1 z FREE) as claim. simpl in claim.
destruct claim as [EQ | IN]; [now contradiction NE | exact IN].
Qed.
#[program]
Definition Con_trm_nil_scoped (c : L.(constant_symbols)) : scoped_trm [] :=
@exist _ _ (Con_trm c) _.
#[program]
Definition subst_one_frm_nil_scoped (y : ivar) (t : scoped_trm []) (p : scoped_frm [y]) : scoped_frm [] :=
@exist _ _ (subst_frm (one_subst y (proj1_sig t)) (proj1_sig p)) _.
Next Obligation.
revert z H.
assert (claim1 : forall z : ivar, is_free_in_frm z (proj1_sig p) = true -> z = y).
{ intros z FREE. now pose proof (proj2_sig p z FREE) as [EQ | []]. }
assert (claim2 : forall z : ivar, is_not_free_in_trm z (proj1_sig t)).
{ intros z. red. pose proof (proj2_sig t z). destruct (is_free_in_trm z (proj1_sig t)) as [ | ]; [now contradiction H | reflexivity]. }
intros z H. pose proof (one_fv_frm_subst_closed_term_close_formula y (proj1_sig t) (proj1_sig p) claim1 claim2 z) as claim3. red in claim3.
enough (WTS : true = false) by discriminate. rewrite <- H. rewrite <- claim3. reflexivity.
Qed.

Lemma closed_frm_is_sentence (p : frm L)
: L.null (fvs_frm (closed_frm p)) = true.