Section Code_Substitute_Formula.
Variable L : Language.
Variable codeF : Functions L -> nat.
Variable codeR : Relations L -> nat.
Notation Formula := (Formula L) (only parsing).
Notation Formulas := (Formulas L) (only parsing).
Notation System := (System L) (only parsing).
Notation Term := (Term L) (only parsing).
Notation Terms := (Terms L) (only parsing).
Let var := var L.
Let apply := apply L.
Let codeFormula := codeFormula L codeF codeR.
Let codeTerm := codeTerm L codeF.
Definition cTriple (a b c : nat) : nat := cPair a (cPair b c).
Definition cTriplePi1 (n : nat) : nat := cPairPi1 n.
Definition cTriplePi2 (n : nat) : nat := cPairPi1 (cPairPi2 n).
Definition cTriplePi3 (n : nat) : nat := cPairPi2 (cPairPi2 n).
unfold cTriplePi1, cTriple in |- *.
intros.
apply cPairProjections1.
Qed.
unfold cTriplePi2, cTriple in |- *.
intros.
rewrite cPairProjections2.
apply cPairProjections1.
Qed.
unfold cTriplePi3, cTriple in |- *.
intros.
rewrite cPairProjections2.
apply cPairProjections2.
Qed.
(*Trace has form ((v,s, formula_input), formula_output, [subTrace1], [subTrace2])*)
Definition codeNewVar (l : nat) : nat :=
evalStrongRec 0
(fun n Hrecs : nat =>
switchPR n
(max (S (cPairPi1 (pred n)))
(codeNth (n - S (cPairPi2 (pred n))) Hrecs)) 0) l.
Definition checkSubFormulaTrace : nat -> nat :=
evalStrongRec 0
(fun trace recs : nat =>
let v := cTriplePi1 (cTriplePi1 trace) in
let s := cTriplePi2 (cTriplePi1 trace) in
let input := cTriplePi3 (cTriplePi1 trace) in
let output := cTriplePi2 trace in
let rest := cTriplePi3 trace in
let type := cPairPi1 input in
switchPR type
(switchPR (pred type)
(switchPR (pred (pred type))
(switchPR (pred (pred (pred type)))
(charFunction 2 beq_nat output
(cPair type (codeSubTerms (cPairPi2 input) v s)))
(switchPR
(charFunction 2 beq_nat v (cPairPi1 (cPairPi2 input)))
(charFunction 2 beq_nat input output)
(switchPR
(codeIn (cPairPi1 (cPairPi2 input)) (codeFreeVarTerm s))
(let nv :=
codeNewVar
(S
(cPair v
(codeApp (codeFreeVarTerm s)
(codeFreeVarFormula
(cPairPi2 (cPairPi2 input)))))) in
charFunction 0
(beq_nat output
(cPair 3 (cPair nv (cTriplePi2 (cPairPi2 rest)))) &&
(beq_nat (cTriple v s (cTriplePi2 (cPairPi1 rest)))
(cTriplePi1 (cPairPi2 rest)) &&
beq_nat
(cTriple (cPairPi1 (cPairPi2 input))
(cPair 0 nv) (cPairPi2 (cPairPi2 input)))
(cTriplePi1 (cPairPi1 rest)))) *
(codeNth (trace - S (cPairPi1 rest)) recs *
codeNth (trace - S (cPairPi2 rest)) recs))
(charFunction 0
(beq_nat output
(cPair 3
(cPair (cPairPi1 (cPairPi2 input))
(cTriplePi2 rest))) &&
beq_nat (cTriple v s (cPairPi2 (cPairPi2 input)))
(cTriplePi1 rest)) *
codeNth (trace - S rest) recs))))
(charFunction 0
(beq_nat output (cPair 2 (cTriplePi2 rest)) &&
beq_nat (cTriple v s (cPairPi2 input)) (cTriplePi1 rest)) *
codeNth (trace - S rest) recs))
(charFunction 0
(beq_nat output
(cPair 1
(cPair (cTriplePi2 (cPairPi1 rest))
(cTriplePi2 (cPairPi2 rest)))) &&
(beq_nat (cTriple v s (cPairPi1 (cPairPi2 input)))
(cTriplePi1 (cPairPi1 rest)) &&
beq_nat (cTriple v s (cPairPi2 (cPairPi2 input)))
(cTriplePi1 (cPairPi2 rest)))) *
(codeNth (trace - S (cPairPi1 rest)) recs *
codeNth (trace - S (cPairPi2 rest)) recs)))
(charFunction 2 beq_nat output
(cPair 0
(cPair (codeSubTerm (cPairPi1 (cPairPi2 input)) v s)
(codeSubTerm (cPairPi2 (cPairPi2 input)) v s))))).
Definition makeTraceImp (f1 : fol.Formula L)
(f1rec : nat * fol.Term L -> nat) (f2 : fol.Formula L)
(f2rec : nat * fol.Term L -> nat) (p : nat * fol.Term L) : nat :=
let v := fst p in
let s := snd p in
cTriple (cTriple v (codeTerm s) (codeFormula (impH L f1 f2)))
(codeFormula (substituteFormula L (impH L f1 f2) v s))
(cPair (f1rec p) (f2rec p)).
Definition makeTraceNot (f : fol.Formula L) (frec : nat * fol.Term L -> nat)
(p : nat * fol.Term L) : nat :=
let v := fst p in
let s := snd p in
cTriple (cTriple v (codeTerm s) (codeFormula (notH L f)))
(codeFormula (substituteFormula L (notH L f) v s))
(frec p).
Definition makeTraceForall (n : nat) (f : fol.Formula L)
(rec : forall b : fol.Formula L,
lt_depth L b (forallH L n f) -> nat * fol.Term L -> nat)
(p : nat * fol.Term L) : nat.
intros.
set (v := fst p) in *.
set (s := snd p) in *.
induction (eq_nat_dec n v).
exact
(cTriple (cTriple v (codeTerm s) (codeFormula (forallH L n f)))
(codeFormula (substituteFormula L (forallH L n f) v s)) 0).
assert (lt_depth L f (forallH L v f)).
apply depthForall.
induction (In_dec eq_nat_dec n (freeVarTerm L s)).
set (nv := newVar (v :: freeVarTerm L s ++ freeVarFormula L f)) in *.
assert (lt_depth L (substituteFormula L f n (var nv)) (forallH L v f)).
apply eqDepth with f.
symmetry  in |- *.
apply subFormulaDepth.
apply H.
exact
(cTriple (cTriple v (codeTerm s) (codeFormula (forallH L n f)))
(codeFormula (substituteFormula L (forallH L n f) v s))
(cPair (rec f H (n, var nv))
(rec (substituteFormula L f n (var nv)) H0 p))).
exact
(cTriple (cTriple v (codeTerm s) (codeFormula (forallH L n f)))
(codeFormula (substituteFormula L (forallH L n f) v s))
(rec f H p)).
Defined.
Definition makeTrace : fol.Formula L -> nat * fol.Term L -> nat :=
Formula_depth_rec2 L (fun _ : fol.Formula L => nat * fol.Term L -> nat)
(fun (t t0 : fol.Term L) (p : nat * fol.Term L) =>
let v := fst p in
let s := snd p in
cTriple (cTriple v (codeTerm s) (codeFormula (equal L t t0)))
(codeFormula (substituteFormula L (equal L t t0) v s)) 0)
(fun (r : Relations L) t (p : nat * fol.Term L) =>
let v := fst p in
let s := snd p in
cTriple (cTriple v (codeTerm s) (codeFormula (atomic L r t)))
(codeFormula (substituteFormula L (atomic L r t) v s)) 0) makeTraceImp
makeTraceNot makeTraceForall.
Remark makeTrace1 :
forall (f : fol.Formula L) (v : nat) (s : fol.Term L),
cTriplePi1 (makeTrace f (v, s)) = cTriple v (codeTerm s) (codeFormula f).
Remark makeTrace2 :
forall (f : fol.Formula L) (v : nat) (s : fol.Term L),
cTriplePi2 (makeTrace f (v, s)) = codeFormula (substituteFormula L f v s).
Definition ReplaceTermTermsTerm : nat -> nat -> nat :=
evalStrongRec 1
(fun t recs s : nat =>
cPair
(switchPR (cPairPi1 t)
(cPair (cPairPi1 t) (cPairPi2 (codeNth (t - S (cPairPi2 t)) recs)))
(cPair 0 s))
(switchPR t
(S
(cPair (cPairPi1 (codeNth (t - S (cPairPi1 (pred t))) recs))
(cPairPi2 (codeNth (t - S (cPairPi2 (pred t))) recs)))) 0)).
Remark ReplaceTermTermsTermIsPR : isPR 2 ReplaceTermTermsTerm.
Definition ReplaceTermTerm (t s : nat) : nat :=
cPairPi1 (ReplaceTermTermsTerm t s).
Definition ReplaceTermsTerm (t s : nat) : nat :=
cPairPi2 (ReplaceTermTermsTerm t s).
Remark ReplaceTermTermsTermMonotone :
forall a s1 s2 : nat,
s1 <= s2 ->
ReplaceTermTerm a s1 <= ReplaceTermTerm a s2 /\
ReplaceTermsTerm a s1 <= ReplaceTermsTerm a s2.
Remark maxLemma :
forall a b c d : nat, a <= b -> c <= d -> max a c <= max b d.
Remark maxLemma2 :
forall a b : list nat, fold_right max 0 a <= fold_right max 0 (a ++ b).
Remark maxLemma3 :
forall a b : list nat, fold_right max 0 b <= fold_right max 0 (a ++ b).
Remark maxApp :
forall a b : list nat,
{fold_right max 0 (a ++ b) = fold_right max 0 a} +
{fold_right max 0 (a ++ b) = fold_right max 0 b}.
Definition ReplaceFormulaTerm : nat -> nat -> nat :=
evalStrongRec 1
(fun f recs s : nat =>
switchPR (cPairPi1 f)
(switchPR (pred (cPairPi1 f))
(switchPR (pred (pred (cPairPi1 f)))
(switchPR (pred (pred (pred (cPairPi1 f))))
(cPair (cPairPi1 f) (ReplaceTermsTerm (cPairPi2 f) s))
(cPair 3
(cPair s (codeNth (f - S (cPairPi2 (cPairPi2 f))) recs))))
(cPair 2 (codeNth (f - S (cPairPi2 f)) recs)))
(cPair 1
(cPair (codeNth (f - S (cPairPi1 (cPairPi2 f))) recs)
(codeNth (f - S (cPairPi2 (cPairPi2 f))) recs))))
(cPair 0
(cPair (ReplaceTermTerm (cPairPi1 (cPairPi2 f)) s)
(ReplaceTermTerm (cPairPi2 (cPairPi2 f)) s)))).
Fixpoint varFormula (f : fol.Formula L) : list nat :=
match f with
| equal t s => freeVarTerm L t ++ freeVarTerm L s
| atomic r ts => freeVarTerms L _ ts
| impH A B => varFormula A ++ varFormula B
| notH A => varFormula A
| forallH v A => v :: varFormula A
end.
Remark codeTermFreeVar :
forall s : fol.Term L, fold_right max 0 (freeVarTerm L s) <= codeTerm s.
Remark maxVarFreeVar :
forall f : fol.Formula L,
fold_right max 0 (freeVarFormula L f) <= fold_right max 0 (varFormula f).
Remark maxSubTerm :
forall (t : fol.Term L) (v : nat) (s : fol.Term L),
fold_right max 0 (freeVarTerm L (substituteTerm L t v s)) <=
fold_right max 0 (freeVarTerm L s ++ freeVarTerm L t).
Remark maxSubTerms :
forall (n : nat) (ts : fol.Terms L n) (v : nat) (s : fol.Term L),
fold_right max 0 (freeVarTerms L n (substituteTerms L n ts v s)) <=
fold_right max 0 (freeVarTerm L s ++ freeVarTerms L n ts).
Definition pow3 : nat -> nat :=
nat_rec (fun _ => nat) 1 (fun _ rec : nat => rec + (rec + rec)).
Remark mapListLemma :
forall l : list nat, fold_right max 0 (map S l) <= S (fold_right max 0 l).
Remark boundSubFormulaHelp2 :
forall (a : fol.Formula L) (v0 : nat) (s : fol.Term L),
newVar (v0 :: freeVarTerm L s ++ freeVarFormula L a) <=
S
(fold_right max 0
(v0 :: fold_right max 0 (freeVarTerm L s) :: varFormula a)).
intros.
unfold newVar in |- *.
apply
le_trans
with (S (fold_right max 0 (v0 :: freeVarTerm L s ++ freeVarFormula L a))).
apply mapListLemma.
apply le_n_S.
simpl in |- *.
apply maxLemma.
apply le_n.
induction (maxApp (freeVarTerm L s) (freeVarFormula L a)).
rewrite a0.
apply le_max_l.
rewrite b.
eapply le_trans.
apply maxVarFreeVar.
apply le_max_r.
Qed.
Remark boundSubFormulaHelp1 :
forall (b a : fol.Formula L) (v0 v : nat) (s : fol.Term L),
fold_right max 0
(varFormula
(substituteFormula L b v
(fol.var L (newVar (v0 :: freeVarTerm L s ++ freeVarFormula L a))))) <=
pow3 (depth L b) + pow3 (depth L b) +
max v0
(max (fold_right max 0 (freeVarTerm L s))
(max v
(max (fold_right max 0 (varFormula b))
(fold_right max 0 (varFormula a))))).
Remark boundSubFormulaHelp :
forall (f : fol.Formula L) (v : nat) (s : fol.Term L),
codeFormula (substituteFormula L f v s) <=
ReplaceFormulaTerm (codeFormula f)
(max (codeTerm s)
(pow3 (depth L f) +
fold_right max 0 (v :: freeVarTerm L s ++ varFormula f))).
Definition boundComputation (d p1 p2 : nat) : nat :=
nat_rec (fun _ => nat) (cTriple p1 p2 0)
(fun _ rec : nat => cTriple p1 p2 (cPair rec rec)) d.

Lemma boundComputationMonotone :
forall a1 a2 b1 b2 c1 c2 : nat,
a1 <= a2 ->
b1 <= b2 ->
c1 <= c2 -> boundComputation a1 b1 c1 <= boundComputation a2 b2 c2.