Section HSUBST.
#[local] Open Scope list_scope.
Definition to_hsubst (s : subst L') : hsubst :=
fun z : hatom =>
match z with
| inl x => s x
| inr c => @Con_trm L' (inr c)
end.
Definition from_hsubst (sigma : hsubst) : subst L' :=
fun z : ivar => sigma (inl z).
Fixpoint accum_hatom_in_trm (t : trm L') : list hatom :=
match t with
| Var_trm x => [inl x]
| Fun_trm f ts => accum_hatom_in_trms ts
| Con_trm c =>
match c with
| inl cc => []
| inr hc => [inr hc]
end
end
with accum_hatom_in_trms {n : nat} (ts : trms L' n) : list hatom :=
match ts with
| O_trms => []
| S_trms n t ts => accum_hatom_in_trm t ++ accum_hatom_in_trms ts
end.
Fixpoint accum_hatom_in_frm (p : frm L') : list hatom :=
match p with
| Rel_frm R ts => accum_hatom_in_trms ts
| Eqn_frm t1 t2 => accum_hatom_in_trm t1 ++ accum_hatom_in_trm t2
| Neg_frm p1 => accum_hatom_in_frm p1
| Imp_frm p1 p2 => accum_hatom_in_frm p1 ++ accum_hatom_in_frm p2
| All_frm y p1 => L.remove eq_dec (inl y) (accum_hatom_in_frm p1)
end.
#[local] Hint Rewrite in_accum_hatom_in_trm_iff_HC_occurs_in_trm in_accum_hatom_in_trms_iff_HC_occurs_in_trms : simplication_hints.
#[local] Hint Rewrite in_accum_hatom_in_frm_iff_HC_occurs_in_frm : simplication_hints.
Definition hchi_frm (sigma : hsubst) (p : frm L') : ivar :=
1 + maxs (L.map (last_ivar_trm ∘ sigma)%prg (accum_hatom_in_frm p)).
Definition nil_hsubst : hsubst :=
fun z : hatom =>
match z with
| inl x => Var_trm x
| inr c => @Con_trm L' (inr c)
end.
Definition cons_hsubst (x : hatom) (t : trm L') (sigma : hsubst) : hsubst :=
fun z : hatom => if Prelude.eqb z x then t else sigma z.
Definition one_hsubst (x : hatom) (t : trm L') : hsubst :=
cons_hsubst x t nil_hsubst.
Fixpoint hsubst_trm (sigma : hsubst) (t : trm L') : trm L' :=
match t with
| Var_trm x => sigma (inl x)
| Fun_trm f ts => Fun_trm f (hsubst_trms sigma ts)
| Con_trm c =>
match c with
| inl cc => Con_trm c
| inr hc => sigma (inr hc)
end
end
with hsubst_trms {n : nat} (sigma : hsubst) (ts : trms L' n) : trms L' n :=
match ts with
| O_trms => O_trms
| S_trms n t ts => S_trms n (hsubst_trm sigma t) (hsubst_trms sigma ts)
end.
Fixpoint hsubst_frm (sigma : hsubst) (p : frm L') : frm L' :=
let chi : ivar := hchi_frm sigma p in
match p with
| Rel_frm R ts => Rel_frm R (hsubst_trms sigma ts)
| Eqn_frm t1 t2 => Eqn_frm (hsubst_trm sigma t1) (hsubst_trm sigma t2)
| Neg_frm p1 => Neg_frm (hsubst_frm sigma p1)
| Imp_frm p1 p2 => Imp_frm (hsubst_frm sigma p1) (hsubst_frm sigma p2)
| All_frm y p1 => All_frm chi (hsubst_frm (cons_hsubst (inl y) (Var_trm chi) sigma) p1)
end.
#[local] Hint Rewrite occurs_free_in_trm_iff occurs_free_in_trms_iff : simplication_hints.
Definition trm_is_fresh_in_hsubst (x : ivar) (sigma : hsubst) (t : trm L') : bool :=
L.forallb (negb ∘ is_free_in_trm x ∘ sigma)%prg (accum_hatom_in_trm t).
Definition trms_is_fresh_in_hsubst {n : nat} (x : ivar) (sigma : hsubst) (ts : trms L' n) : bool :=
L.forallb (negb ∘ is_free_in_trm x ∘ sigma)%prg (accum_hatom_in_trms ts).
Definition frm_is_fresh_in_hsubst (x : ivar) (sigma : hsubst) (p : frm L') : bool :=
L.forallb (negb ∘ is_free_in_trm x ∘ sigma)%prg (accum_hatom_in_frm p).
Definition equiv_hsubst_in_frm (sigma1 : hsubst) (sigma2 : hsubst) (p : frm L') : Prop :=
forall z : hatom, forall FREE : occurs_free_in_frm z p = true, sigma1 z = sigma2 z.
#[local] Tactic Notation "done" :=
first [now firstorder | done!].
Definition occurs_free_in_trm_wrt (z : hatom) (sigma : hsubst) (t : trm L') : Prop :=
exists x : hatom, occurs_free_in_trm x t = true /\ occurs_free_in_trm z (sigma x) = true.
Definition occurs_free_in_trms_wrt {n : nat} (z : hatom) (sigma : hsubst) (ts : trms L' n) : Prop :=
exists x : hatom, occurs_free_in_trms x ts = true /\ occurs_free_in_trm z (sigma x) = true.
Definition occurs_free_in_frm_wrt (z : hatom) (sigma : hsubst) (p : frm L') : Prop :=
exists x : hatom, occurs_free_in_frm x p = true /\ occurs_free_in_trm z (sigma x) = true.
Fixpoint occurs_free_in_trm_wrt_iff (t : trm L') (z : hatom) (sigma : hsubst) {struct t}
: occurs_free_in_trm_wrt z sigma t <-> occurs_free_in_trm z (hsubst_trm sigma t) = true
with occurs_free_in_trms_wrt_iff n (ts : trms L' n) (z : hatom) (sigma : hsubst) {struct ts}
: occurs_free_in_trms_wrt z sigma ts <-> occurs_free_in_trms z (hsubst_trms sigma ts) = true.
Definition replace_constant_in_trm (c : Henkin_constants) (ct : trm L') (t : trm L') : trm L' :=
hsubst_trm (one_hsubst (inr c) ct) t.
Definition replace_constant_in_trms {n : nat} (c : Henkin_constants) (ct : trm L') (ts : trms L' n) : trms L' n :=
hsubst_trms (one_hsubst (inr c) ct) ts.
Definition replace_constant_in_frm (c : Henkin_constants) (ct : trm L') (p : frm L') : frm L' :=
hsubst_frm (one_hsubst (inr c) ct) p.

Lemma quick_draw_constant (c : Henkin_constants) (x : ivar) (t : trm L') (y : ivar) (p : frm L')
(NE : y <> x)
: replace_constant_in_frm c (Var_trm y) (subst_frm (one_subst x t) p) = subst_frm (one_subst x (replace_constant_in_trm c (Var_trm y) t)) (replace_constant_in_frm c (Var_trm y) p).