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.

Lemma distr_hcompose_one (sigma1 : hsubst) (sigma2 : hsubst) (x : hatom) (y : ivar) (z : hatom) (t : trm L') (p : frm L')
(FRESH : forallb (negb ∘ occurs_free_in_trm (inl y) ∘ sigma1)%prg (remove eq_dec x (accum_hatom_in_frm p)) = true)
(FREE : occurs_free_in_frm z p = true)
: cons_hsubst x t (hsubst_compose sigma1 sigma2) z = hsubst_compose (cons_hsubst x (Var_trm y) sigma1) (cons_hsubst (inl y) t sigma2) z.