Section Substitution.
Fixpoint substituteTerm (s : fol.Term L) (x : nat)
(t : fol.Term L) {struct s} : fol.Term L :=
match s with
| fol.var v =>
match eq_nat_dec x v with
| left _ => t
| right _ => var v
end
| fol.apply f ts => apply f (substituteTerms _ ts x t)
end
with substituteTerms (n : nat) (ss : fol.Terms L n)
(x : nat) (t : fol.Term L) {struct ss} : fol.Terms L n :=
match ss in (fol.Terms _ n0) return (fol.Terms L n0) with
| Tnil => Tnil L
| Tcons m s ts =>
Tcons L m (substituteTerm s x t) (substituteTerms m ts x t)
end.
Definition newVar (l : list nat) : nat := fold_right max 0 (map S l).
Definition substituteFormulaImp (f : fol.Formula L)
(frec : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L f})
(g : fol.Formula L)
(grec : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L g})
(p : nat * fol.Term L) :
{y : fol.Formula L | depth L y = depth L (impH f g)} :=
match frec p with
| exist f' prf1 =>
match grec p with
| exist g' prf2 =>
exist
(fun y : fol.Formula L =>
depth L y = S (max (depth L f) (depth L g)))
(impH f' g')
(eq_ind_r
(fun n : nat =>
S (max n (depth L g')) = S (max (depth L f) (depth L g)))
(eq_ind_r
(fun n : nat =>
S (max (depth L f) n) = S (max (depth L f) (depth L g)))
(refl_equal (S (max (depth L f) (depth L g)))) prf2) prf1)
end
end.
Remark substituteFormulaImpNice :
forall (f g : fol.Formula L)
(z1 z2 : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L f}),
(forall q : nat * fol.Term L, z1 q = z2 q) ->
forall
z3 z4 : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L g},
(forall q : nat * fol.Term L, z3 q = z4 q) ->
forall q : nat * fol.Term L,
substituteFormulaImp f z1 g z3 q = substituteFormulaImp f z2 g z4 q.
Definition substituteFormulaNot (f : fol.Formula L)
(frec : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L f})
(p : nat * fol.Term L) :
{y : fol.Formula L | depth L y = depth L (notH f)} :=
match frec p with
| exist f' prf1 =>
exist (fun y : fol.Formula L => depth L y = S (depth L f))
(notH f')
(eq_ind_r (fun n : nat => S n = S (depth L f))
(refl_equal (S (depth L f))) prf1)
end.
Remark substituteFormulaNotNice :
forall (f : fol.Formula L)
(z1 z2 : nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L f}),
(forall q : nat * fol.Term L, z1 q = z2 q) ->
forall q : nat * fol.Term L,
substituteFormulaNot f z1 q = substituteFormulaNot f z2 q.
Definition substituteFormulaForall (n : nat) (f : fol.Formula L)
(frec : forall b : fol.Formula L,
lt_depth b (forallH n f) ->
nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L b})
(p : nat * fol.Term L) :
{y : fol.Formula L | depth L y = depth L (forallH n f)} :=
match p with
| (v, s) =>
match eq_nat_dec n v with
| left _ =>
exist (fun y : fol.Formula L => depth L y = S (depth L f))
(forallH n f) (refl_equal (depth L (forallH n f)))
| right _ =>
match In_dec eq_nat_dec n (freeVarTerm s) with
| left _ =>
let nv := newVar (v :: freeVarTerm s ++ freeVarFormula f) in
match frec f (depthForall L f n) (n, var nv) with
| exist f' prf1 =>
match
frec f'
(eqDepth L f' f (forallH n f)
(sym_eq prf1) (depthForall L f n)) p
with
| exist f'' prf2 =>
exist
(fun y : fol.Formula L => depth L y = S (depth L f))
(forallH nv f'')
(eq_ind_r (fun n : nat => S n = S (depth L f))
(refl_equal (S (depth L f)))
(trans_eq prf2 prf1))
end
end
| right _ =>
match frec f (depthForall L f n) p with
| exist f' prf1 =>
exist (fun y : fol.Formula L => depth L y = S (depth L f))
(forallH n f')
(eq_ind_r (fun n : nat => S n = S (depth L f))
(refl_equal (S (depth L f))) prf1)
end
end
end
end.
Remark substituteFormulaForallNice :
forall (v : nat) (a : fol.Formula L)
(z1
z2 : forall b : fol.Formula L,
lt_depth b (forallH v a) ->
nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L b}),
(forall (b : fol.Formula L) (q : lt_depth b (forallH v a))
(r : nat * fol.Term L), z1 b q r = z2 b q r) ->
forall q : nat * fol.Term L,
substituteFormulaForall v a z1 q = substituteFormulaForall v a z2 q.
Definition substituteFormulaHelp (f : fol.Formula L)
(v : nat) (s : fol.Term L) : {y : fol.Formula L | depth L y = depth L f}.
intros.
apply
(Formula_depth_rec2 L
(fun f : fol.Formula L =>
nat * fol.Term L -> {y : fol.Formula L | depth L y = depth L f})).
intros.
induction H as (a, b).
exists (equal (substituteTerm t a b) (substituteTerm t0 a b)).
auto.
intros.
induction H as (a, b).
exists (atomic r (substituteTerms _ t a b)).
auto.
exact substituteFormulaImp.
exact substituteFormulaNot.
exact substituteFormulaForall.
exact (v, s).
Defined.
Definition substituteFormula (f : fol.Formula L) (v : nat)
(s : fol.Term L) : fol.Formula L := proj1_sig (substituteFormulaHelp f v s).

Lemma subFormulaForall :
forall (f : fol.Formula L) (x v : nat) (s : fol.Term L),
let nv := newVar (v :: freeVarTerm s ++ freeVarFormula f) in
substituteFormula (forallH x f) v s =
match eq_nat_dec x v with
| left _ => forallH x f
| right _ =>
match In_dec eq_nat_dec x (freeVarTerm s) with
| right _ => forallH x (substituteFormula f v s)
| left _ =>
forallH nv (substituteFormula (substituteFormula f x (var nv)) v s)
end
end.