From LogRel.AutoSubst Require Import core unscoped Ast Extra.
From LogRel Require Import Utils BasicAst Notations Context NormalForms Weakening GenericTyping LogicalRelation DeclarativeInstance Validity.
From LogRel.LogicalRelation Require Import Induction Irrelevance Escape Reflexivity Weakening Neutral Transitivity.
From LogRel.Substitution Require Import Irrelevance Properties Conversion.

Set Universe Polymorphism.

Section SingleSubst.
Context `{GenericTypingProperties}.

Set Printing Primitive Projection Parameters.

Lemma singleSubstComm G t σ : G[t..][σ] = G[t[σ] .: σ].
Proof. now asimpl. Qed.

Lemma substS {Γ F G t l} {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  (VG : [Γ,, F ||-v<l> G | validSnoc VΓ VF])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF]) :
  [Γ ||-v<l> G[t..] | VΓ].
Proof.
  opector; intros; rewrite singleSubstComm.
  - unshelve eapply validTy. 3,4:  tea.
    now eapply consSubstSvalid.
  - irrelevance0. 1: symmetry; apply singleSubstComm.
    eapply validTyExt.
    1: eapply consSubstS; now  eapply validTm.
    now eapply consSubstSEqvalid.
    Unshelve. all: eassumption.
Qed.

Lemma substSEq {Γ F F' G G' t t' l} {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  {VF' : [Γ ||-v<l> F' | VΓ]}
  (VFF' : [Γ ||-v<l> F ≅ F' | VΓ | VF])
  (VΓF := validSnoc VΓ VF)
  (VΓF' := validSnoc VΓ VF')
  {VG : [Γ,, F ||-v<l> G | VΓF]}
  (VG' : [Γ,, F' ||-v<l> G' | VΓF'])
  (VGG' : [Γ ,, F ||-v<l> G ≅ G' | VΓF | VG])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF])
  (Vt' : [Γ ||-v<l> t' : F' | VΓ | VF'])
  (Vtt' : [Γ ||-v<l> t ≅ t' : F | VΓ | VF])
  (VGt := substS VG Vt) :
  [Γ ||-v<l> G[t..] ≅ G'[t'..] | VΓ | VGt].
Proof.
  constructor; intros.
  assert (VtF' : [Γ ||-v<l> t : F' | VΓ | VF']) by now eapply conv.
  pose proof (consSubstSvalid _ _ Vσ _ Vt').
  pose proof (consSubstSvalid _ _ Vσ _ VtF').
  rewrite singleSubstComm; irrelevance0.
  1: symmetry; apply singleSubstComm.
  eapply transEq.
  - unshelve now eapply validTyEq.
    2: now eapply consSubstSvalid.
  - eapply validTyExt; tea.
    unshelve econstructor.
    1: eapply reflSubst.
    eapply validTmEq.
    now eapply convEq.
    Unshelve. all: tea.
    now eapply validTy.
Qed.

Lemma substSTm {Γ F G t f l} {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  (VΓF := validSnoc VΓ VF)
  {VG : [Γ,, F ||-v<l> G | VΓF]}
  (Vt : [Γ ||-v<l> t : F | VΓ | VF])
  (Vf : [Γ ,, F ||-v<l> f : G | VΓF | VG])
  (VGt := substS VG Vt) :
  [Γ ||-v<l> f[t..] : G[t..] | VΓ | VGt].
Proof.
  constructor; intros; rewrite !singleSubstComm; irrelevance0.
  1,3: symmetry; apply singleSubstComm.
  - now eapply validTm.
  - eapply validTmExt; tea.
    1: now apply consSubstSvalid.
    now apply consSubstSEqvalid.
    Unshelve. 1,3: eassumption.
    now apply consSubstSvalid.
Qed.

Lemma substSTmEq {Γ F F' G G' t t' f f' l} (VΓ : [||-v Γ])
  (VF : [Γ ||-v<l> F | VΓ])
  (VF' : [Γ ||-v<l> F' | VΓ])
  (VFF' : [Γ ||-v<l> F ≅ F' | VΓ | VF])
  (VΓF := validSnoc VΓ VF)
  (VΓF' := validSnoc VΓ VF')
  (VG : [Γ,, F ||-v<l> G | VΓF])
  (VG' : [Γ,, F' ||-v<l> G' | VΓF'])
  (VGG' : [Γ ,, F ||-v<l> G ≅ G' | VΓF | VG])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF])
  (Vt' : [Γ ||-v<l> t' : F' | VΓ | VF'])
  (Vtt' : [Γ ||-v<l> t ≅ t' : F | VΓ | VF])
  (Vf : [Γ ,, F ||-v<l> f : G | VΓF | VG])
  (Vf' : [Γ ,, F' ||-v<l> f' : G' | VΓF' | VG'])
  (Vff' : [Γ ,, F ||-v<l> f ≅ f' : G | VΓF | VG]) :
  [Γ ||-v<l> f[t..] ≅ f'[t'..] : G[t..] | VΓ | substS VG Vt].
Proof.
  constructor; intros; rewrite !singleSubstComm; irrelevance0.
  1: symmetry; apply singleSubstComm.
  eapply transEqTerm.
  + unshelve now eapply validTmEq.
    2: now eapply consSubstSvalid.
  + assert (Vσt : [Δ ||-v (t[σ] .: σ) : _ | VΓF' | wfΔ])
     by (eapply consValid; tea; now eapply conv).
    assert (Vσt' : [Δ ||-v (t'[σ] .: σ) : _ | VΓF' | wfΔ])
     by (eapply consValid; tea; now eapply conv).
    assert (Vσtσt' : [Δ ||-v (t[σ] .: σ) ≅ (t'[σ] .: σ) : _ | VΓF' | wfΔ | Vσt]).
    1:{
      constructor.
      - bsimpl; epose (reflSubst _  _ Vσ); now eapply irrelevanceSubstEq.
      - bsimpl; eapply validTmEq. now eapply convEq.
    }
    eapply LRTmEqRedConv.
    2: eapply (validTmExt Vf' _ Vσt Vσt' Vσtσt').
    eapply LRTyEqSym. now eapply validTyEq.
    Unshelve. 2: now eapply consValid.
Qed.

(* Skipping a series of lemmas on single substitution of a weakened term *)

Lemma liftSubstComm G t σ : G[t]⇑[σ] = G[t[σ] .: ↑ >> σ].
Proof. now bsimpl. Qed.

Lemma substLiftS {Γ F G t l} (VΓ : [||-v Γ])
  (VF : [Γ ||-v<l> F | VΓ])
  (VΓF := validSnoc VΓ VF)
  (VG : [Γ,, F ||-v<l> G | VΓF])
  (VF' := wk1ValidTy VF VF)
  (Vt : [Γ,, F ||-v<l> t : F⟨@wk1 Γ F⟩ | VΓF | VF']) :
  [Γ ,, F ||-v<l> G[t]⇑ | VΓF].
Proof.
  assert (h : forall Δ σ (wfΔ: [|- Δ])
    (vσ: [VΓF | Δ ||-v σ : Γ,, F | wfΔ]),
    [VΓF | Δ ||-v (t[σ] .: ↑ >> σ) : _ | wfΔ ]).
  1:{
    unshelve econstructor.
    + asimpl; now eapply validTail.
    + cbn. irrelevance0.
      2: now eapply validTm.
      now bsimpl.
  }
  opector; intros; rewrite liftSubstComm.
  - unshelve eapply validTy; cycle 2; tea; now eapply h.
  - irrelevance0.
    2: unshelve eapply validTyExt.
    8: now eapply h.
    4: now eapply (h _ _  _ vσ).
    1: now bsimpl.
    1: tea.
    constructor.
    + asimpl; eapply irrelevanceSubstEq; now eapply eqTail.
    + cbn. irrelevance0.
      2: now eapply validTmExt.
      now bsimpl.
      Unshelve. all:tea.
Qed.

Lemma substLiftSEq {Γ F G G' t l} (VΓ : [||-v Γ])
  (VF : [Γ ||-v<l> F | VΓ])
  (VΓF := validSnoc VΓ VF)
  (VG : [Γ,, F ||-v<l> G | VΓF])
  (VG' : [Γ,, F ||-v<l> G' | VΓF])
  (VGeq : [Γ,, F ||-v<l> G ≅ G' | VΓF | VG])
  (VF' := wk1ValidTy VF VF)
  (Vt : [Γ,, F ||-v<l> t : F⟨@wk1 Γ F⟩ | VΓF | VF']) :
  [Γ ,, F ||-v<l> G[t]⇑ ≅ G'[t]⇑ | VΓF | substLiftS _ VF VG Vt].
Proof.
  constructor; intros; rewrite liftSubstComm.
  assert (Vσt : [Δ ||-v (t[σ] .: ↑ >> σ) : _ | VΓF | wfΔ ]). 1:{
    unshelve econstructor.
    + bsimpl. now eapply validTail.
    + bsimpl. instValid Vσ. irrelevance.
  }
  instValid Vσt. irrelevance.
Qed.

Lemma singleSubstΠ1 {Γ F G t l lF}
  (ΠFG : [Γ ||-<l> tProd F G])
  {RF : [Γ ||-<lF> F]}
  (Rt : [Γ ||-<lF> t : F | RF]) :
  [Γ ||-<l> G[t..]].
Proof.
  apply invLRΠ in ΠFG; destruct ΠFG as [?? red ??? domRed codRed].
  unshelve eassert (h :=redtywf_whnf red _).
  1: constructor.
  symmetry in h; injection h; clear h; intros ;  subst.
  replace G[t..] with G[t .: wk_id (Γ:=Γ) >> tRel] by now bsimpl.
  unshelve eapply codRed.
  1: gen_typing.
  irrelevance0; tea.
  now bsimpl.
Qed.

Lemma singleSubstΠ2 {Γ F F' G G' t t' l lF lF'}
  {ΠFG : [Γ ||-<l> tProd F G]}
  (ΠFGeq : [Γ ||-<l> tProd F G ≅ tProd F' G' | ΠFG])
  {RF : [Γ ||-<lF> F]}
  {RF' : [Γ ||-<lF'> F']}
  (Rt : [Γ ||-<lF> t : F | RF])
  (Rt' : [Γ ||-<lF'> t' : F' | RF'])
  (Rteq : [Γ ||-<lF> t ≅ t' : F | RF])
  (RGt : [Γ ||-<lF> G[t..]])
  (RGt' : [Γ ||-<lF'> G'[t'..]]) :
  [Γ ||-<lF> G[t..] ≅ G'[t'..] | RGt ].
Proof.
  pose (hΠ := invLRΠ ΠFG).
  assert (heq : [Γ ||-<l> tProd F G ≅ tProd F' G' | LRPi' hΠ]) by irrelevance.
  destruct hΠ as [?? red ??? domRed codRed codExt]; clear ΠFG ΠFGeq.
  assert (wfΓ : [|-Γ]) by gen_typing.
  destruct heq as [?? red' ? domRedEq codRedEq]; cbn in *.
  unshelve eassert (h :=redtywf_whnf red _).  1: constructor.
  unshelve eassert (h' :=redtywf_whnf red' _).  1: constructor.
  symmetry in h; symmetry in h' ; injection h; injection h'; clear h h'; intros ;  subst.
  assert [Γ ||-<l> t' : F⟨wk_id (Γ:=Γ)⟩ | domRed Γ wk_id wfΓ].
  {
    eapply LRTmRedConv; tea.
    eapply LRTyEqSym.
    replace F' with F'⟨wk_id (Γ := Γ)⟩ by now bsimpl.
    eapply domRedEq.
  }
  eapply transEq.
  2: (replace G'[t'..] with G'[t' .: wk_id (Γ:=Γ) >> tRel] by now bsimpl); eapply codRedEq.
  irrelevance0.
  2: eapply codExt.
  3: irrelevance0; tea; now bsimpl.
  1: now bsimpl.
  eassumption.
  Unshelve. all: tea.
  irrelevance0; tea; now bsimpl.
Qed.

Lemma substSΠaux {Γ F G t l}
  {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  (VΠFG : [Γ ||-v<l> tProd F G | VΓ])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF])
  (Δ : context) (σ : nat -> term)
  (wfΔ : [ |-[ ta ] Δ]) (vσ : [VΓ | Δ ||-v σ : Γ | wfΔ]) :
  [Δ ||-< l > G[up_term_term σ][t[σ]..]].
Proof.
  eapply singleSubstΠ1.
  eapply (validTy VΠFG); tea.
  now eapply validTm.
  Unshelve. all: eassumption.
Qed.

Lemma singleSubstComm' G t σ : G[t..][σ] = G[up_term_term σ][t[σ]..].
Proof. now asimpl. Qed.

Lemma substSΠ {Γ F G t l}
  {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  (VΠFG : [Γ ||-v<l> tProd F G | VΓ])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF]) :
  [Γ ||-v<l> G[t..] | VΓ].
Proof.
  opector; intros.
  - rewrite singleSubstComm'; now eapply substSΠaux.
  - rewrite singleSubstComm'.
    irrelevance0. 1: symmetry; apply singleSubstComm'.
    eapply singleSubstΠ2.
    1: eapply (validTyExt VΠFG).
    1, 2: tea.
    1, 2: now eapply validTm.
    1: now eapply validTmExt.
    now eapply substSΠaux.
    Unshelve. all: tea.
    now eapply substSΠaux.
Qed.

Lemma substSΠeq {Γ F F' G G' t u l}
  {VΓ : [||-v Γ]}
  {VF : [Γ ||-v<l> F | VΓ]}
  {VF' : [Γ ||-v<l> F' | VΓ]}
  {VΠFG : [Γ ||-v<l> tProd F G | VΓ]}
  (VΠFG' : [Γ ||-v<l> tProd F' G' | VΓ])
  (VΠFGeq : [Γ ||-v<l> tProd F G ≅ tProd F' G' | VΓ | VΠFG])
  (Vt : [Γ ||-v<l> t : F | VΓ | VF])
  (Vu : [Γ ||-v<l> u : F' | VΓ | VF'])
  (Vtu : [Γ ||-v<l> t ≅ u : F | VΓ | VF])
  (VGt := substSΠ VΠFG Vt) :
  [Γ ||-v<l> G[t..] ≅ G'[u..] | VΓ | VGt].
Proof.
  constructor; intros.
  rewrite singleSubstComm'.
  irrelevance0.
  1: symmetry; apply singleSubstComm'.
  eapply singleSubstΠ2.
  1: now eapply (validTyEq VΠFGeq).
  3: now eapply validTmEq.
  1,2: now eapply validTm.
  now eapply substSΠaux.
  Unshelve. all: tea.
  now eapply substSΠaux.
Qed.

End SingleSubst.


Set Implicit Arguments.

Section TotalMap.

  Variable K V : Type.
  Variable eqK : K -> K -> bool.
  Notation "i '==' j" := (eqK i j) (at level 80, right associativity).

  Definition totalMap := K -> V.

  Definition emptyTMap (v : V) : totalMap := fun _ => v.

  Definition updateTMap (m : totalMap) (k : K) (v : V) :=
    fun k' => if k == k' then v else m k'.

End TotalMap.

Section PartialMap.

  Variable K V : Type.
  Variable eqK : K -> K -> bool.

  Definition partialMap := totalMap K (option V).

  Definition emptyPMap : partialMap := emptyTMap None.

  Definition updatePMap (m : partialMap) (k : K) (v : V) :=
    updateTMap eqK m k (Some v).

End PartialMap.

Section ListMap.

  Variable K V : Type.
  Variable eqK : K -> K -> bool.
  Notation "i '==' j" := (eqK i j) (at level 80, right associativity).

  Definition listMap := list (K * V).

  Definition add (kvs : listMap) (k : K) (v : V) : listMap :=
    cons (k,v) kvs.

  Fixpoint update (kvs : listMap) (k : K) (v : V) : listMap :=
    match kvs with
    | nil               => cons (k,v) nil
    | cons (k',v') kvs' => if (k' == k) then cons (k',v) kvs'
                          else cons (k',v') (update kvs' k v)
    end.

  Fixpoint lookup (kvs : listMap) (k : K) : option V :=
    match kvs with
    | nil              => None
    | cons (k',v) kvs' => if (k' == k) then Some v
                         else lookup kvs' k
    end.

  Definition union (kvs1 kvs2 : listMap) : listMap := app kvs1 kvs2.

End ListMap.

Section Properties.

  Lemma lookup_deterministic :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : listMap A B) (k : A) (v1 v2 : option B),
      lookup eqA Sigma k = v1 ->
      lookup eqA Sigma k = v2 ->
      v1 = v2.
  Proof.
    intros.
    rewrite H in H0.
    apply H0.
  Qed.

  Lemma lookupT_deterministic :
    forall (A B : Type) (Sigma : totalMap A B) (k : A) (v1 v2 : B),
      Sigma k = v1 ->
      Sigma k = v2 ->
      v1 = v2.
  Proof.
    intros.
    rewrite H in H0.
    apply H0.
  Qed.

  Lemma lookupP_deterministic :
    forall (A B : Type) (Sigma : partialMap A B) (k : A) (v1 v2 : option B),
      Sigma k = v1 ->
      Sigma k = v2 ->
      v1 = v2.
  Proof.
    intros.
    rewrite H in H0.
    apply H0.
  Qed.

  Lemma update_lookupT1 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : totalMap A B) (k : A) (v : B),
      (forall x : A, eqA x x = true) ->
      (updateTMap eqA Sigma k v) k = v.
  Proof.
    intros.
    unfold updateTMap.
    rewrite (H k).
    reflexivity.
  Qed.

  Lemma update_lookupT2 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : totalMap A B) (k1 k2 : A) (v1 v2 : B),
      eqA k2 k1 = false ->
      (updateTMap eqA Sigma k2 v2) k1 = Sigma k1.
  Proof.
    intros.
    unfold updateTMap.
    rewrite H.
    reflexivity.
  Qed.

  Lemma add_lookupL1 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : listMap A B) (k : A) (v : B),
      (forall x : A, eqA x x = true) ->
      lookup eqA (add Sigma k v) k = Some v.
  Proof.
    intros.
    unfold add.
    simpl lookup.
    rewrite (H k).
    reflexivity.
  Qed.

  Lemma add_lookupL2 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : listMap A B) (k1 k2 : A) (v  : B),
      eqA k2 k1 = false ->
      lookup eqA (add Sigma k2 v) k1 = lookup eqA Sigma k1.
  Proof.
    intros.
    unfold add.
    simpl lookup.
    rewrite H.
    reflexivity.
  Qed.

  Lemma update_lookup1 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : listMap A B) (k : A) (v : B),
      (forall x : A, eqA x x = true) ->
      lookup eqA (update eqA Sigma k v) k = Some v.
  Proof.
    intros.
    induction Sigma; simpl.
    - rewrite (H k).
      reflexivity.
    - destruct a as [k' v'].
      destruct (eqA k' k) eqn:HeqKK.
      + simpl lookup.
        rewrite HeqKK.
        reflexivity.
      + simpl lookup.
        rewrite HeqKK.
        apply IHSigma.
  Qed.

  Lemma update_lookup2 :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma : listMap A B) (k1 k2 : A) (v : B),
      (forall x y z : A, eqA x y = eqA x z -> true = eqA y z) ->
      eqA k2 k1 = false ->
      lookup eqA (update eqA Sigma k2 v) k1 = lookup eqA Sigma k1.
  Proof.
    intros.
    induction Sigma; simpl.
    - rewrite H0.
      reflexivity.
    - destruct a as [k' v'].
      destruct (eqA k' k2) eqn:HeqKK2.
      + simpl lookup.
        destruct (eqA k' k1) eqn:HeqKK1.
        * rewrite <- HeqKK1 in HeqKK2.
          specialize (H k' k2 k1 HeqKK2).
          congruence.
        * reflexivity.
      + simpl lookup.
        destruct (eqA k' k1) eqn:HeqKK1.
        * reflexivity.
        * apply IHSigma.
  Qed.

  Lemma union_lookup :
    forall (A B : Type) (eqA : A -> A -> bool) (Sigma Delta : listMap A B) (k : A),
      lookup eqA Delta k = None ->
      lookup eqA (union Delta Sigma ) k = lookup eqA Sigma k.
  Proof.
    intros.
    induction Delta; simpl.
    - reflexivity.
    - destruct a as [k0 v].
      inversion H.
      destruct (eqA k0 k).
      + inversion H1.
      + apply IHDelta.
        apply H1.
  Qed.

End Properties.


From Coq Require Import List.
Import List.ListNotations.
Open Scope list_scope.
From Coq Require Import Sorting.Permutation.

From Coq Require Import FSets.FMapPositive.
From Velus Require Import Common.
From Velus Require Import Environment.
From Velus Require Import Operators.
From Velus Require Import Clocks.
From Velus Require Import CoreExpr.CESyntax.
From Velus Require Import IndexedStreams.
From Velus Require Import CoreExpr.CESemantics.

(** * Interpreter for Core Expresssions *)

Module Type CEINTERPRETER
       (Import Ids   : IDS)
       (Import Op    : OPERATORS)
       (Import OpAux : OPERATORS_AUX   Op)
       (Import CESyn : CESYNTAX        Op)
       (Import Str   : INDEXEDSTREAMS  Op OpAux)
       (Import CESem : CESEMANTICS Ids Op OpAux CESyn Str).

  (** ** Instantaneous semantics *)

  Section InstantInterpreter.

    Variable base : bool.
    Variable R: env.

    Definition interp_vars_instant (xs: list ident): list value :=
      map (interp_var_instant R) xs.

     Fixpoint interp_exp_instant (e: exp): value :=
      match e with
      | Econst c =>
        if base then present (sem_const c) else absent
      | Evar x _ =>
        interp_var_instant R x
      | Ewhen e x b =>
        match interp_var_instant R x, interp_exp_instant e with
        | present xv, present ev =>
          match val_to_bool xv with
          | Some b' => if b ==b b' then present ev else absent
          | None => absent
          end
        | _, _ => absent
        end
      | Eunop op e _ =>
        match interp_exp_instant e with
        | present v =>
          match sem_unop op v (typeof e) with
          | Some v' => present v'
          | None => absent
          end
        | absent => absent
        end
      | Ebinop op e1 e2 _ =>
        match interp_exp_instant e1, interp_exp_instant e2 with
        | present v1, present v2 =>
          match sem_binop op v1 (typeof e1) v2 (typeof e2) with
          | Some v => present v
          | None => absent
          end
        | _, _ => absent
        end
      end.

    Definition interp_exps_instant (les: list exp): list value :=
      map interp_exp_instant les.

    Fixpoint interp_cexp_instant (e: cexp): value :=
      match e with
      | Emerge x t f =>
        match interp_var_instant R x, interp_cexp_instant t, interp_cexp_instant f with
        | present xv, present tv, absent =>
          if xv ==b true_val then present tv else absent
        | present xv, absent, present fv =>
          if xv ==b false_val then present fv else absent
        | _, _, _ => absent
        end

      | Eite b t f =>
        match interp_exp_instant b, interp_cexp_instant t, interp_cexp_instant f with
        | present bv, present tv, present fv =>
          match val_to_bool bv with
          | Some b' => present (if b' then tv else fv)
          | None => absent
          end
        | _, _, _ => absent
        end

      | Eexp e =>
        interp_exp_instant e
      end.

    Ltac rw_exp_helper :=
      repeat match goal with
             | _: sem_var_instant R ?x ?v |- context[interp_var_instant ?R ?x] =>
               erewrite <-(interp_var_instant_sound R x v); eauto; simpl
             | H: val_to_bool ?x = _ |- context[val_to_bool ?x] =>
               rewrite H
             | H: sem_unop ?op ?c ?t = _ |- context[sem_unop ?op ?c ?t] =>
               rewrite H
             | H: sem_binop ?op ?c1 ?t1 ?c2 ?t2 = _ |- context[sem_binop ?op ?c1 ?t1 ?c2 ?t2] =>
               rewrite H
          end.

    Lemma interp_vars_instant_sound:
      forall xs vs,
        sem_vars_instant R xs vs ->
        vs = interp_vars_instant xs.
    Proof.
      unfold sem_vars_instant, interp_vars_instant.
      induction 1; auto; simpl; rw_exp_helper; f_equal; auto.
    Qed.

    Lemma interp_exp_instant_sound:
      forall e v,
        sem_exp_instant base R e v ->
        v = interp_exp_instant e.
    Proof.
      induction 1; simpl;
        try rewrite <-IHsem_exp_instant;
        try rewrite <-IHsem_exp_instant1;
        try rewrite <-IHsem_exp_instant2;
        rw_exp_helper; auto;
          destruct b; auto.
    Qed.

    Lemma interp_exps_instant_sound:
      forall es vs,
        sem_exps_instant base R es vs ->
        vs = interp_exps_instant es.
    Proof.
      induction 1; simpl; auto.
      f_equal; auto.
      now apply interp_exp_instant_sound.
    Qed.

    Ltac rw_cexp_helper :=
      repeat (rw_exp_helper;
              repeat match goal with
                     | _: sem_exp_instant base R ?e ?v |- context[interp_exp_instant ?e] =>
                       erewrite <-(interp_exp_instant_sound e v); eauto; simpl
                     end).

    Lemma interp_cexp_instant_sound:
      forall e v,
        sem_cexp_instant base R e v ->
        v = interp_cexp_instant e.
    Proof.
      induction 1; simpl;
        try rewrite <-IHsem_cexp_instant;
        try rewrite <-IHsem_cexp_instant1;
        try rewrite <-IHsem_cexp_instant2;
        rw_cexp_helper;
        try rewrite equiv_decb_refl; auto;
          destruct b; auto.
    Qed.

    Definition interp_annotated_instant {A} (interp: A -> value) (ck: clock) (a: A): value :=
      if interp_clock_instant base R ck then
        interp a
      else
        absent.

    Definition interp_caexp_instant (ck: clock) (ce: cexp) : value :=
      interp_annotated_instant (interp_cexp_instant) ck ce.

    Lemma interp_caexp_instant_sound:
      forall ck e v,
        sem_caexp_instant base R ck e v ->
        v = interp_caexp_instant ck e.
    Proof.
      unfold interp_caexp_instant, interp_annotated_instant.
      induction 1; erewrite <-interp_clock_instant_sound; eauto; simpl; auto.
      apply interp_cexp_instant_sound; auto.
    Qed.

    Definition interp_aexp_instant (ck: clock) (e: exp) : value :=
      interp_annotated_instant (interp_exp_instant) ck e.

    Lemma interp_aexp_instant_sound:
      forall ck e v,
        sem_aexp_instant base R ck e v ->
        v = interp_aexp_instant ck e.
    Proof.
      unfold interp_aexp_instant, interp_annotated_instant.
      induction 1; erewrite <-interp_clock_instant_sound; eauto; simpl; auto.
      apply interp_exp_instant_sound; auto.
    Qed.

  End InstantInterpreter.

  (** ** Liftings of instantaneous semantics *)

  Section LiftInterpreter.

    Variable bk : stream bool.
    Variable H: history.

    Definition interp_vars (xs: list ident): stream (list value) :=
      lift_interp' H interp_vars_instant xs.

    Definition interp_exp (e: exp): stream value :=
      lift_interp bk H interp_exp_instant e.

    Definition interp_exps (e: list exp): stream (list value) :=
      lift_interp bk H interp_exps_instant e.

    Definition interp_exps' (e: list exp): list (stream value) :=
      map interp_exp e.

    Lemma interp_exps'_sound:
      forall es ess,
        sem_exps bk H es ess ->
        Forall2 (sem_exp bk H) es (interp_exps' es).
    Proof.
      induction es; intros * Sem; simpl; auto.
      constructor.
      - intro n; specialize (Sem n); inv Sem.
        unfold interp_exp, lift_interp.
        erewrite <-interp_exp_instant_sound; eauto.
      - eapply IHes.
        intro n; specialize (Sem n); inv Sem.
        instantiate (1 := fun n => tl (ess n)).
        simpl.
        rewrite <-H2; simpl; auto.
    Qed.

    Definition interp_cexp (e: cexp): stream value :=
      lift_interp bk H interp_cexp_instant e.

    Definition interp_caexp (ck: clock) (e: cexp): stream value :=
      lift_interp bk H (fun base R => interp_caexp_instant base R ck) e.

    Definition interp_aexp (ck: clock) (e: exp): stream value :=
      lift_interp bk H (fun base R => interp_aexp_instant base R ck) e.

    Corollary interp_vars_sound:
      forall xs vss,
        sem_vars H xs vss ->
        vss ≈ interp_vars xs.
    Proof.
      intros; eapply lift'_sound; eauto;
        apply interp_vars_instant_sound.
    Qed.

    Corollary interp_exp_sound:
      forall e vs,
        sem_exp bk H e vs ->
        vs ≈ interp_exp e.
    Proof.
      intros; eapply lift_sound; eauto;
        apply interp_exp_instant_sound.
    Qed.

    Corollary interp_exps_sound:
      forall es vss,
        sem_exps bk H es vss ->
        vss ≈ interp_exps es.
    Proof.
      intros; eapply lift_sound; eauto;
        apply interp_exps_instant_sound.
    Qed.

    Corollary interp_cexp_sound:
      forall e vs,
        sem_cexp bk H e vs ->
        vs ≈ interp_cexp e.
    Proof.
      intros; eapply lift_sound; eauto;
        apply interp_cexp_instant_sound.
    Qed.

    Corollary interp_aexp_sound:
      forall e ck vs,
        sem_aexp bk H ck e vs ->
        vs ≈ interp_aexp ck e.
    Proof.
      intros; eapply lift_sound; eauto.
      intros; apply interp_aexp_instant_sound; auto.
    Qed.

    Corollary interp_caexp_sound:
      forall e ck vs,
        sem_caexp bk H ck e vs ->
        vs ≈ interp_caexp ck e.
    Proof.
      intros; eapply lift_sound; eauto.
      intros; apply interp_caexp_instant_sound; auto.
    Qed.
    (* Definition interp_annotated {A} (interp_instant: bool -> env -> A -> value) (ck: clock) (a: A): stream value := *)
    (*   lift (fun base R => interp_annotated_instant base R interp_instant ck) a. *)

  End LiftInterpreter.

End CEINTERPRETER.

Module CEInterpreterFun
       (Import Ids   : IDS)
       (Import Op    : OPERATORS)
       (Import OpAux : OPERATORS_AUX   Op)
       (Import CESyn : CESYNTAX        Op)
       (Import Str   : INDEXEDSTREAMS  Op OpAux)
       (Import CESem : CESEMANTICS Ids Op OpAux CESyn Str)
       <: CEINTERPRETER Ids Op OpAux CESyn Str CESem.
  Include CEINTERPRETER Ids Op OpAux CESyn Str CESem.
End CEInterpreterFun.


From Coq Require Import Ensembles.
From Coq Require Import List.
From hydras.Ackermann Require Import checkPrf.
From hydras.Ackermann Require Import code.
From hydras.Ackermann Require Import Languages.
From hydras.Ackermann Require Import folProp.
From hydras.Ackermann Require Import folProof.
From hydras.Ackermann Require Import folLogic3.
From hydras.Ackermann Require Import folReplace.
From Goedel Require Import PRrepresentable.
From hydras.Ackermann Require Import expressible.
From hydras.Ackermann Require Import primRec.
From Coq Require Import Arith.
From hydras.Ackermann Require Import PA.
From hydras.Ackermann Require Import NNtheory.
From hydras.Ackermann Require Import codeList.
From hydras.Ackermann Require Import subProp.
From hydras.Ackermann Require Import ListExt.
From hydras.Ackermann Require Import cPair.
From hydras.Ackermann Require Import wellFormed.
From hydras.Ackermann Require Import prLogic.

Ltac SimplFreeVar :=
  repeat
   match goal with
   | H1:(?X1 = ?X2),H2:(?X1 <> ?X2) |- _ =>
       elim H2; apply H1
   | H1:(?X1 = ?X2),H2:(?X2 <> ?X1) |- _ =>
       elim H2; symmetry  in |- *; apply H1
   | H1:(?X1 <> ?X1) |- _ =>
       elim H1; reflexivity
   | H:(In ?X3 (freeVarFormula ?X9 (existH ?X1 ?X2))) |- _ =>
       assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula X9 X2)));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.existH ?X9 ?X1 ?X2))) |- _ =>
       assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula X9 X2)));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (forallH ?X1 ?X2))) |- _ =>
       assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula X9 X2)));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.forallH ?X9 ?X1 ?X2))) |- _ =>
       assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula X9 X2)));
        [ apply H | clear H ]
   | H:(In ?X3 (list_remove nat eq_nat_dec ?X1 (freeVarFormula ?X9 ?X2))) |-
   _ =>
       assert (In X3 (freeVarFormula X9 X2));
        [ eapply In_list_remove1; apply H
        | assert (X3 <> X1); [ eapply In_list_remove2; apply H | clear H ] ]
   | H:(In ?X3 (freeVarFormula ?X9 (andH ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.andH ?X9 ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (orH ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.orH ?X9 ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (impH ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.impH ?X9 ?X1 ?X2))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1 ++ freeVarFormula X9 X2));
        [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (notH ?X1))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1)); [ apply H | clear H ]
   | H:(In ?X3 (freeVarFormula ?X9 (fol.notH ?X9 ?X1))) |- _ =>
       assert (In X3 (freeVarFormula X9 X1)); [ apply H | clear H ]
   | H:(In _ (_ ++ _)) |- _ =>
       induction (in_app_or _ _ _ H); clear H
   | H:(In _ (freeVarFormula ?X9 (substituteFormula ?X9 ?X1 ?X2 ?X3))) |- _
   =>
       induction (freeVarSubFormula3 _ _ _ _ _ H); clear H
   | H:(In _ (freeVarFormula ?X9 (LT ?X1 ?X2))) |- _ =>
       rewrite freeVarLT in H
   | H:(In _ (freeVarTerm ?X9 (LNT.natToTerm _))) |- _ =>
       elim (LNT.closedNatToTerm _ _ H)
   | H:(In _ (freeVarTerm ?X9 (natToTerm _))) |- _ =>
       elim (closedNatToTerm _ _ H)
   | H:(In _ (freeVarTerm ?X9 Zero)) |- _ =>
       elim H
   | H:(In _ (freeVarTerm ?X9 (Succ _))) |- _ =>
       rewrite freeVarSucc in H
   | H:(In _ (freeVarTerm ?X9 (var _))) |- _ =>
       simpl in H; decompose sum H; clear H
   | H:(In _ (freeVarTerm ?X9 (LNT.var _))) |- _ =>
       simpl in H; decompose sum H; clear H
   | H:(In _ (freeVarTerm ?X9 (fol.var ?X9 _))) |- _ =>
       simpl in H; decompose sum H; clear H
   end.

Section code_SysPrf.

Variable L : Language.
Variable codeF : Functions L -> nat.
Variable codeR : Relations L -> nat.
Variable codeArityF : nat -> nat.
Variable codeArityR : nat -> nat.
Hypothesis codeArityFIsPR : isPR 1 codeArityF.
Hypothesis
  codeArityFIsCorrect1 :
    forall f : Functions L, codeArityF (codeF f) = S (arity L (inr _ f)).
Hypothesis
  codeArityFIsCorrect2 :
    forall n : nat, codeArityF n <> 0 -> exists f : Functions L, codeF f = n.
Hypothesis codeArityRIsPR : isPR 1 codeArityR.
Hypothesis
  codeArityRIsCorrect1 :
    forall r : Relations L, codeArityR (codeR r) = S (arity L (inl _ r)).
Hypothesis
  codeArityRIsCorrect2 :
    forall n : nat, codeArityR n <> 0 -> exists r : Relations L, codeR r = n.

Hypothesis codeFInj : forall f g : Functions L, codeF f = codeF g -> f = g.
Hypothesis codeRInj : forall R S : Relations L, codeR R = codeR S -> R = S.

Section LNN.

Variable T : System.
Hypothesis TextendsNN : Included _ NN T.
Variable U : fol.System L.
Variable fU : Formula.
Variable v0 : nat.
Hypothesis freeVarfU : forall v : nat, In v (freeVarFormula LNN fU) -> v = v0.
Hypothesis
  expressU1 :
    forall f : fol.Formula L,
    mem _ U f ->
    SysPrf T
      (substituteFormula LNN fU v0 (natToTerm (codeFormula L codeF codeR f))).
Hypothesis
  expressU2 :
    forall f : fol.Formula L,
    ~ mem _ U f ->
    SysPrf T
      (notH
         (substituteFormula LNN fU v0
            (natToTerm (codeFormula L codeF codeR f)))).

Definition codeSysPrf : Formula :=
  let nv := newVar (2 :: 1 :: 0 :: v0 :: nil) in
  existH nv
    (andH
       (substituteFormula LNN
          (substituteFormula LNN
             (primRecFormula 2
                (proj1_sig
                   (checkPrfIsPR L codeF codeR codeArityF codeArityR
                      codeArityFIsPR codeArityRIsPR))) 0
             (Succ (var nv))) 2 (var 0))
       (forallH (S nv)
          (impH (LT (var (S nv)) (var nv))
             (orH
                (substituteFormula LNN
                   (substituteFormula LNN
                      (substituteFormula LNN
                         (primRecFormula 2 (proj1_sig codeInIsPR)) 2
                         (var (S nv))) 1 (var nv)) 0 Zero)
                (substituteFormula LNN fU v0 (var (S nv))))))).

Lemma codeSysPrfCorrect1 :
 forall (f : fol.Formula L) (A : list (fol.Formula L)) (p : Prf L A f),
 (forall g : fol.Formula L, In g A -> mem _ U g) ->
 SysPrf T
   (substituteFormula LNN
      (substituteFormula LNN codeSysPrf 0
         (natToTerm (codeFormula L codeF codeR f))) 1
      (natToTerm (codePrf L codeF codeR A f p))).
Proof.
intros.
unfold codeSysPrf in |- *.
set (nvl := 2 :: 1 :: 0 :: v0 :: nil) in *.
set (nv := newVar nvl) in *.
assert (nv <> 0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H0; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 1).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H1; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 2).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H2; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> v0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H3; unfold nvl in |- *.
simpl in |- *; auto.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 0).
elim H0; assumption.
induction
 (In_dec eq_nat_dec nv
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 1).
elim H1; assumption.
induction
 (In_dec eq_nat_dec nv
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A f p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
apply existI with (natToTerm (codeList (map (codeFormula L codeF codeR) A))).
repeat rewrite (subFormulaAnd LNN).
apply andI.
apply sysExtend with NN.
apply TextendsNN.
set
 (B :=
  primRecFormula 2
    (proj1_sig
       (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
          codeArityRIsPR))) in *.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN B 0 (Succ (var nv)))
             2 (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm (codePrf L codeF codeR A f p))) nv
       (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
apply iffE2.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert
 (In 0 (freeVarFormula LNN (substituteFormula LNN B 0 (Succ (var nv))))).
eapply In_list_remove1.
apply H4.
induction (freeVarSubFormula3 _ _ _ _ _ H5).
elim (In_list_remove2 _ _ _ _ _ H6).
reflexivity.
simpl in H6.
decompose sum H6.
auto.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN B 2
                (natToTerm (codeFormula L codeF codeR f))) 1
             (natToTerm (codePrf L codeF codeR A f p))) 0
          (Succ (var nv))) nv
       (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
apply iffE2.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN B 2
             (natToTerm (codeFormula L codeF codeR f))) 0
          (Succ (var nv))) 1 (natToTerm (codePrf L codeF codeR A f p))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
simpl in |- *.
unfold not in |- *; intros.
decompose sum H4.
apply H2; assumption.
apply closedNatToTerm.
apply (subFormulaExch LNN).
discriminate.
simpl in |- *.
unfold not in |- *; intros.
decompose sum H4.
apply H1; assumption.
apply closedNatToTerm.
unfold B in |- *.
clear B.
assert
 (Representable NN 2 (checkPrf L codeF codeR codeArityF codeArityR)
    (primRecFormula 2
       (proj1_sig
          (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
             codeArityRIsPR)))).
apply primRecRepresentable.
induction H4 as (H4, H5).
set
 (F :=
  primRecFormula 2
    (proj1_sig
       (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
          codeArityRIsPR))) in *.
simpl in H5.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (equal (var 0)
             (natToTerm
                (checkPrf L codeF codeR codeArityF codeArityR
                   (codeFormula L codeF codeR f)
                   (codePrf L codeF codeR A f p)))) 0
          (Succ (var nv))) nv
       (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
apply iffE2.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H5.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
rewrite (subFormulaEqual LNN).
replace
 (substituteTerm LNN (Succ (var nv)) nv
    (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) with
 (natToTerm (S (codeList (map (codeFormula L codeF codeR) A)))).
rewrite (subTermNil LNN).
rewrite checkPrfCorrect1.
apply eqRefl.
apply codeArityFIsCorrect1.
apply codeArityRIsCorrect1.
apply closedNatToTerm.
generalize nv.
intro.
simpl in |- *.
induction (eq_nat_dec nv0 nv0).
reflexivity.
elim b.
reflexivity.
apply closedNatToTerm.
assert (S nv <> 1).
unfold not in |- *; intros.
elim (le_not_lt (S nv) 1).
rewrite H4.
apply le_n.
apply lt_S.
unfold nv in |- *.
apply newVar2.
unfold nvl in |- *; simpl in |- *; auto.
assert (S nv <> 2).
unfold not in |- *; intros.
elim (le_not_lt (S nv) 2).
rewrite H5.
apply le_n.
apply lt_S.
unfold nv in |- *.
apply newVar2.
unfold nvl in |- *; simpl in |- *; auto.
assert (S nv <> nv).
unfold not in |- *; intros.
eapply (n_Sn nv).
symmetry  in |- *; assumption.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) 0).
discriminate a.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) 1).
elim H4; assumption.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A f p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) nv).
elim H6; assumption.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN
       (natToTerm (codeList (map (codeFormula L codeF codeR) A))))).
elim (closedNatToTerm _ _ a).
clear b b0.
repeat rewrite (subFormulaImp LNN).
replace
 (substituteFormula LNN
    (substituteFormula LNN
       (substituteFormula LNN (LT (var (S nv)) (var nv)) 0
          (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm (codePrf L codeF codeR A f p))) nv
    (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) with
 (LT (var (S nv)) (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
set
 (G :=
  list_rec (fun _ => Formula) (equal Zero Zero)
    (fun (a : fol.Formula L) _ (rec : Formula) =>
     andH
       (substituteFormula LNN fU v0 (natToTerm (codeFormula L codeF codeR a)))
       rec) A) in *.
assert (forall v : nat, ~ In v (freeVarFormula LNN G)).
unfold G in |- *.
intros.
generalize A.
intro.
induction A0 as [| a A0 HrecA0].
simpl in |- *.
auto.
simpl in |- *.
unfold not in |- *; intros.
induction (in_app_or _ _ _ H7).
induction (freeVarSubFormula3 _ _ _ _ _ H8).
absurd (v = v0).
eapply In_list_remove2.
apply H9.
apply freeVarfU.
eapply In_list_remove1.
apply H9.
elim (closedNatToTerm _ _ H9).
auto.
apply impE with G.
apply sysExtend with NN.
assumption.
apply impI.
assert (forall v : nat, ~ In_freeVarSys LNN v (Ensembles.Add (fol.Formula LNN) NN G)).
unfold not in |- *; intros.
induction H8 as (x, H8).
induction H8 as (H8, H9).
induction H9 as [x H9| x H9].
elim (closedNN v).
exists x.
auto.
induction H9.
apply (H7 v).
assumption.
apply forallI.
apply H8.
apply impI.
apply impE with G.
apply
 impE
  with
    (LT (var (S nv))
       (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
repeat simple apply sysWeaken.
apply boundedLT.
intros.
rewrite (subFormulaImp LNN).
apply impTrans with G.
apply iffE1.
apply (subFormulaNil LNN).
apply H7.
apply impI.
repeat rewrite (subFormulaOr LNN).
induction (In_dec eq_nat_dec n (map (codeFormula L codeF codeR) A)).
apply orI2.
apply impE with (substituteFormula LNN fU v0 (natToTerm n)).
apply iffE2.
apply sysWeaken.
assert
 (forall v : nat,
  ~ In v (list_remove nat eq_nat_dec v0 (freeVarFormula LNN fU))).
unfold not in |- *; intros.
absurd (v = v0).
eapply In_list_remove2.
apply H10.
apply freeVarfU.
eapply In_list_remove1.
apply H10.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv))) 1
             (natToTerm (codePrf L codeF codeR A f p))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H11).
apply (H10 0).
assumption.
simpl in H12.
decompose sum H12.
discriminate H13.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H11).
apply (H10 1).
assumption.
simpl in H12.
decompose sum H12.
apply H4; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv)))
       (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H11).
apply (H10 nv).
assumption.
simpl in H12.
decompose sum H12.
apply H6; assumption.
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
absurd (S nv = v0).
unfold not in |- *; intros.
elim (le_not_lt (S nv) v0).
rewrite H12.
apply le_n.
apply lt_S.
unfold nv in |- *.
apply newVar2.
unfold nvl in |- *; simpl in |- *; auto.
apply freeVarfU.
eapply In_list_remove1.
apply H11.
clear H9 H8 H7 H p.
induction A as [| a0 A HrecA].
elim a.
simpl in (value of G).
simpl in a.
induction a as [H| H].
unfold G in |- *.
rewrite H.
eapply andE1.
apply Axm; right; constructor.
apply
 impE
  with
    (list_rec (fun _ => Formula) (equal Zero Zero)
       (fun (a : fol.Formula L) (_ : list (fol.Formula L)) (rec : Formula) =>
        andH
          (substituteFormula LNN fU v0
             (natToTerm (codeFormula L codeF codeR a))) rec) A).
apply sysWeaken.
apply impI.
apply HrecA.
assumption.
eapply andE2.
unfold G in |- *.
apply Axm; right; constructor.
apply orI1.
assert (Representable NN 2 codeIn (primRecFormula 2 (proj1_sig codeInIsPR))).
apply primRecRepresentable.
induction H10 as (H10, H11).
set (J := primRecFormula 2 (proj1_sig codeInIsPR)) in *.
simpl in H11.
apply sysWeaken.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN J 2 (natToTerm n)) 1
          (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0 Zero).
apply iffE2.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN
                   (substituteFormula LNN J 2 (var (S nv))) 1
                   (var nv)) 0 Zero) 1
             (natToTerm (codePrf L codeF codeR A f p))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H12).
elim (In_list_remove2 _ _ _ _ _ H13).
reflexivity.
apply H13.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
                1 (var nv)) 0 Zero) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H12).
assert
 (In 1
    (freeVarFormula LNN
       (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv))) 1
          (var nv)))).
eapply In_list_remove1.
apply H13.
induction (freeVarSubFormula3 _ _ _ _ _ H14).
elim (In_list_remove2 _ _ _ _ _ H15).
reflexivity.
simpl in H15.
decompose sum H15.
apply H1; assumption.
apply H13.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
                1 (var nv)) nv
             (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0
          Zero) (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
unfold not in |- *; intros; apply H0; symmetry  in |- *; assumption.
auto.
apply closedNatToTerm.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv))) 1
             (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0
          Zero) (S nv) (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert (In nv (freeVarFormula LNN (substituteFormula LNN J 2 (var (S nv))))).
eapply In_list_remove1.
apply H12.
induction (freeVarSubFormula3 _ _ _ _ _ H13).
apply (le_not_lt nv 2).
apply H10.
eapply In_list_remove1.
apply H14.
destruct nv as [| n0].
elim H0; reflexivity.
destruct n0.
elim H1; reflexivity.
destruct n0.
elim H2; reflexivity.
repeat apply lt_n_S.
apply lt_O_Sn.
simpl in H14.
decompose sum H14.
apply H6; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv))) 1
             (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
          (S nv) (natToTerm n)) 0 Zero).
apply (subFormulaExch LNN).
discriminate.
auto.
apply closedNatToTerm.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
             (S nv) (natToTerm n)) 1
          (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0 Zero).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
unfold not in |- *; intros; apply H4; symmetry  in |- *; assumption.
apply closedNatToTerm.
apply closedNatToTerm.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
apply (le_not_lt (S nv) 2).
apply H10.
eapply In_list_remove1.
apply H12.
apply le_lt_n_Sm.
destruct nv as [| n0].
elim H0; reflexivity.
destruct n0.
elim H1; reflexivity.
repeat apply le_n_S.
apply le_O_n.
apply
 impE
  with
    (substituteFormula LNN
       (equal (var 0)
          (natToTerm
             (codeIn n (codeList (map (codeFormula L codeF codeR) A))))) 0
       Zero).
apply iffE2.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H11.
rewrite codeInCorrect.
induction (In_dec eq_nat_dec n (map (codeFormula L codeF codeR) A)).
elim b; assumption.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
apply eqRefl.
apply closedNatToTerm.
apply Axm; right; constructor.
apply Axm; left; right; constructor.
clear p H7.
induction A as [| a A HrecA]; simpl in (value of G).
unfold G in |- *.
apply eqRefl.
simpl in H.
unfold G in |- *.
apply andI.
apply expressU1.
apply H.
auto.
apply HrecA.
intros.
apply H.
auto.
assert
 (forall (t1 t2 s : Term) (v : nat),
  substituteFormula LNN (LT t1 t2) v s =
  LT (substituteTerm LNN t1 v s) (substituteTerm LNN t2 v s)).
reflexivity.
repeat rewrite H7.
repeat rewrite (subTermVar1 LNN) || rewrite (subTermVar2 LNN);
 try unfold not in |- *; intros.
reflexivity.
apply H1; auto.
apply H0; auto.
apply H6; auto.
apply H4; auto.
discriminate H8.
Qed.

Lemma codeSysPrfCorrect2 :
 forall (f : fol.Formula L) (A : fol.Formulas L),
 (exists g : fol.Formula L, In g A /\ ~ mem _ U g) ->
 forall p : Prf L A f,
 SysPrf T
   (notH
      (substituteFormula LNN
         (substituteFormula LNN codeSysPrf 0
            (natToTerm (codeFormula L codeF codeR f))) 1
         (natToTerm (codePrf L codeF codeR A f p)))).
Proof.
intros.
unfold codeSysPrf in |- *.
set (nvl := 2 :: 1 :: 0 :: v0 :: nil) in *.
set (nv := newVar nvl) in *.
assert (nv <> 0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H0; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 1).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H1; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 2).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H2; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> v0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H3; unfold nvl in |- *.
simpl in |- *; auto.
set
 (F :=
  primRecFormula 2
    (proj1_sig
       (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
          codeArityRIsPR))) in *.
set (J := primRecFormula 2 (proj1_sig codeInIsPR)) in *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 0).
elim H0; assumption.
induction
 (In_dec eq_nat_dec nv
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 1).
elim H1; assumption.
induction
 (In_dec eq_nat_dec nv
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A f p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
repeat rewrite (subFormulaAnd LNN).
apply nExist.
set (n := codePrf L codeF codeR A f p) in *.
apply
 impE
  with
    (forallH nv
       (notH
          (fol.andH LNN
             (equal (Succ (var nv))
                (natToTerm
                   (checkPrf L codeF codeR codeArityF codeArityR
                      (codeFormula L codeF codeR f) n)))
             (substituteFormula LNN
                (substituteFormula LNN
                   (forallH (S nv)
                      (impH (LT (var (S nv)) (var nv))
                         (orH
                            (substituteFormula LNN
                               (substituteFormula LNN
                                  (substituteFormula LNN J 2 (var (S nv))) 1
                                  (var nv)) 0 Zero)
                            (substituteFormula LNN fU v0 (var (S nv)))))) 0
                   (natToTerm (codeFormula L codeF codeR f))) 1
                (natToTerm n))))).
apply sysExtend with NN.
assumption.
apply iffE2.
apply (reduceForall LNN).
apply closedNN.
apply (reduceNot LNN).
apply (reduceAnd LNN).
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN F 2
             (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm n)) 0 (Succ (var nv))).
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN F 0 (Succ (var nv))) 2
          (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert
 (In 0 (freeVarFormula LNN (substituteFormula LNN F 0 (Succ (var nv))))).
eapply In_list_remove1.
apply H4.
induction (freeVarSubFormula3 _ _ _ _ _ H5).
elim (In_list_remove2 _ _ _ _ _ H6).
reflexivity.
simpl in H6.
decompose sum H6.
apply H0; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN F 2
             (natToTerm (codeFormula L codeF codeR f))) 0
          (Succ (var nv))) 1 (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
apply H2; assumption.
apply closedNatToTerm.
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
apply H1; assumption.
apply closedNatToTerm.
assert
 (Representable NN 2 (checkPrf L codeF codeR codeArityF codeArityR)
    (primRecFormula 2
       (proj1_sig
          (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
             codeArityRIsPR)))).
apply primRecRepresentable.
fold F in H4.
induction H4 as (H4, H5).
simpl in H5.
apply
 iffTrans
  with
    (substituteFormula LNN
       (equal (var 0)
          (natToTerm
             (checkPrf L codeF codeR codeArityF codeArityR
                (codeFormula L codeF codeR f) n))) 0
       (Succ (var nv))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H5.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
apply iffRefl.
apply closedNatToTerm.
apply iffRefl.
unfold n in |- *.
rewrite checkPrfCorrect1.
decompose record H.
apply
 impE
  with
    (notH
       (substituteFormula LNN fU v0 (natToTerm (codeFormula L codeF codeR x)))).
apply sysExtend with NN.
assumption.
apply impI.
assert
 (forall v : nat,
  ~
  In v
    (freeVarFormula LNN
       (notH
          (substituteFormula LNN fU v0
             (natToTerm (codeFormula L codeF codeR x)))))).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H4).
absurd (v = v0).
eapply In_list_remove2.
apply H7.
apply freeVarfU.
eapply In_list_remove1.
apply H7.
apply (closedNatToTerm _ _ H7).
assert
 (forall v : nat,
  ~
  In_freeVarSys LNN v
    (Ensembles.Add (fol.Formula LNN) NN
       (notH
          (substituteFormula LNN fU v0
             (natToTerm (codeFormula L codeF codeR x)))))).
unfold not in |- *; intros.
induction H7 as (x0, H7); induction H7 as (H7, H8).
induction H8 as [x0 H8| x0 H8].
elim (closedNN v).
exists x0.
auto.
induction H8.
apply (H4 v).
assumption.
apply forallI.
apply H7.
apply nAnd.
unfold orH at 1 in |- *.
unfold fol.orH in |- *.
apply
 impTrans
  with
    (equal (Succ (var nv))
       (natToTerm (S (codeList (map (codeFormula L codeF codeR) A))))).
apply impI.
apply nnE.
apply Axm; right; constructor.
apply impI.
rewrite <-
 (subFormulaId LNN
    (notH
       (substituteFormula LNN
          (substituteFormula LNN
             (forallH (S nv)
                (impH (LT (var (S nv)) (var nv))
                   (orH
                      (substituteFormula LNN
                         (substituteFormula LNN
                            (substituteFormula LNN J 2 (var (S nv))) 1
                            (var nv)) 0 Zero)
                      (substituteFormula LNN fU v0 (var (S nv)))))) 0
             (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm (codePrf L codeF codeR A f p)))) nv)
 .
apply
 impE
  with
    (substituteFormula LNN
       (notH
          (substituteFormula LNN
             (substituteFormula LNN
                (forallH (S nv)
                   (impH (LT (var (S nv)) (var nv))
                      (orH
                         (substituteFormula LNN
                            (substituteFormula LNN
                               (substituteFormula LNN J 2 (var (S nv))) 1
                               (var nv)) 0 Zero)
                         (substituteFormula LNN fU v0 (var (S nv)))))) 0
                (natToTerm (codeFormula L codeF codeR f))) 1
             (natToTerm (codePrf L codeF codeR A f p)))) nv
       (natToTerm (codeList (map (codeFormula L codeF codeR) A)))).
apply (subWithEquals LNN).
apply eqSym.
apply
 impE
  with
    (fol.equal LNN (Succ (var nv))
       (natToTerm (S (codeList (map (codeFormula L codeF codeR) A))))).
apply sysWeaken.
fold var in |- *.
simpl in |- *.
apply sysWeaken.
apply nn2.
apply Axm; right; constructor.
apply sysWeaken.
assert (S nv <> 1).
unfold not in |- *; intros.
elim (le_not_lt (S nv) 1).
rewrite H8.
apply le_n.
apply lt_S.
unfold nv in |- *.
apply newVar2.
unfold nvl in |- *; simpl in |- *; auto.
assert (S nv <> 2).
unfold not in |- *; intros.
elim (le_not_lt (S nv) 2).
rewrite H9.
apply le_n.
apply lt_S.
unfold nv in |- *.
apply newVar2.
unfold nvl in |- *; simpl in |- *; auto.
assert (S nv <> nv).
unfold not in |- *; intros.
eapply (n_Sn nv).
symmetry  in |- *; assumption.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) 0).
discriminate a.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) 1).
elim H8; assumption.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A f p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaNot LNN).
rewrite (subFormulaForall LNN).
induction (eq_nat_dec (S nv) nv).
elim H10; assumption.
induction
 (In_dec eq_nat_dec (S nv)
    (freeVarTerm LNN
       (natToTerm (codeList (map (codeFormula L codeF codeR) A))))).
elim (closedNatToTerm _ _ a).
clear b b0.
apply nForall.
apply existI with (natToTerm (codeFormula L codeF codeR x)).
rewrite (subFormulaNot LNN).
repeat rewrite (subFormulaImp LNN).
apply nImp.
apply andI.
assert
 (forall (t1 t2 s : Term) (v : nat),
  substituteFormula LNN (LT t1 t2) v s =
  LT (substituteTerm LNN t1 v s) (substituteTerm LNN t2 v s)).
reflexivity.
repeat rewrite H11.
repeat rewrite (subTermVar1 LNN) || rewrite (subTermVar2 LNN);
 try unfold not in |- *; intros.
rewrite (subTermNil LNN).
apply sysWeaken.
apply natLT.
cut (In x A).
generalize x A.
intros.
induction A0 as [| a A0 HrecA0].
elim H12.
induction H12 as [H12| H12].
rewrite H12.
simpl in |- *.
apply le_lt_n_Sm.
apply cPairLe1.
apply lt_le_trans with (codeList (map (codeFormula L codeF codeR) A0)).
auto.
simpl in |- *.
apply le_S.
apply cPairLe2.
assumption.
apply closedNatToTerm.
apply H1; auto.
apply H0; auto.
apply H10; auto.
apply H8; auto.
discriminate H12.
repeat rewrite (subFormulaOr LNN).
apply nOr.
apply andI.
apply sysWeaken.
assert (Representable NN 2 codeIn J).
unfold J in |- *; apply primRecRepresentable.
induction H11 as (H11, H12).
apply
 impE
  with
    (notH
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN J 2
                (natToTerm (codeFormula L codeF codeR x))) 1
             (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0
          Zero)).
apply cp2.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN
                   (substituteFormula LNN J 2 (var (S nv))) 1
                   (var nv)) 0 Zero) 1
             (natToTerm (codePrf L codeF codeR A f p))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H13).
elim (In_list_remove2 _ _ _ _ _ H14).
reflexivity.
apply H14.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN
                   (substituteFormula LNN J 2 (var (S nv))) 1
                   (var nv)) 1 (natToTerm (codePrf L codeF codeR A f p))) 0
             Zero) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
auto.
apply closedNatToTerm.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
                1 (var nv)) 0 Zero) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H13).
elim (In_list_remove2 _ _ _ _ _ H14).
reflexivity.
simpl in H14.
decompose sum H14.
apply H1; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
                1 (var nv)) nv
             (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0
          Zero) (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
unfold not in |- *; intros.
apply H0; symmetry  in |- *; assumption.
auto.
apply closedNatToTerm.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv))) 1
             (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0
          Zero) (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert (In nv (freeVarFormula LNN (substituteFormula LNN J 2 (var (S nv))))).
eapply In_list_remove1.
apply H13.
induction (freeVarSubFormula3 _ _ _ _ _ H14).
apply (le_not_lt nv 2).
apply H11.
eapply In_list_remove1.
apply H15.
destruct nv as [| n0].
elim H0; reflexivity.
destruct n0.
elim H1; reflexivity.
destruct n0.
elim H2; reflexivity.
repeat apply lt_n_S.
apply lt_O_Sn.
simpl in H15.
decompose sum H15.
apply H10; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv))) 1
             (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
          (S nv) (natToTerm (codeFormula L codeF codeR x))) 0 Zero).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
auto.
apply closedNatToTerm.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN J 2 (var (S nv)))
             (S nv) (natToTerm (codeFormula L codeF codeR x))) 1
          (natToTerm (codeList (map (codeFormula L codeF codeR) A)))) 0 Zero).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
unfold not in |- *; intros.
apply H8; symmetry  in |- *; assumption.
apply closedNatToTerm.
apply closedNatToTerm.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
apply (le_not_lt (S nv) 2).
apply H11.
eapply In_list_remove1.
apply H13.
destruct nv as [| n0].
elim H8; reflexivity.
destruct n0.
elim H9; reflexivity.
repeat apply lt_n_S.
apply lt_O_Sn.
simpl in H12.
apply
 impE
  with
    (notH
       (substituteFormula LNN
          (equal (var 0)
             (natToTerm
                (codeIn (codeFormula L codeF codeR x)
                   (codeList (map (codeFormula L codeF codeR) A))))) 0 Zero)).
apply cp2.
apply iffE1.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H12.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
rewrite codeInCorrect.
induction
 (In_dec eq_nat_dec (codeFormula L codeF codeR x)
    (map (codeFormula L codeF codeR) A)).
replace Zero with (natToTerm 0).
apply natNE.
discriminate.
reflexivity.
elim b.
cut (In x A).
generalize A x.
intros.
induction A0 as [| a A0 HrecA0].
elim H13.
induction H13 as [H13| H13].
rewrite H13.
simpl in |- *.
auto.
simpl in |- *.
auto.
assumption.
apply closedNatToTerm.
apply
 impE
  with
    (notH
       (substituteFormula LNN fU v0 (natToTerm (codeFormula L codeF codeR x)))).
apply sysWeaken.
apply cp2.
apply iffE1.
assert
 (forall v : nat,
  ~ In v (list_remove nat eq_nat_dec v0 (freeVarFormula LNN fU))).
unfold not in |- *; intros.
absurd (v = v0).
eapply In_list_remove2.
apply H11.
apply freeVarfU.
eapply In_list_remove1.
apply H11.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv))) 1
             (natToTerm (codePrf L codeF codeR A f p))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H12).
apply (H11 0).
assumption.
simpl in H13.
decompose sum H13.
discriminate H14.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv))) nv
          (natToTerm (codeList (map (codeFormula L codeF codeR) A))))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H12).
apply (H11 1).
assumption.
simpl in H13.
decompose sum H13.
apply H8; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN (substituteFormula LNN fU v0 (var (S nv)))
       (S nv) (natToTerm (codeFormula L codeF codeR x))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H12).
apply (H11 nv).
assumption.
simpl in H13.
decompose sum H13.
apply H10; assumption.
apply (subFormulaTrans LNN).
apply H11.
apply Axm; right; constructor.
apply expressU2.
assumption.
assumption.
assumption.
Qed.

Lemma codeSysPrfCorrect3 :
 forall (f : fol.Formula L) (n : nat),
 (forall (A : list (fol.Formula L)) (p : Prf L A f),
  n <> codePrf L codeF codeR A f p) ->
 SysPrf T
   (notH
      (substituteFormula LNN
         (substituteFormula LNN codeSysPrf 0
            (natToTerm (codeFormula L codeF codeR f))) 1
         (natToTerm n))).
Proof.
intros.
unfold codeSysPrf in |- *.
set (nvl := 2 :: 1 :: 0 :: v0 :: nil) in *.
set (nv := newVar nvl) in *.
assert (nv <> 0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H0; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 1).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H1; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> 2).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H2; unfold nvl in |- *.
simpl in |- *; auto.
assert (nv <> v0).
unfold nv, not in |- *; intros; elim (newVar1 nvl).
rewrite H3; unfold nvl in |- *.
simpl in |- *; auto.
set
 (F :=
  primRecFormula 2
    (proj1_sig
       (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
          codeArityRIsPR))) in *.
set (J := primRecFormula 2 (proj1_sig codeInIsPR)) in *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 0).
elim H0; assumption.
induction
 (In_dec eq_nat_dec nv
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec nv 1).
elim H1; assumption.
induction (In_dec eq_nat_dec nv (freeVarTerm LNN (natToTerm n))).
elim (closedNatToTerm _ _ a).
clear b b0.
repeat rewrite (subFormulaAnd LNN).
apply nExist.
apply sysExtend with NN.
assumption.
apply forallI.
apply closedNN.
apply nAnd.
apply orI1.
apply
 impE
  with
    (notH
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN F 2
                (natToTerm (codeFormula L codeF codeR f))) 1
             (natToTerm n)) 0 (Succ (var nv)))).
apply cp2.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN F 0 (Succ (var nv))) 2
          (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert
 (In 0 (freeVarFormula LNN (substituteFormula LNN F 0 (Succ (var nv))))).
eapply In_list_remove1.
apply H4.
induction (freeVarSubFormula3 _ _ _ _ _ H5).
elim (In_list_remove2 _ _ _ _ _ H6).
reflexivity.
simpl in H6.
decompose sum H6.
apply H0; assumption.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN F 2
             (natToTerm (codeFormula L codeF codeR f))) 0
          (Succ (var nv))) 1 (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
apply H2; assumption.
apply closedNatToTerm.
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
apply H1; assumption.
apply closedNatToTerm.
assert
 (Representable NN 2 (checkPrf L codeF codeR codeArityF codeArityR)
    (primRecFormula 2
       (proj1_sig
          (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
             codeArityRIsPR)))).
apply primRecRepresentable.
fold F in H4.
induction H4 as (H4, H5).
simpl in H5.
apply
 impE
  with
    (notH
       (substituteFormula LNN
          (equal (var 0)
             (natToTerm
                (checkPrf L codeF codeR codeArityF codeArityR
                   (codeFormula L codeF codeR f) n))) 0
          (Succ (var nv)))).
apply cp2.
apply iffE1.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H5.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
induction
 (eq_nat_dec
    (checkPrf L codeF codeR codeArityF codeArityR
       (codeFormula L codeF codeR f) n) 0).
rewrite a.
apply nn1.
decompose record
 (checkPrfCorrect2 L codeF codeR codeArityF codeArityR codeArityFIsCorrect1
    codeArityFIsCorrect2 codeArityRIsCorrect1 codeArityRIsCorrect2 codeFInj
    codeRInj (codeFormula L codeF codeR f) n b).
assert (x = f).
eapply codeFormulaInj.
apply codeFInj.
apply codeRInj.
assumption.
rewrite <- H6 in H.
elim (H x0 x1).
symmetry  in |- *.
assumption.
apply closedNatToTerm.
Qed.

Lemma freeVarCodeSysPrf :
 forall v : nat, In v (freeVarFormula LNN codeSysPrf) -> v <= 1.
Proof.
intros.
unfold codeSysPrf in H.
set (nv := newVar (2 :: 1 :: 0 :: v0 :: nil)) in *.
unfold existH, andH, forallH, impH, orH in H.
repeat
 match goal with
 | H1:(?X1 = ?X2),H2:(?X1 <> ?X2) |- _ =>
     elim H2; apply H1
 | H1:(?X1 = ?X2),H2:(?X2 <> ?X1) |- _ =>
     elim H2; symmetry  in |- *; apply H1
 | H:(In ?X3 (freeVarFormula LNN (fol.existH LNN ?X1 ?X2))) |- _ =>
     assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula LNN X2)));
      [ apply H | clear H ]
 | H:(In ?X3 (freeVarFormula LNN (fol.forallH LNN ?X1 ?X2))) |- _ =>
     assert (In X3 (list_remove nat eq_nat_dec X1 (freeVarFormula LNN X2)));
      [ apply H | clear H ]
 | H:(In ?X3 (list_remove nat eq_nat_dec ?X1 (freeVarFormula LNN ?X2))) |- _
 =>
     assert (In X3 (freeVarFormula LNN X2));
      [ eapply In_list_remove1; apply H
      | assert (X3 <> X1); [ eapply In_list_remove2; apply H | clear H ] ]
 | H:(In ?X3 (freeVarFormula LNN (fol.andH LNN ?X1 ?X2))) |- _ =>
     assert (In X3 (freeVarFormula LNN X1 ++ freeVarFormula LNN X2));
      [ apply H | clear H ]
 | H:(In ?X3 (freeVarFormula LNN (fol.orH LNN ?X1 ?X2))) |- _ =>
     assert (In X3 (freeVarFormula LNN X1 ++ freeVarFormula LNN X2));
      [ apply H | clear H ]
 | H:(In ?X3 (freeVarFormula LNN (fol.impH LNN ?X1 ?X2))) |- _ =>
     assert (In X3 (freeVarFormula LNN X1 ++ freeVarFormula LNN X2));
      [ apply H | clear H ]
 | H:(In ?X3 (freeVarFormula LNN (fol.notH LNN ?X1))) |- _ =>
     assert (In X3 (freeVarFormula LNN X1)); [ apply H | clear H ]
 | H:(In _ (_ ++ _)) |- _ =>
     induction (in_app_or _ _ _ H); clear H
 | H:(In _ (freeVarFormula LNN (substituteFormula LNN ?X1 ?X2 ?X3))) |- _ =>
     induction (freeVarSubFormula3 _ _ _ _ _ H); clear H
 | H:(In _ (freeVarFormula LNN (LT ?X1 ?X2))) |- _ =>
     rewrite freeVarLT in H
 | H:(In _ (freeVarTerm LNN (natToTerm _))) |- _ =>
     elim (closedNatToTerm _ _ H)
 | H:(In _ (freeVarTerm LNN Zero)) |- _ =>
     elim H
 | H:(In _ (freeVarTerm LNN (Succ _))) |- _ =>
     rewrite freeVarSucc in H
 | H:(In _ (freeVarTerm LNN (var _))) |- _ =>
     simpl in H; decompose sum H; clear H
 | H:(In _ (freeVarTerm LNN (fol.var LNN _))) |- _ =>
     simpl in H; decompose sum H; clear H
 end.
assert
 (Representable NN 2 (checkPrf L codeF codeR codeArityF codeArityR)
    (primRecFormula 2
       (proj1_sig
          (checkPrfIsPR L codeF codeR codeArityF codeArityR codeArityFIsPR
             codeArityRIsPR)))).
apply primRecRepresentable.
induction H0 as (H0, H4).
clear H4.
induction (le_lt_or_eq _ _ (H0 _ H)).
apply le_S_n.
apply H4.
elim H2; assumption.
rewrite <- H.
auto.
assert (Representable NN 2 codeIn (primRecFormula 2 (proj1_sig codeInIsPR))).
apply primRecRepresentable.
induction H0 as (H0, H6).
induction (le_lt_or_eq _ _ (H0 _ H)).
apply le_S_n.
apply H7.
elim H5; assumption.
elim H3.
apply freeVarfU.
assumption.
Qed.

Definition codeSysPf : Formula := existH 1 codeSysPrf.

Lemma freeVarCodeSysPf :
 forall v : nat, In v (freeVarFormula LNN codeSysPf) -> v = 0.
Proof.
intros.
unfold codeSysPf in H.
destruct v as [| n].
reflexivity.
destruct n.
elim (In_list_remove2 _ _ _ _ _ H).
reflexivity.
elim (le_not_lt (S (S n)) 1).
apply freeVarCodeSysPrf.
eapply In_list_remove1.
apply H.
apply lt_n_S.
apply lt_O_Sn.
Qed.

Lemma codeSysPfCorrect :
 forall f : fol.Formula L,
 folProof.SysPrf L U f ->
 SysPrf T
   (substituteFormula LNN codeSysPf 0
      (natToTerm (codeFormula L codeF codeR f))).
Proof.
intros.
induction H as (x, H).
induction H as (x0, H).
unfold codeSysPf in |- *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 1 0).
discriminate a.
induction
 (In_dec eq_nat_dec 1
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
apply existI with (natToTerm (codePrf L codeF codeR _ _ x0)).
apply codeSysPrfCorrect1.
assumption.
Qed.

Definition codeSysPrfNot :=
  existH 2
    (andH (substituteFormula LNN codeSysPrf 0 (var 2))
       (substituteFormula LNN
          (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
             (var 2)) 1 (var 0))).

Lemma freeVarCodeSysPrfN :
 forall v : nat, In v (freeVarFormula LNN codeSysPrfNot) -> v <= 1.
Proof.
intros.
unfold codeSysPrfNot in H.
SimplFreeVar.
apply freeVarCodeSysPrf.
apply H.
assert (Representable NN 1 codeNot (primRecFormula 1 (proj1_sig codeNotIsPR))).
apply primRecRepresentable.
induction H0 as (H0, H4).
clear H4.
apply H0.
assumption.
rewrite <- H.
apply le_O_n.
Qed.

Lemma codeSysPrfNCorrect1 :
 forall (f : fol.Formula L) (A : fol.Formulas L) (p : Prf L A (fol.notH L f)),
 (forall g : fol.Formula L, In g A -> mem _ U g) ->
 SysPrf T
   (substituteFormula LNN
      (substituteFormula LNN codeSysPrfNot 0
         (natToTerm (codeFormula L codeF codeR f))) 1
      (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
Proof.
intros.
unfold codeSysPrfNot in |- *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 0).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 1).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
apply existI with (natToTerm (codeFormula L codeF codeR (fol.notH L f))).
repeat rewrite (subFormulaAnd LNN).
apply andI.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN codeSysPrf 0
          (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
       (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
apply sysExtend with NN.
apply TextendsNN.
apply iffE2.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H0).
apply (In_list_remove2 _ _ _ _ _ H1).
reflexivity.
simpl in H1.
decompose sum H1.
discriminate H2.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 2
          (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
       (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
apply (subFormulaExch LNN).
discriminate.
apply closedNatToTerm.
apply closedNatToTerm.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
elim (le_not_lt 2 1).
apply freeVarCodeSysPrf.
eapply In_list_remove1.
apply H0.
eapply lt_n_S.
apply lt_O_Sn.
apply codeSysPrfCorrect1.
assumption.
apply sysExtend with NN.
apply TextendsNN.
set (B := primRecFormula 1 (proj1_sig codeNotIsPR)) in *.
assert (rep : Representable NN 1 codeNot B).
unfold B in |- *; apply primRecRepresentable.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN B 1 (natToTerm (codeFormula L codeF codeR f)))
       0 (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
apply iffE2.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN B 0 (var 2)) 1
             (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert (In 0 (freeVarFormula LNN (substituteFormula LNN B 0 (var 2)))).
eapply In_list_remove1.
apply H0.
induction (freeVarSubFormula3 _ _ _ _ _ H1).
elim (In_list_remove2 _ _ _ _ _ H2).
reflexivity.
induction H2 as [H2| H2].
discriminate H2.
apply H2.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN B 0 (var 2)) 1
          (natToTerm (codeFormula L codeF codeR f))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H0).
elim (In_list_remove2 _ _ _ _ _ H1).
reflexivity.
elim (closedNatToTerm _ _ H1).
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN B 1
             (natToTerm (codeFormula L codeF codeR f))) 0
          (var 2)) 2 (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H0.
decompose sum H0.
discriminate H1.
apply closedNatToTerm.
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
assert
 (In 2
    (freeVarFormula LNN
       (substituteFormula LNN B 1 (natToTerm (codeFormula L codeF codeR f))))).
eapply In_list_remove1.
apply H0.
induction (freeVarSubFormula3 _ _ _ _ _ H1).
induction rep as (H3, H4).
apply (le_not_lt 2 1).
apply H3.
eapply In_list_remove1.
apply H2.
apply lt_n_S.
apply lt_O_Sn.
apply (closedNatToTerm _ _ H2).
induction rep as (H0, H1).
unfold RepresentableHelp in H1.
apply
 impE
  with
    (substituteFormula LNN
       (equal (var 0) (natToTerm (codeNot (codeFormula L codeF codeR f)))) 0
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
apply iffE2.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H1.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
rewrite (codeNotCorrect L codeF codeR).
apply eqRefl.
apply closedNatToTerm.
Qed.

Lemma codeSysPrfNCorrect2 :
 forall (f : fol.Formula L) (A : fol.Formulas L),
 (exists g : fol.Formula L, In g A /\ ~ mem _ U g) ->
 forall p : Prf L A (fol.notH L f),
 SysPrf T
   (notH
      (substituteFormula LNN
         (substituteFormula LNN codeSysPrfNot 0
            (natToTerm (codeFormula L codeF codeR f))) 1
         (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))).
Proof.
intros.
unfold codeSysPrfNot in |- *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 0).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 1).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))).
elim (closedNatToTerm _ _ a).
clear b b0.
apply nExist.
apply
 impE
  with
    (fol.notH LNN
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrf 0
             (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))).
apply sysExtend with NN.
apply TextendsNN.
apply impI.
apply forallI.
unfold not in |- *; intros.
induction H0 as (x, H0); induction H0 as (H0, H1).
induction H1 as [x H1| x H1].
apply (closedNN 2).
exists x.
auto.
induction H1.
(*Fold notH in H0.*)
SimplFreeVar.
elim (le_not_lt 2 1).
apply freeVarCodeSysPrf.
apply H1.
apply lt_n_Sn.
repeat rewrite (subFormulaAnd LNN).
apply nAnd.
apply orSym.
unfold orH, fol.orH in |- *.
apply
 impTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 1
          (natToTerm (codeFormula L codeF codeR f))) 0
       (var 2)).
apply sysWeaken.
apply
 impTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN
                (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
                (var 2)) 1 (var 0)) 0
          (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
apply impI.
apply nnE.
apply Axm; right; constructor.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
             (var 2)) 1 (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros; SimplFreeVar.
discriminate H1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
          (var 2)) 1 (natToTerm (codeFormula L codeF codeR f))).
apply (subFormulaNil LNN).
unfold not in |- *; intros; SimplFreeVar.
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros; SimplFreeVar.
discriminate H1.
unfold not in |- *; intros; SimplFreeVar.
set (B := primRecFormula 1 (proj1_sig codeNotIsPR)) in *.
assert (rep : Representable NN 1 codeNot B).
unfold B in |- *; apply primRecRepresentable.
induction rep as (H0, H1).
unfold RepresentableHelp in H1.
apply
 impTrans
  with
    (substituteFormula LNN
       (equal (var 0) (natToTerm (codeNot (codeFormula L codeF codeR f)))) 0
       (var 2)).
apply iffE1.
apply sysWeaken.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H1.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
rewrite (codeNotCorrect L) with (a := f).
apply impI.
rewrite <-
 (subFormulaId LNN
    (notH
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2))
             0 (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))) 2)
 .
apply
 impE
  with
    (substituteFormula LNN
       (notH
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrf 0 (var 2)) 0
                (natToTerm (codeFormula L codeF codeR f))) 1
             (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
eapply (subWithEquals LNN).
apply eqSym.
apply Axm; right; constructor.
apply sysWeaken.
rewrite (subFormulaNot LNN).
apply
 impE
  with
    (fol.notH LNN
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrf 0
             (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p)))).
apply cp2.
apply sysWeaken.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 1
          (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros; SimplFreeVar.
discriminate.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 2
          (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
       (natToTerm (codePrf L codeF codeR A (fol.notH L f) p))).
apply (subFormulaExch LNN).
discriminate.
apply closedNatToTerm.
apply closedNatToTerm.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros; SimplFreeVar.
elim (le_not_lt 2 1).
apply freeVarCodeSysPrf.
apply H3.
apply lt_n_Sn.
apply Axm; right; constructor.
apply closedNatToTerm.
apply codeSysPrfCorrect2.
assumption.
Qed.

Lemma codeSysPrfNCorrect3 :
 forall (f : fol.Formula L) (n : nat),
 (forall (A : fol.Formulas L) (p : Prf L A (fol.notH L f)),
  n <> codePrf L codeF codeR A (fol.notH L f) p) ->
 SysPrf T
   (notH
      (substituteFormula LNN
         (substituteFormula LNN codeSysPrfNot 0
            (natToTerm (codeFormula L codeF codeR f))) 1
         (natToTerm n))).
Proof.
intros.
unfold codeSysPrfNot in |- *.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 0).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN (natToTerm (codeFormula L codeF codeR f)))).
elim (closedNatToTerm _ _ a).
clear b b0.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 1).
discriminate a.
induction (In_dec eq_nat_dec 2 (freeVarTerm LNN (natToTerm n))).
elim (closedNatToTerm _ _ a).
clear b b0.
apply nExist.
apply
 impE
  with
    (fol.notH LNN
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrf 0
             (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
          (natToTerm n))).
apply sysExtend with NN.
apply TextendsNN.
apply impI.
apply forallI.
unfold not in |- *; intros.
induction H0 as (x, H0); induction H0 as (H0, H1).
induction H1 as [x H1| x H1].
apply (closedNN 2).
exists x.
auto.
induction H1.
fold notH in H0.
SimplFreeVar.
elim (le_not_lt 2 1).
apply freeVarCodeSysPrf.
apply H1.
apply lt_n_Sn.
repeat rewrite (subFormulaAnd LNN).
apply nAnd.
apply orSym.
unfold orH, fol.orH in |- *.
apply
 impTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 1
          (natToTerm (codeFormula L codeF codeR f))) 0
       (var 2)).
apply sysWeaken.
apply
 impTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN
             (substituteFormula LNN
                (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
                (var 2)) 1 (var 0)) 0
          (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm n)).
apply impI.
apply nnE.
apply Axm; right; constructor.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
             (var 2)) 1 (natToTerm (codeFormula L codeF codeR f))) 1
       (natToTerm n)).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros; SimplFreeVar.
discriminate H1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (primRecFormula 1 (proj1_sig codeNotIsPR)) 0
          (var 2)) 1 (natToTerm (codeFormula L codeF codeR f))).
apply (subFormulaNil LNN).
unfold not in |- *; intros; SimplFreeVar.
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros; SimplFreeVar.
discriminate H1.
unfold not in |- *; intros; SimplFreeVar.
set (B := primRecFormula 1 (proj1_sig codeNotIsPR)) in *.
assert (rep : Representable NN 1 codeNot B).
unfold B in |- *; apply primRecRepresentable.
induction rep as (H0, H1).
unfold RepresentableHelp in H1.
apply
 impTrans
  with
    (substituteFormula LNN
       (equal (var 0) (natToTerm (codeNot (codeFormula L codeF codeR f)))) 0
       (var 2)).
apply iffE1.
apply sysWeaken.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply H1.
rewrite (subFormulaEqual LNN).
rewrite (subTermVar1 LNN).
rewrite (subTermNil LNN).
rewrite (codeNotCorrect L) with (a := f).
apply impI.
rewrite <-
 (subFormulaId LNN
    (notH
       (substituteFormula LNN
          (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2))
             0 (natToTerm (codeFormula L codeF codeR f))) 1
          (natToTerm n))) 2).
apply
 impE
  with
    (substituteFormula LNN
       (notH
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrf 0 (var 2)) 0
                (natToTerm (codeFormula L codeF codeR f))) 1
             (natToTerm n))) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
eapply (subWithEquals LNN).
apply eqSym.
apply Axm; right; constructor.
apply sysWeaken.
rewrite (subFormulaNot LNN).
apply
 impE
  with
    (fol.notH LNN
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrf 0
             (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
          (natToTerm n))).
apply cp2.
apply sysWeaken.
apply iffE1.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 1
          (natToTerm n)) 2
       (natToTerm (codeFormula L codeF codeR (fol.notH L f)))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaNil LNN).
unfold not in |- *; intros; SimplFreeVar.
discriminate.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN (substituteFormula LNN codeSysPrf 0 (var 2)) 2
          (natToTerm (codeFormula L codeF codeR (fol.notH L f)))) 1
       (natToTerm n)).
apply (subFormulaExch LNN).
discriminate.
apply closedNatToTerm.
apply closedNatToTerm.
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaTrans LNN).
unfold not in |- *; intros; SimplFreeVar.
elim (le_not_lt 2 1).
apply freeVarCodeSysPrf.
apply H3.
apply lt_n_Sn.
apply Axm; right; constructor.
apply closedNatToTerm.
fold notH in |- *.
apply codeSysPrfCorrect3.
assumption.
Qed.

End LNN.

End code_SysPrf.


(* ---------------------------------------------------------------------

   This file is part of a repository containing the definitions and
   proof scripts related to the formalization of context-free language
   theory in Coq. Specifically, the following results were obtained:

   (i) closure operations for context-free grammars,
   (ii) context-free grammars simplification
   (iii) context-free grammar Chomsky normalization and
   (iv) pumping lemma for context-free languages.

   More information can be found in thesis "Formalization of
   Context-Free Language Theory", submitted to the Informatics
   Center of the Pernambuco Federal University (CIn/UFPE) in
   Brazil.

   The file README.md descbrides the contents of each file and
   provides instructions to compile them.

   Marcus Vinícius Midena Ramos
   mvmramos@gmail.com
   --------------------------------------------------------------------- *)

Require Import List.
Require Import Ring.
Require Import Omega.
Require Import Compare_dec.

Require Import misc_arith.
Require Import misc_list.
Require Import cfg.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import ListNotations.
Open Scope list_scope.

Section AllRules.

Variables terminal non_terminal: Type.

Notation symbol:= (non_terminal + terminal)%type.
Notation sf:= (list symbol).
Notation sentence := (list terminal).
Notation term_lift:= ((terminal_lift non_terminal) terminal).

Notation rlist:= (list (non_terminal * sf)).
Notation tlist:= (list terminal).
Notation nlist:= (list non_terminal).
Notation vlist:= (list symbol).
Notation slist:= (list sf).

Fixpoint concat_symbol (s: non_terminal + terminal) (l: slist): slist:=
match l with
| [] => []
| e :: l' => (s :: e) :: concat_symbol s l'
end.

Lemma concat_symbol_correct:
forall e: symbol,
forall s: sf,
forall l: slist,
In s l ->
In (e :: s) (concat_symbol e l).
Proof.
intros e s l.
generalize dependent e.
generalize dependent s.
induction l.
- intros s e H1.
  simpl in H1.
  contradiction.
- intros s e H1.
  simpl in H1.
  simpl.
  destruct H1 as [H1 | H1].
  + left.
    rewrite H1.
    reflexivity.
  + right.
    specialize (IHl s e H1).
    exact IHl.
Qed.

Lemma concat_symbol_app_right:
forall s: symbol,
forall l1 l2: slist,
concat_symbol s (l1 ++ l2) = concat_symbol s l1 ++ concat_symbol s l2.
Proof.
intros s.
induction l1.
- simpl.
  reflexivity.
- intros l2.
  simpl.
  rewrite IHl1.
  reflexivity.
Qed.

Fixpoint concat_list (l1: vlist) (l2: slist): slist:=
match l1 with
| [] => []
| s :: l1' => (concat_symbol s l2) ++ (concat_list l1' l2)
end.

Lemma concat_list_correct:
forall l1: vlist,
forall l2: slist,
forall s: symbol,
forall l: sf,
In s l1 ->
In l l2 ->
In (s :: l) (concat_list l1 l2).
Proof.
intros l1.
induction l1.
- intros l2 s l H1 H2.
  simpl in H1.
  contradiction.
- intros l2 s l H1 H2.
  simpl in H1.
  simpl.
  apply in_or_app.
  destruct H1 as [H1 | H1].
  + subst.
    left.
    apply concat_symbol_correct.
    exact H2.
  + right.
    apply IHl1.
    * exact H1.
    * exact H2.
Qed.

Lemma concat_list_app_left:
forall v1 v2: vlist,
forall l: slist,
concat_list (v1 ++ v2) l = concat_list (v1) l ++ concat_list (v2) l.
Proof.
induction v1.
- simpl.
  reflexivity.
- intros v2 l.
  simpl.
  rewrite (IHv1 v2 l).
  rewrite <- app_assoc.
  reflexivity.
Qed.

Lemma concat_list_app_right:
forall s: symbol,
forall l1 l2: slist,
concat_list [s] (l1 ++ l2) = concat_list [s] l1 ++ concat_list [s] l2.
Proof.
induction l1.
- intros l2.
  simpl.
  reflexivity.
- intros l2.
  simpl.
  repeat rewrite app_nil_r.
  rewrite concat_symbol_app_right.
  reflexivity.
Qed.

Lemma concat_list_empty:
forall s: symbol,
forall v1 v2: vlist,
In [s] (concat_list (v1 ++ s :: v2) [[]]).
Proof.
intros s v1 v2.
rewrite concat_list_app_left.
apply in_or_app.
right.
simpl.
left.
reflexivity.
Qed.

Lemma concat_list_non_empty:
forall s: symbol,
forall s0: sf,
forall v1 v2: vlist,
forall l1 l2: slist,
In (s :: s0) (concat_list (v1 ++ s :: v2) (l1 ++ s0 :: l2)).
Proof.
intros s s0 v1 v2 l1 l2.
rewrite concat_list_app_left.
apply in_or_app.
right.
change (s :: v2) with ([s] ++ v2).
rewrite concat_list_app_left.
apply in_or_app.
left.
rewrite concat_list_app_right.
apply in_or_app.
right.
simpl.
left.
reflexivity.
Qed.

Fixpoint all_sf_with (n: nat) (v: vlist): slist:=
match n with
| O => [[]]
| S n' => concat_list v (all_sf_with n' v)
end.

Fixpoint all_sf_up_to (n: nat) (v: vlist): slist:=
match n with
| O => [[]]
| S n' => (all_sf_with n v) ++ (all_sf_up_to n' v)
end.

Lemma all_sf_with_correct:
forall v: vlist,
forall s: sf,
forall n: nat,
(forall e: symbol, In e s -> In e v) ->
length s = n ->
In s (all_sf_with n v).
Proof.
intros v s n.
generalize dependent v.
generalize dependent s.
induction n.
- intros s v H0 H1.
  apply length_zero in H1.
  rewrite H1.
  simpl.
  left.
  reflexivity.
- intros s v H0 H1.
  simpl.
  destruct s.
  + simpl in H1.
    discriminate.
  + simpl in H1.
    apply eq_add_S in H1.
    apply concat_list_correct.
    * apply H0.
      simpl.
      left.
      reflexivity.
    * {
      apply IHn.
      - intros e H2.
        apply H0.
        change (s :: s0) with ([s] ++ s0).
        apply in_or_app.
        right.
        exact H2.
      - exact H1.
      }
Qed.

End AllRules.