From Coq Require Import Ensembles.
From Coq Require Import List.
From Coq Require Import Arith.
From hydras.Ackermann Require Import folProp.
From hydras.Ackermann Require Import folProof.
From hydras.Ackermann Require Import folReplace.
From hydras.Ackermann Require Import folLogic3.
From hydras.Ackermann Require Import subProp.
From hydras.Ackermann Require Import ListExt.
From Goedel Require Import fixPoint.
From Goedel Require Import codeSysPrf.
From hydras.Ackermann Require Import NNtheory.
From hydras.Ackermann Require Import code.
From Goedel Require Import PRrepresentable.
From hydras.Ackermann Require Import expressible.
From hydras.Ackermann Require Import checkPrf.
From hydras.Ackermann Require Import codeNatToTerm.

Section Rosser's_Incompleteness.

Definition codeFormula := codeFormula LNN codeLNTFunction codeLNNRelation.

Variable T : System.

Hypothesis extendsNN : Included _ NN T.

Variable repT : Formula.
Variable v0 : nat.
Hypothesis
  freeVarRepT : forall v : nat, In v (freeVarFormula LNN repT) -> v = v0.
Hypothesis
  expressT1 :
    forall f : Formula,
    mem _ T f ->
    SysPrf T (substituteFormula LNN repT v0 (natToTerm (codeFormula f))).
Hypothesis
  expressT2 :
    forall f : Formula,
    ~ mem _ T f ->
    SysPrf T
      (notH (substituteFormula LNN repT v0 (natToTerm (codeFormula f)))).

Definition codeSysPrf :=
  codeSysPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
    codeArityLNTFIsPR codeArityLNNRIsPR repT v0.

Definition codeSysPrfCorrect1 :=
  codeSysPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT1.

Definition codeSysPrfCorrect2 :=
  codeSysPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT2.

Definition codeSysPrfCorrect3 :=
  codeSysPrfCorrect3 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNNRIsPR codeArityLNNRIsCorrect1
    codeArityLNNRIsCorrect2 codeLNTFunctionInj codeLNNRelationInj T extendsNN.

Definition codePrf := codePrf LNN codeLNTFunction codeLNNRelation.

Definition codeSysPrfNot :=
  codeSysPrfNot LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0.

Definition freeVarCodeSysPrfN :=
  freeVarCodeSysPrfN LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0 freeVarRepT.

Definition codeSysPrfNCorrect1 :=
  codeSysPrfNCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT1.

Definition codeSysPrfNCorrect2 :=
  codeSysPrfNCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1 codeArityLNNRIsPR
    codeArityLNNRIsCorrect1 T extendsNN T repT v0 freeVarRepT expressT2.

Definition codeSysPrfNCorrect3 :=
  codeSysPrfNCorrect3 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNTFIsCorrect1
    codeArityLNTFIsCorrect2 codeArityLNNRIsPR codeArityLNNRIsCorrect1
    codeArityLNNRIsCorrect2 codeLNTFunctionInj codeLNNRelationInj T extendsNN
    repT v0 freeVarRepT.

Lemma decideAxioms :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 forall x : Formulas,
 (forall g : Formula, In g x -> mem _ T g) \/
 (exists g : Formula, In g x /\ ~ mem _ T g).
Proof.
intros.
induction x as [| a x Hrecx].
left.
intros.
elim H0.
induction Hrecx as [H0| H0].
induction (H a).
left.
intros.
induction H2 as [H2| H2].
rewrite <- H2.
assumption.
auto.
right.
exists a.
split.
auto with datatypes.
assumption.
right.
induction H0 as (x0, H0).
exists x0.
induction H0 as (H0, H1).
auto with datatypes.
Qed.

Lemma searchProof :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 forall (a b : Formula) (A : Formulas) (p : Prf LNN A a),
 (exists B : Formulas,
    (exists q : Prf LNN B b,
       codePrf _ _ q < S (codePrf _ _ p) /\
       (forall x : Formula, In x B -> mem _ T x))) \/
 (forall (B : Formulas) (q : Prf LNN B b),
  codePrf _ _ q < S (codePrf _ _ p) ->
  exists g : Formula, In g B /\ ~ mem _ T g).
Proof.
intros.
induction (S (codePrf A a p)).
right.
intros.
elim (Nat.nlt_0_r _ H0).
induction IHn as [H0| H0].
left.
decompose record H0.
exists x.
exists x0.
auto.
induction
 (eq_nat_dec
    (checkPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
       (codeFormula b) n) 0).
right.
intros.
induction (proj1 (Nat.lt_eq_cases _ _) (proj1 (Nat.lt_succ_r _ _) H1)).
eauto.
rewrite <- H2 in a0.
rewrite
 (checkPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNNRIsCorrect1)
  in a0.
discriminate a0.
decompose record
 (checkPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNNRIsCorrect1 codeArityLNNRIsCorrect2 codeLNTFunctionInj
    codeLNNRelationInj _ _ b0).
assert (x = b).
eapply codeFormulaInj.
apply codeLNTFunctionInj.
apply codeLNNRelationInj.
assumption.
rewrite <- H1.
induction (decideAxioms H x0).
left.
exists x0.
exists x1.
unfold codePrf in |- *.
rewrite H3.
auto.
right.
intros.
induction (proj1 (Nat.lt_eq_cases _ _) (proj1 (Nat.lt_succ_r _ _) H5)).
rewrite <- H1 in H0.
eauto.
assert (B = x0).
eapply (codePrfInjAxm LNN) with (p := q) (q := x1).
apply codeLNTFunctionInj.
apply codeLNNRelationInj.
transitivity n.
unfold codePrf in H6.
apply H6.
symmetry  in |- *.
apply H3.
rewrite H7.
assumption.
Qed.

(*To prove the strong contructive result we need the decidability of T*)

Theorem Rosser'sIncompleteness :
 (forall x : Formula, mem _ T x \/ ~ mem _ T x) ->
 exists f : Formula,
   (forall v : nat, ~ In v (freeVarFormula LNN f)) /\
   (SysPrf T f \/ SysPrf T (notH f) -> Inconsistent LNN T).
Proof.
intros decide.
set
 (A :=
  forallH 1
    (impH codeSysPrf
       (existH 2
          (andH (LT (var 2) (var 1))
             (substituteFormula LNN codeSysPrfNot 1 (var 2))))))
 in *.
destruct (FixPointLNN A 0) as [x [H0 H1]].
exists x.
split.
unfold not in |- *; intros.
induction (H1 v).
assert (In v (list_remove nat eq_nat_dec 0 (freeVarFormula LNN A))).
apply H2.
assumption.
unfold A in H4.
SimplFreeVar.
assert (v <= 1).
apply
 (freeVarCodeSysPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0 freeVarRepT).
apply H5.
destruct v as [| n].
apply H6.
reflexivity.
destruct n.
apply H7.
reflexivity.
apply (Nat.le_ngt (S (S n)) 1).
assumption.
apply (proj1 (Nat.succ_lt_mono _ _)).
apply Nat.lt_0_succ.
assert (v <= 1).
apply freeVarCodeSysPrfN.
assumption.
destruct v as [| n].
apply H6.
reflexivity.
destruct n.
apply H7.
reflexivity.
apply (Nat.le_ngt (S (S n)) 1).
assumption.
apply (proj1 (Nat.succ_lt_mono _ _)).
apply Nat.lt_0_succ.
intros.
induction H as [H| H].
unfold Inconsistent in |- *.
intros.
elim H.
intros.
induction H2 as (x1, H2).
induction (searchProof decide _ (notH x) _ x1).
decompose record H3.
apply contradiction with x.
assumption.
exists x2.
exists x3.
assumption.
apply
 contradiction
  with
    (existH 2
       (andH (LT (var 2) (natToTerm (codePrf _ _ x1)))
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrfNot 0
                (natToTerm (codeFormula x))) 1 (var 2)))).
apply
 impE
  with
    (existH 2
       (andH (LT (var 2) (natToTerm (codePrf x0 x x1)))
          (substituteFormula LNN
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrfNot 0
                   (natToTerm (codeFormula x))) 1 (var 2)) 1
             (natToTerm (codePrf _ _ x1))))).
apply iffE1.
apply sysExtend with NN.
apply extendsNN.
apply (reduceExist LNN).
apply closedNN.
apply (reduceAnd LNN).
apply iffRefl.
apply (subFormulaNil LNN).
unfold not in |- *; intros.
induction (freeVarSubFormula3 _ _ _ _ _ H4).
apply (In_list_remove2 _ _ _ _ _ H5).
reflexivity.
simpl in H5.
decompose sum H5.
discriminate H6.
replace (LT (var 2) (natToTerm (codePrf _ _ x1))) with
 (substituteFormula LNN (LT (var 2) (var 1)) 1 (natToTerm (codePrf _ _ x1))).
rewrite <- (subFormulaAnd LNN).
apply
 impE
  with
    (existH 2
       (substituteFormula LNN
          (fol.andH LNN (LT (var 2) (var 1))
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrfNot 1 (var 2)) 0
                (natToTerm (codeFormula x)))) 1 (natToTerm (codePrf x0 x x1)))).
apply iffE1.
apply sysExtend with NN.
apply extendsNN.
apply (reduceExist LNN).
apply closedNN.
apply (reduceSub LNN).
apply closedNN.
apply (reduceAnd LNN).
apply iffRefl.
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros.
simpl in H4.
decompose sum H4.
discriminate H5.
apply closedNatToTerm.
replace (LT (var 2) (var 1)) with
 (substituteFormula LNN (LT (var 2) (var 1)) 0 (natToTerm (codeFormula x))).
rewrite <- (subFormulaAnd LNN).
replace
 (existH 2
    (substituteFormula LNN
       (substituteFormula LNN
          (fol.andH LNN (LT (var 2) (var 1))
             (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
          (natToTerm (codeFormula x))) 1 (natToTerm (codePrf x0 x x1)))) with
 (substituteFormula LNN
    (existH 2
       (substituteFormula LNN
          (fol.andH LNN (LT (var 2) (var 1))
             (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
          (natToTerm (codeFormula x)))) 1 (natToTerm (codePrf x0 x x1))).
replace
 (existH 2
    (substituteFormula LNN
       (fol.andH LNN (LT (var 2) (var 1))
          (substituteFormula LNN codeSysPrfNot 1 (var 2))) 0
       (natToTerm (codeFormula x)))) with
 (substituteFormula LNN
    (existH 2
       (fol.andH LNN (LT (var 2) (var 1))
          (substituteFormula LNN codeSysPrfNot 1 (var 2)))) 0
    (natToTerm (codeFormula x))).
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN codeSysPrf 0 (natToTerm (codeFormula x))) 1
       (natToTerm (codePrf _ _ x1))).
repeat rewrite <- (subFormulaImp LNN).
apply forallE.
replace
 (forallH 1
    (substituteFormula LNN
       (fol.impH LNN codeSysPrf
          (existH 2
             (fol.andH LNN (LT (var 2) (var 1))
                (substituteFormula LNN codeSysPrfNot 1 (var 2))))) 0
       (natToTerm (codeFormula x)))) with
 (substituteFormula LNN
    (forallH 1
       (fol.impH LNN codeSysPrf
          (existH 2
             (fol.andH LNN (LT (var 2) (var 1))
                (substituteFormula LNN codeSysPrfNot 1 (var 2)))))) 0
    (natToTerm (codeFormula x))).
apply impE with x.
apply iffE1.
apply sysExtend with NN.
apply extendsNN.
apply H0.
assumption.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec 1 0).
discriminate a.
induction (In_dec eq_nat_dec 1 (freeVarTerm LNN (natToTerm (codeFormula x)))).
elim (closedNatToTerm _ _ a).
reflexivity.
apply codeSysPrfCorrect1.
assumption.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 0).
discriminate a.
induction (In_dec eq_nat_dec 2 (freeVarTerm LNN (natToTerm (codeFormula x)))).
elim (closedNatToTerm _ _ a).
reflexivity.
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 1).
discriminate a.
induction
 (In_dec eq_nat_dec 2 (freeVarTerm LNN (natToTerm (codePrf x0 x x1)))).
elim (closedNatToTerm _ _ a).
reflexivity.
unfold LT in |- *.
rewrite (subFormulaRelation LNN).
simpl in |- *.
reflexivity.
unfold LT in |- *.
rewrite (subFormulaRelation LNN).
simpl in |- *.
reflexivity.
apply nExist.
set
 (E :=
  nat_rec (fun _ => Formula) (equal Zero Zero)
    (fun (n : nat) (rec : Formula) =>
     andH
       (notH
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrfNot 0
                (natToTerm (codeFormula x))) 1 (natToTerm n))) rec)
    (codePrf x0 x x1)) in *.
assert (forall x : nat, ~ In x (freeVarFormula LNN E)).
unfold E in |- *.
clear H3 E.
induction (codePrf x0 x x1).
simpl in |- *.
auto.
intros.
unfold nat_rec, nat_rect in |- *.
unfold not in |- *; intros.
set
 (Q :=
  (fix F (n : nat) : (fun _ : nat => Formula) n :=
     match n with
     | O => equal Zero Zero
     | S n0 =>
         (fun (n1 : nat) (rec : Formula) =>
          andH
            (notH
               (substituteFormula LNN
                  (substituteFormula LNN codeSysPrfNot 0
                     (natToTerm (codeFormula x))) 1
                  (natToTerm n1))) rec) n0 (F n0)
     end) n) in *.
SimplFreeVar.
apply (Nat.le_ngt x2 1).
apply freeVarCodeSysPrfN.
assumption.
destruct x2 as [| n0].
elim H6; reflexivity.
destruct n0.
elim H5; reflexivity.
apply (proj1 (Nat.succ_lt_mono _ _)).
apply Nat.lt_0_succ.
apply (IHn x2 H3).
apply impE with E.
apply sysExtend with NN.
apply extendsNN.
apply impI.
apply forallI.
unfold not in |- *; intros.
induction H5 as (x2, H5).
induction H5 as (H5, H6).
induction H6 as [x2 H6| x2 H6].
apply (closedNN 2).
exists x2.
auto.
induction H6.
apply (H4 2).
assumption.
apply nAnd.
unfold orH, fol.orH in |- *.
apply impTrans with (LT (var 2) (natToTerm (codePrf x0 x x1))).
apply impI.
apply nnE.
apply Axm; right; constructor.
apply impI.
apply impE with E.
apply impE with (LT (var 2) (natToTerm (codePrf x0 x x1))).
do 2 apply sysWeaken.
apply boundedLT.
intros.
rewrite (subFormulaImp LNN).
rewrite (subFormulaNot LNN).
apply
 impE
  with
    (fol.impH LNN E
       (fol.notH LNN
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrfNot 0
                (natToTerm (codeFormula x))) 1 (natToTerm n)))).
apply iffE2.
apply (reduceImp LNN).
apply (subFormulaNil LNN).
apply H4.
apply (reduceNot LNN).
apply (subFormulaTrans LNN).
unfold not in |- *; intros.
SimplFreeVar.
apply (Nat.le_ngt 2 1).
apply freeVarCodeSysPrfN.
assumption.
apply Nat.lt_succ_diag_r.
unfold E in |- *.
clear E H4 H3.
apply impI.
induction (codePrf x0 x x1).
elim (Nat.nlt_0_r _ H5).
unfold nat_rec, nat_rect in |- *.
set
 (Q :=
  (fix F (n1 : nat) : (fun _ : nat => Formula) n1 :=
     match n1 with
     | O => equal Zero Zero
     | S n2 =>
         (fun (n3 : nat) (rec : Formula) =>
          andH
            (notH
               (substituteFormula LNN
                  (substituteFormula LNN codeSysPrfNot 0
                     (natToTerm (codeFormula x))) 1
                  (natToTerm n3))) rec) n2 (F n2)
     end) n0) in *.
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H5)).
apply impE with Q.
apply sysWeaken.
apply impI.
apply (IHn0 H3).
eapply andE2.
apply Axm; right; constructor.
rewrite H3.
eapply andE1.
apply Axm; right; constructor.
apply Axm; right; constructor.
apply Axm; left; right; constructor.
unfold E in |- *.
clear H4 E.
induction (codePrf x0 x x1).
simpl in |- *.
apply eqRefl.
simpl in |- *.
apply andI.
induction
 (eq_nat_dec
    (checkPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
       (codeFormula (notH x)) n) 0).
unfold codeSysPrfNot in |- *.
apply codeSysPrfNCorrect3.
unfold not in |- *; intros.
rewrite H4 in a.
rewrite
 (checkPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNNRIsCorrect1)
  in a.
discriminate a.
decompose record
 (checkPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNNRIsCorrect1 codeArityLNNRIsCorrect2 codeLNTFunctionInj
    codeLNNRelationInj _ _ b).
rewrite <- H6.
assert (x2 = notH x).
eapply codeFormulaInj.
apply codeLNTFunctionInj.
apply codeLNNRelationInj.
assumption.
cut (code.codePrf LNN codeLNTFunction codeLNNRelation x3 x2 x4 = n).
generalize x4.
clear H6 x4.
rewrite H4.
intros.
apply codeSysPrfNCorrect2.
eapply H3.
apply Nat.lt_lt_succ_r.
rewrite <- H6.
apply Nat.lt_succ_diag_r.
assumption.
apply IHn.
intros.
eapply H3.
apply Nat.lt_lt_succ_r.
apply H4.
unfold Inconsistent in |- *.
intros.
elim H.
intros.
induction H2 as (x1, H2).
induction (searchProof decide _ x _ x1).
decompose record H3.
apply contradiction with x.
exists x2.
exists x3.
assumption.
assumption.
apply
 contradiction
  with
    (substituteFormula LNN A 0
       (natToTermLNN (code.codeFormula LNN codeLNTFunction codeLNNRelation x))).
unfold A in |- *.
rewrite (subFormulaForall LNN).
induction (eq_nat_dec 1 0).
discriminate a.
induction
 (In_dec eq_nat_dec 1
    (freeVarTerm LNN
       (natToTermLNN (code.codeFormula LNN codeLNTFunction codeLNNRelation x)))).
elim (closedNatToTerm _ _ a).
clear b0 b.
set
 (E :=
  nat_rec (fun _ => Formula) (equal Zero Zero)
    (fun (n : nat) (rec : Formula) =>
     andH
       (notH
          (substituteFormula LNN
             (substituteFormula LNN codeSysPrf 0 (natToTerm (codeFormula x)))
             1 (natToTerm n))) rec) (S (codePrf _ _ x1)))
 in *.
assert (forall x : nat, ~ In x (freeVarFormula LNN E)).
unfold E in |- *.
clear H3 E.
induction (S (codePrf x0 (notH x) x1)).
simpl in |- *.
auto.
intros.
unfold nat_rec, nat_rect in |- *.
unfold not in |- *; intros.
SimplFreeVar.
apply (le_not_lt x2 1).
apply
 (freeVarCodeSysPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsPR codeArityLNNRIsPR repT v0 freeVarRepT).
apply H4.
destruct x2 as [| n0].
elim H6; reflexivity.
destruct n0.
elim H5; reflexivity.
apply lt_n_S.
apply Nat.lt_0_succ.
apply (IHn _ H3).
apply impE with E.
set
 (G :=
  substituteFormula LNN
    (substituteFormula LNN codeSysPrfNot 0 (natToTerm (codeFormula x))) 1
    (natToTerm (codePrf x0 (notH x) x1))) in *.
apply impE with G.
apply sysExtend with NN.
assumption.
repeat apply impI.
apply forallI.
unfold not in |- *; intros.
induction H5 as (x2, H5); induction H5 as (H5, H6).
induction H6 as [x2 H6| x2 H6].
induction H6 as [x2 H6| x2 H6].
apply (closedNN 1).
exists x2.
auto.
induction H6.
unfold G in H5.
SimplFreeVar.
induction H6.
apply (H4 _ H5).
rewrite (subFormulaImp LNN).
rewrite (subFormulaExist LNN).
induction (eq_nat_dec 2 0).
discriminate a.
induction
 (In_dec eq_nat_dec 2
    (freeVarTerm LNN
       (natToTermLNN (code.codeFormula LNN codeLNTFunction codeLNNRelation x)))).
elim (closedNatToTerm _ _ a).
clear b0 b.
rewrite (subFormulaAnd LNN).
replace
 (substituteFormula LNN (LT (var 2) (var 1)) 0
    (natToTermLNN (code.codeFormula LNN codeLNTFunction codeLNNRelation x)))
 with (LT (var 2) (var 1)).
apply
 orE
  with
    (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
       (equal (var 1) (natToTerm (codePrf x0 (notH x) x1))))
    (LT (natToTerm (codePrf x0 (notH x) x1)) (var 1)).
repeat simple apply sysWeaken.
apply
 impE
  with
    (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
       (orH (equal (var 1) (natToTerm (codePrf x0 (notH x) x1)))
          (LT (natToTerm (codePrf x0 (notH x) x1)) (var 1)))).
apply impI.
apply orSys.
apply orI1.
apply orI1.
apply Axm; right; constructor.
apply orSys.
apply orI1.
apply orI2.
apply Axm; right; constructor.
apply orI2.
apply Axm; right; constructor.
apply nn9.
apply impI.
apply impE with G.
apply impE with E.
apply impE with (LT (var 1) (natToTerm (S (codePrf x0 (notH x) x1)))).
repeat simple apply sysWeaken.
apply boundedLT.
intros.
repeat apply impE.
repeat rewrite (subFormulaImp LNN).
repeat apply impI.
fold codeFormula in |- *.
apply
 contradiction
  with
    (substituteFormula LNN
       (substituteFormula LNN codeSysPrf 0 (natToTermLNN (codeFormula x))) 1
       (natToTerm n)).
apply Axm; right; constructor.
apply sysWeaken.
apply impE with E.
repeat simple apply sysWeaken.
apply impI.
clear H3.
clear H4.
induction (S (codePrf x0 (notH x) x1)).
elim (Nat.nlt_0_r _ H5).
induction (le_lt_or_eq _ _ (lt_n_Sm_le _ _ H5)).
unfold E in |- *.
apply
 impE
  with
    (nat_rec (fun _ : nat => Formula) (equal Zero Zero)
       (fun (n : nat) (rec : Formula) =>
        andH
          (notH
             (substituteFormula LNN
                (substituteFormula LNN codeSysPrf 0
                   (natToTerm (codeFormula x))) 1 (natToTerm n))) rec) n0).
apply sysWeaken.
repeat apply impI.
apply IHn0.
assumption.
simpl in |- *.
eapply andE2.
apply Axm; right; constructor.
unfold E in |- *.
simpl in |- *.
rewrite H3.
eapply andE1.
apply Axm; right; constructor.
apply impE with (substituteFormula LNN E 1 (natToTerm n)).
apply iffE1.
apply (subFormulaNil LNN).
apply H4.
apply Axm; left; right; constructor.
apply
 impE
  with
    (orH (LT (var 1) (natToTerm (codePrf x0 (notH x) x1)))
       (equal (var 1) (natToTerm (codePrf x0 (notH x) x1)))).
repeat simple apply sysWeaken.
simpl in |- *.
apply nnPlusNotNeeded.
apply Axm; right; constructor.
apply Axm; left; right; constructor.
apply Axm; do 2 left; right; constructor.
repeat apply impI.
apply sysWeaken.
apply existI with (natToTerm (codePrf x0 (notH x) x1)).
rewrite (subFormulaAnd LNN).
apply andI.
unfold LT in |- *.
rewrite (subFormulaRelation LNN).
simpl in |- *.
apply Axm; right; constructor.
apply sysWeaken.
apply sysWeaken.
apply
 impE
  with
    (substituteFormula LNN
       (substituteFormula LNN codeSysPrfNot 0 (natToTerm (codeFormula x))) 1
       (natToTerm (codePrf x0 (notH x) x1))).
apply sysWeaken.
apply iffE2.
fold codeFormula in |- *.
apply
 iffTrans
  with
    (substituteFormula LNN
       (substituteFormula LNN
          (substituteFormula LNN codeSysPrfNot 0
             (natToTermLNN (codeFormula x))) 1 (var 2)) 2
       (natToTerm (codePrf x0 (notH x) x1))).
repeat (apply (reduceSub LNN); [ apply closedNN | idtac ]).
apply (subFormulaExch LNN).
discriminate.
unfold not in |- *; intros; SimplFreeVar.
discriminate H6.
apply closedNatToTerm.
apply (subFormulaTrans LNN).
unfold not in |- *; intros; SimplFreeVar.
apply (le_not_lt 2 1).
apply freeVarCodeSysPrfN.
assumption.
apply Nat.lt_succ_diag_r.
apply Axm; right; constructor.
unfold LT in |- *.
rewrite (subFormulaRelation LNN).
reflexivity.
unfold G in |- *.
apply codeSysPrfNCorrect1.
assumption.
clear H4.
unfold E in |- *; clear E.
induction (S (codePrf x0 (notH x) x1)).
simpl in |- *.
apply eqRefl.
simpl in |- *.
apply andI.
induction
 (eq_nat_dec
    (checkPrf LNN codeLNTFunction codeLNNRelation codeArityLNTF codeArityLNNR
       (codeFormula x) n) 0).
unfold codeSysPrf, codeFormula in |- *.
apply codeSysPrfCorrect3.
unfold not in |- *; intros.
rewrite H4 in a.
rewrite
 (checkPrfCorrect1 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNNRIsCorrect1)
  in a.
discriminate a.
decompose record
 (checkPrfCorrect2 LNN codeLNTFunction codeLNNRelation codeArityLNTF
    codeArityLNNR codeArityLNTFIsCorrect1 codeArityLNTFIsCorrect2
    codeArityLNNRIsCorrect1 codeArityLNNRIsCorrect2 codeLNTFunctionInj
    codeLNNRelationInj _ _ b).
rewrite <- H6.
assert (x2 = x).
eapply (codeFormulaInj LNN).
apply codeLNTFunctionInj.
apply codeLNNRelationInj.
assumption.
rewrite <- H4.
apply codeSysPrfCorrect2.
rewrite <- H4 in H3.
apply H3 with x4.
rewrite <- H6.
apply Nat.lt_succ_diag_r.
apply IHn.
intros.
eapply H3.
apply Nat.lt_lt_succ_r.
apply H4.
apply impE with (notH x).
apply cp2.
apply iffE2.
apply sysExtend with NN.
apply extendsNN.
assumption.
assumption.
Qed.

End Rosser's_Incompleteness.

Definition RepresentsInSelf (T:System) :=
exists rep:Formula, exists v:nat,
(forall x : nat, In x (freeVarFormula LNN rep) -> x = v)  /\
(forall f : Formula,
        mem Formula T f ->
        SysPrf T (substituteFormula LNN rep v (natToTerm (codeFormula f)))) /\
(forall f : Formula,
        ~ mem Formula T f ->
        SysPrf T
          (notH (substituteFormula LNN rep v (natToTerm (codeFormula f))))).

Definition DecidableSet (A:_)(s:Ensemble A) :=
(forall x : A,
        mem A s x \/
        ~ mem A s x).

Theorem Incompleteness :
       forall T : System,
       Included Formula NN T ->
       RepresentsInSelf T ->
       DecidableSet Formula T ->
       exists f : Formula,
         (Sentence f) /\
         (SysPrf T f \/ SysPrf T (notH f) -> Inconsistent LNN T).
Proof.
intros.
repeat induction H0.
apply Rosser'sIncompleteness with x x0; auto; tauto.
Qed.


Require Import PeanoNat Le Gt Minus Bool Lt List Arith Nat Omega ExtensionalityFacts Logic.
Import ListNotations.
From Block
Require Import lib definitions ramsey.

(* ***************** *)
(* **** Closure **** *)
(* ***************** *)

(* Closure properties of block-pumpable languages *)
Lemma paranoia : forall {X : Type} (P : Prop) (Q : X -> Prop),
    (forall x : X, P -> Q x) <-> (P -> forall x, Q x).
Proof.
  intros; split; intros.
  spec H x H0. assumption.
  spec H H0.
  exact (H x).
Qed.

(* Paper states result for two languages with the same pumping constant! *)
Lemma bp_intersect_closure : forall (l1 l2 : language) (k1: block_pumping_constant),
    block_pumpable_with k1 l1 ->
    block_pumpable_with k1 l2 ->
    exists k' : block_pumping_constant,
      block_pumpable_with k' (intersection_lang l1 l2).
Proof.
  intros l1 l2 k H_L H_L'.
  assert (H_ramsey := Theorem_of_Ramsey_duo_prop k).
  destruct H_ramsey as [k' [H_lt H_ramsey]].
  exists k'.
  intros w H_mem bps.
  spec H_ramsey w bps (is_pump l1 w).
  destruct H_mem as [H_mem H_mem'].
  destruct H_ramsey as [bps' [H_sublist H_ramsey]].
  spec H_L w H_mem bps'; spec H_L' w H_mem' bps'.
  destruct H_ramsey as [left | right].
  + (* case1 : is pump for L1 *)
    destruct H_L' as [bp1 [bp2 H_L']].
    spec left bp1 bp2.
    destruct H_L' as [H_lt' H_L']; spec left H_lt'.
    destruct bp1 as [bp1 about_bp1];
      destruct bp2 as [bp2 about_bp2].
    assert (breakpoint_predicate bp1 k' w bps).
    { unfold breakpoint_predicate.
        unfold sublist in H_sublist;
        spec H_sublist bp1 about_bp1;
        assumption. }
    assert (breakpoint_predicate bp2 k' w bps).
    { unfold breakpoint_predicate.
        unfold sublist in H_sublist;
        spec H_sublist bp2 about_bp2;
        assumption. }
    exists (exist _ bp1 H).
    exists (exist _ bp2 H0).
    split; simpl. assumption.
    intro m; unfold intersection_lang; split.
    unfold is_pump in left. simpl in *.
    spec left m. assumption.
    spec H_L' m. exact H_L'.
  + (* case2 : is not pump for L1 *)
    destruct H_L as [bp1 [bp2 H_L]].
    spec right bp1 bp2. clear H_lt.
    destruct H_L as [H_lt H_L]; spec right H_lt.
    unfold is_pump in right.
    exfalso. apply right.
    intro m.
    exact (H_L m).
Qed.
(* This uses LEM *)

Lemma bp_union_closure : forall (l1 l2 : language) (k : block_pumping_constant),
    block_pumpable_with k l1 ->
    block_pumpable_with k l2 ->
    exists k' : block_pumping_constant,
      block_pumpable_with k' (union_lang l1 l2).
Proof.
  intros l1 l2 k H_L H_L'.
  assert (H_ramsey := Theorem_of_Ramsey_duo_prop k).
  destruct H_ramsey as [k' [_ H_ramsey]].
  exists k'.
  intros w H_mem bps.
  spec H_ramsey w bps (is_pump l1 w).
  destruct H_ramsey as [bps' [H_sublist [left | right]]].
  ++ (* case1 : is pump for L1 *)
     destruct H_mem as [H_mem | H_mem'].
    +++ spec H_L w H_mem bps'.
        destruct H_L as [bp1 [bp2 [H_lt H_L]]].
        spec left bp1 bp2 H_lt; unfold is_pump in left.
        assert (breakpoint_predicate bp1 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp1 as [bp1 about_bp1];
            unfold sublist in H_sublist;
            spec H_sublist bp1 about_bp1;
            assumption. }
        assert (breakpoint_predicate bp2 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp2 as [bp2 about_bp2];
            unfold sublist in H_sublist;
            spec H_sublist bp2 about_bp2;
            assumption. }
        destruct bp1 as [bp1 about_bp1];
          destruct bp2 as [bp2 about_bp2].
        exists (exist _ bp1 H).
        exists (exist _ bp2 H0).
        split; simpl in *. exact H_lt.
        intro m.
        left; spec H_L m; assumption.
    +++ spec H_L' w H_mem' bps'.
        destruct H_L' as [bp1 [bp2 [H_lt H_L']]].
        spec left bp1 bp2 H_lt; unfold is_pump in left.
        assert (breakpoint_predicate bp1 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp1 as [bp1 about_bp1];
            unfold sublist in H_sublist;
            spec H_sublist bp1 about_bp1;
            assumption. }
        assert (breakpoint_predicate bp2 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp2 as [bp2 about_bp2];
        unfold sublist in H_sublist;
        spec H_sublist bp2 about_bp2;
        assumption. }
        destruct bp1 as [bp1 about_bp1];
          destruct bp2 as [bp2 about_bp2].
        exists (exist _ bp1 H).
        exists (exist _ bp2 H0).
        split; simpl in *. exact H_lt.
        intro m.
        right; spec H_L' m; assumption.
  ++ (* case1 : is not pump for L1 *)
    destruct H_mem as [H_mem | H_mem'].
    +++ spec H_L w H_mem bps'.
        destruct H_L as [bp1 [bp2 [H_lt H_L]]].
        spec right bp1 bp2 H_lt; unfold is_pump in right.
        assert (breakpoint_predicate bp1 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp1 as [bp1 about_bp1];
            unfold sublist in H_sublist;
            spec H_sublist bp1 about_bp1;
            assumption. }
        assert (breakpoint_predicate bp2 k' w bps).
        { unfold breakpoint_predicate.
          destruct bp2 as [bp2 about_bp2];
            unfold sublist in H_sublist;
            spec H_sublist bp2 about_bp2;
            assumption. }
        destruct bp1 as [bp1 about_bp1];
          destruct bp2 as [bp2 about_bp2].
        exists (exist _ bp1 H).
        exists (exist _ bp2 H0).
        split; simpl in *. exact H_lt.
        intro m.
        left; spec H_L m; assumption.
    +++ spec H_L' w H_mem' bps'.
        destruct H_L' as [bp1 [bp2 [H_lt H_L']]].
    destruct bp1 as [bp1 about_bp1];
      destruct bp2 as [bp2 about_bp2].
    assert (breakpoint_predicate bp1 k' w bps).
    { unfold breakpoint_predicate.
        unfold sublist in H_sublist;
        spec H_sublist bp1 about_bp1;
        assumption. }
    assert (breakpoint_predicate bp2 k' w bps).
    { unfold breakpoint_predicate.
        unfold sublist in H_sublist;
        spec H_sublist bp2 about_bp2;
        assumption. }
    exists (exist _ bp1 H).
    exists (exist _ bp2 H0).
    split; simpl in *. assumption.
    intro m. spec H_L' m; right; assumption.
Qed.
(* This uses LEM *)

Lemma bp_concat_closure : forall (l1 l2 : language) (k : block_pumping_constant),
    block_pumpable_with k l1 ->
    block_pumpable_with k l2 ->
    exists k' : block_pumping_constant,
      block_pumpable_with k' (concat_lang l1 l2).
Proof.
  intros L L' k H_L H_L'.
  (** Constructing block pumping constant **)
  assert (p_predicate (k+k)).
  { destruct k as [k about_k]; unfold p_predicate in *; simpl; omega. }
  (* The new block pumping constant is 2k *)
  exists (exist _ (k+k) H); intros w H_mem bps.
  destruct H_mem as [w1 [w2 [H_split [H_mem1 H_mem2]]]].
  (** Case analysis on breakpoints position in word **)
  (* Either all of w1's breakpoints are in itself,
     or all of w2's breakpoints are in itself *)
  assert (nth (k-1) bps definitions.d <= (length w1) \/ (length w1) < nth (k-1) bps definitions.d) by omega.
  (* Bookkeeping for later *)
  assert (H_split_bps := firstn_skipn k bps).
  assert (H_useful := sublist_preserves_increasing bps
                                                   (firstn k bps)
                                                   (skipn k bps)
                                                   definitions.d).
  symmetry in H_split_bps; spec H_useful H_split_bps.
  (* With all this information in place, destruct! *)
  destruct H0 as [left | right].
  - (* In the case that all of w1's breakpoints are in itself *)
    (** Constructing breakpoint set for left case **)
    assert (about_bps1 : breakpoint_set_predicate (firstn k bps) w1 k).
    { destruct_bps bps about_bps.
      destruct about_bps as [H_length [H_incr H_last]].
      spec H_useful H_incr; destruct H_useful as [H_incr_left _].
      unfold breakpoint_set_predicate; repeat split.
      + rewrite firstn_length.
        rewrite H_length.
        apply min_plus.
      + exact H_incr_left.
      + rewrite about_last_nth in *.
        rewrite firstn_length; rewrite H_length; rewrite min_plus.
        (* Replacing firstn bps with bps *)
        replace (nth (k-1) (firstn k bps) definitions.d)
          with (nth (k-1) bps definitions.d).
        2 : { assert (H_useful := about_firstn_app (k - 1)
                                                   (firstn k bps)
                                                   (skipn k bps)).
              assert (H_obv : k - 1 <= length (firstn k bps)).
              { rewrite firstn_length;
                  rewrite H_length;
                  rewrite min_plus; omega. }
              spec H_useful H_obv; clear H_obv.
              assert (H_useful' := length_nth_in (firstn k bps)
                                                 (skipn k bps)
                                                 (k - 1)
                                                 definitions.d).
              assert (H_obv : k - 1 < length (firstn k bps)).
              { rewrite firstn_length. rewrite H_length.
                rewrite min_plus.
                unfold p_predicate in H; omega. }
              spec H_useful' H_obv; clear H_obv.
              rewrite <- H_split_bps in H_useful'.
              assumption. }
        exact left. }
    (** Passing breakpoint set to L1 **)
    remember (exist (fun l => breakpoint_set_predicate l w1 k) (firstn k bps) about_bps1) as bps1.
    spec H_L w1 H_mem1 bps1.
    (** Acquiring breakpoints from L1 **)
    destruct H_L as [bp1 [bp2 [H_lt H_L]]].
    (** Constructing new breakpoints for concat language **)
    assert (about_bp1 : breakpoint_predicate bp1 (exist _ (k+k) H) w bps).
    { destruct_bp bp1 about_bp1.
      subst bps1.
      unfold breakpoint_predicate in *; simpl.
      rewrite H_split_bps.
      apply in_or_app. left.
      assumption. }
    assert (about_bp2 : breakpoint_predicate bp2 (exist _ (k+k) H) w bps).
    { destruct_bp bp2 about_bp2.
      subst bps1.
      unfold breakpoint_predicate in *; simpl.
      rewrite H_split_bps.
      apply in_or_app. left.
      assumption. }
    (** Supplying breakpoints to concat language **)
    exists (exist (fun i => breakpoint_predicate i (exist (p_predicate) (k+k) H) w bps) bp1 about_bp1).
    exists (exist (fun i => breakpoint_predicate i (exist (p_predicate) (k+k) H) w bps) bp2 about_bp2).
    split. simpl; assumption.
    intro m; simpl in *.
    (** Pumping the left word **)
    spec H_L m.
    exists (firstn bp1 w1 ++ napp m (pumpable_block bp1 bp2 w1) ++ skipn bp2 w1), w2; split.
    2 : split; assumption.
    do 2 rewrite <- app_assoc.
    (** Piecewise showing that result word is in concat language **)
    (* Chunk the first *)
    replace (firstn bp1 w) with (firstn bp1 w1).
    2 : { rewrite H_split.
          rewrite (about_firstn_app bp1 w1 w2). reflexivity.
          apply about_bp_length. }
    (* Chunk the second *)
    replace (napp m (pumpable_block bp1 bp2 w)) with
        (napp m (pumpable_block bp1 bp2 w1)).
    2 : { rewrite H_split. unfold pumpable_block.
          rewrite skipn_app_in.
          rewrite (about_firstn_app (bp2 - bp1) (skipn bp1 w1) w2).
          reflexivity.
          rewrite about_length_skipn.
          assert (bp2 <= length w1) by apply about_bp_length.
          omega.
          assert (bp2 <= length w1) by apply about_bp_length.
          omega. }
    (* Chunk the third *)
    (* This is the place to do case analysis on the position of bp2! *)
    assert (H_disj := about_bp_length k w1 bps1 bp2).
    apply le_lt_or_eq in H_disj.
    destruct H_disj as [trivial | eq].
    -- (* In the non-rightmost case, *)
       replace (skipn bp2 w) with (skipn bp2 w1 ++ w2).
       2 : { rewrite <- skipn_app_in.
             rewrite H_split; reflexivity.
             (* I need this to be strictly less than... *)
             exact trivial. }
       reflexivity.
    -- (* In the rightmost case, *)
      rewrite eq at 2 4.
      rewrite H_split. rewrite skipn_length.
      rewrite skipn_app_first. auto (* Getting rid of random nil app *).
      reflexivity.
  - (* In the case that all of w2's breakpoints are in itself *)
    (** Constructing breakpoint set for right case **)
    (* An important bit of imformation about bps2 for later *)
    assert (H_impt : forall x : nat, In x (skipn k bps) -> x >= length w1).
    intros n H_in_n.
    apply (In_nth _ _ definitions.d) in H_in_n.
    destruct H_in_n as [i [i_lt about_i]].
    rewrite (nth_app_offset (firstn k bps) (skipn k bps) i definitions.d) in about_i.
    rewrite <- H_split_bps in about_i.
    rewrite firstn_length in about_i.
    { destruct_bps bps about_bps;
        destruct about_bps as [H_length [H_incr H_last]].
      rewrite H_length in about_i; rewrite min_plus in about_i.
      spec H_incr (k - 1) (i + k).
      assert (H_obv : k - 1 < i + k < length bps).
      { rewrite H_length. unfold p_predicate in H.
        rewrite plus_comm. rewrite about_length_skipn in i_lt.
        rewrite H_length in i_lt. omega. }
      spec H_incr H_obv; clear H_obv.
      omega. }
    assert (about_bps2 : breakpoint_set_predicate (minus_map (length w1) (skipn k bps)) w2 k).
      { destruct_bps bps about_bps;
          destruct about_bps as [H_length [H_incr H_last]].
        spec H_useful H_incr; destruct H_useful as [_ H_incr_right].
        unfold breakpoint_set_predicate; repeat split.
        + unfold minus_map; rewrite map_length.
          rewrite about_length_skipn.
          rewrite H_length.
          omega.
        + apply about_minus_increasing.
          assert (H_useful := sublist_preserves_increasing bps
                                                           (firstn k bps)
                                                           (skipn k bps)
                                                           definitions.d).
          exact H_incr_right.
          rewrite (nth_app_offset (firstn k bps) (skipn k bps) 0 definitions.d).
          rewrite Nat.add_0_l.
          rewrite firstn_length. rewrite H_length; rewrite min_plus.
          rewrite <- H_split_bps.
          spec H_incr (k-1) k.
          assert (H_obv : k - 1 < k < length bps).
          { rewrite H_length; unfold p_predicate in H; omega. }
          spec H_incr H_obv; clear H_obv.
          omega.
        + rewrite about_last_nth in *.
          unfold minus_map at 1; rewrite map_length;
            rewrite about_length_skipn;
            rewrite H_length;
            replace (k+k-k-1) with (k-1) by omega.
          rewrite (nth_indep (minus_map (length w1) (skipn k bps))
                             definitions.d
                             (reverse_arg_minus (length w1) definitions.d)).
          rewrite about_minus_nth.
          2 : { unfold minus_map; rewrite map_length.
                rewrite about_length_skipn. rewrite H_length.
                unfold p_predicate in H. omega. }
          replace (length w2) with (length w - length w1).
          2 : { rewrite H_split. rewrite app_length. omega. }
          apply Nat.sub_le_mono_r.
          rewrite (nth_app_offset (firstn k bps) (skipn k bps) (k-1) definitions.d).
          rewrite <- H_split_bps.
          rewrite firstn_length.
          rewrite H_length; rewrite min_plus.
          rewrite H_length in H_last.
          rewrite plus_comm.
          rewrite Nat.add_sub_assoc.
          exact H_last.
          unfold p_predicate in H; omega. }
      (** Passing breakpoint set to L2 **)
      remember (exist (fun l => breakpoint_set_predicate l w2 k)
                      (minus_map (length w1) (skipn k bps))
                      about_bps2) as bps2.
      spec H_L' w2 H_mem2 bps2.
      (** Acquiring breakpoints from L2 **)
      destruct H_L' as [bp1 [bp2 [H_lt H_L']]].
      (* Getting some information about bp1, bp2 *)
      destruct_bp bp1 about_bp1; destruct_bp bp2 about_bp2.
      unfold breakpoint_predicate in about_bp1, about_bp2.
      subst bps2. simpl in *.
      apply (In_nth _ _ definitions.d) in about_bp1;
        apply (In_nth _ _ definitions.d) in about_bp2.
      destruct about_bp1 as [i [i_lt about_i]];
        destruct about_bp2 as [j [j_lt about_j]].
      unfold minus_map, reverse_arg_minus in i_lt, j_lt; rewrite map_length in i_lt, j_lt.
      (** Constructing new breakpoints for the concat language **)
      (* Maybe if we voice these breakpoints differently *)
      assert (about_bp1 : breakpoint_predicate (bp1 + length w1)
                                               (exist p_predicate (k+k) H)
                                               w
                                               bps).
      { unfold breakpoint_predicate.
        rewrite H_split_bps.
        apply in_or_app; right.
        assert (H_escape := map_minus_plus (skipn k bps) (length w1)).
        assert (H_step := in_map (fun x => x + length w1) (minus_map (length w1) (skipn k bps)) bp1).
        rewrite <- about_i in H_step at 1.
        assert (H_pre : In (nth i (minus_map (length w1) (skipn k bps)) definitions.d)
                           (minus_map (length w1) (skipn k bps))).
        { apply nth_In. unfold minus_map, reverse_arg_minus; rewrite map_length.
          assumption. }
        spec H_step H_pre; clear H_pre.
        unfold minus_map, reverse_arg_minus in H_step.
        rewrite map_map in H_step.
        spec H_escape H_impt.
        rewrite <- H_escape. assumption.  }
      assert (about_bp2 : breakpoint_predicate (bp2 + length w1)
                                               (exist p_predicate (k+k) H)
                                               w bps).
      { unfold breakpoint_predicate.
        rewrite H_split_bps.
        apply in_or_app; right.
        assert (H_escape := map_minus_plus (skipn k bps) (length w1)).
        assert (H_step := in_map (fun x => x + length w1) (minus_map (length w1) (skipn k bps)) bp2).
        rewrite <- about_j in H_step at 1.
        assert (H_pre : In (nth j (minus_map (length w1) (skipn k bps)) definitions.d)
                           (minus_map (length w1) (skipn k bps))).
        { apply nth_In. unfold minus_map, reverse_arg_minus; rewrite map_length.
          assumption. }
        spec H_step H_pre; clear H_pre.
        unfold minus_map, reverse_arg_minus in H_step.
        rewrite map_map in H_step.
        spec H_escape H_impt.
        rewrite <- H_escape. assumption. }
      (** Supplying breakpoints to concat language **)
      exists (exist (fun i => breakpoint_predicate i (exist (p_predicate) (k+k) H) w bps) (bp1 + length w1) about_bp1).
      exists (exist (fun i => breakpoint_predicate i (exist (p_predicate) (k+k) H) w bps) (bp2 + length w1) about_bp2).
      simpl in *.
      split. omega.
      intro m.
      (** Pumping the right word **)
      spec H_L' m.
      exists w1, (firstn bp1 w2 ++ napp m (pumpable_block bp1 bp2 w2) ++ skipn bp2 w2); split.
      2 : split; assumption.
      (** Piecewise showing that result word is in concat language **)
      (* Chunk the first *)
      replace (firstn (bp1 + length w1) w) with (w1 ++ firstn bp1 w2).
      2 : { rewrite H_split.
            rewrite <- firstn_app_2.
            rewrite plus_comm; reflexivity. }
      (* Chunk the second *)
      replace (napp m (pumpable_block (bp1 + length w1) (bp2 + length w1) w)) with
          (napp m (pumpable_block bp1 bp2 w2)).
      2 : {  unfold pumpable_block.
             replace (skipn bp1 w2) with (skipn (bp1 + length w1) w).
             2 : { rewrite H_split.
                   rewrite plus_comm.
                   rewrite skipn_app_out.
                   replace (length w1 + bp1 - length w1) with bp1.
                   reflexivity. omega. omega. }
             replace (bp2 + length w1 - (bp1 + length w1)) with (bp2 - bp1) by omega.
             reflexivity. }
      (* Chunk the third *)
      replace (skipn (bp2 + length w1) w) with (skipn bp2 w2).
      2 : { rewrite H_split. rewrite skipn_app_out.
            replace (bp2 + length w1 - length w1) with bp2 by omega. reflexivity.
            omega. }
      rewrite app_assoc_reverse. reflexivity.
Qed.


(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require list.List.

(* Why3 goal *)
Definition nth: forall {a:Type} {a_WT:WhyType a}, Z -> (list a) -> a.
intros a a_WT.
exact (fix nth n l := match l with nil => why_inhabitant | cons h t => if Zeq_bool n Z0 then h else nth (n - 1)%Z t end).
Defined.

(* Why3 goal *)
Lemma nth_cons_0 : forall {a:Type} {a_WT:WhyType a}, forall (x:a)
  (r:(list a)), ((nth 0%Z (Init.Datatypes.cons x r)) = x).
Proof.
now intros a a_WT x r.
Qed.

(* Why3 goal *)
Lemma nth_cons_n : forall {a:Type} {a_WT:WhyType a}, forall (x:a)
  (r:(list a)) (n:Z), (0%Z < n)%Z -> ((nth n
  (Init.Datatypes.cons x r)) = (nth (n - 1%Z)%Z r)).
Proof.
intros a a_WT x r n h1.
simpl.
generalize (Zeq_bool_if n 0).
case Zeq_bool ; try easy.
now intros ->.
Qed.


Welcome to Coq 8.4pl5 (October 2014)

Coq < Section Math022.

Coq < Require Import Arith.
[Loading ML file z_syntax_plugin.cmxs ... done]
[Loading ML file quote_plugin.cmxs ... done]
[Loading ML file newring_plugin.cmxs ... done]

Coq < Load CpdtTactics.

Coq < Goal forall x, (4 * x) - x = x + x + x + x + x - x - x.
1 subgoal

  ============================
   forall x : nat, 4 * x - x = x + x + x + x + x - x - x

Unnamed_thm < crush.
No more subgoals.

Unnamed_thm < Qed.
crush.

Unnamed_thm is defined


Require Import ECDef.

(*
Definition fd23 := pf_builder 23 Logic.eq_refl.
Example pc010isInfO : PC_to_AC (GE_PC_wp fd23 (0, 1, 0)) = InfO fd23.
Proof. reflexivity. Qed.
Compute PC_to_AC (GE_PC_wp fd23 (0, 1, 0)).
Compute GE_uwp (PC_to_AC (GE_PC_wp fd23 (7, 7, 7))).
Compute GE_uwp (PC_to_AC (GE_PC_wp fd23 (5, 5, 7))).
Compute GE_PC_eqb (AC_to_PC (PC_to_AC (GE_PC_wp fd23 (5, 5, 7))))
(GE_PC_wp fd23 (5, 5, 7)).

Definition fd7 := pf_builder 7 Logic.eq_refl.
Example pc112eqpc441 : GE_PC_eqb (GE_PC_wp fd7 (1, 1, 2))
 (GE_PC_wp fd7 (4, 4, 1)) = true := Logic.eq_refl.

Example  pc112invpc431 : GE_PC_invb_pf (GE_PC_wp fd7 (1, 1, 2))
 (GE_PC_wp fd7 (4, 3, 1)) = true := Logic.eq_refl.

(* Example 3 Page 12 *)
Definition fd19 : ECField := pf_builder 19 Logic.eq_refl .
Example acdb102eq1516 : GE_uwp (pf_double_ac (wrapper fd19 1)
 (GE_wp fd19 (10, 2))) = (15, 16) := Logic.eq_refl.
Example ac102plus96eq163 : GE_uwp (pf_add_ac (wrapper fd19 1)
 (GE_wp fd19 (10, 2)) (GE_wp fd19 (9, 6))) = (16, 3) := Logic.eq_refl.
Example pc102ml2eq1516 : GE_uwp (pf_mul_pc (wrapper fd19 1)
 (GE_wp fd19 (10, 2)) 2) = (15, 16) := Logic.eq_refl.
Example pc1021dbleq10177 : GE_PC_uwp (pf_double_pc (wrapper fd19 1)
 (GE_PC_wp fd19 (10, 2, 1))) = (10, 17, 7) := Logic.eq_refl .

(* Example 6 *)
(*
Definition alpha := 2%N.
Compute Bp_power 5 37 alpha 14. (* 29 correct *)
Compute Bp_power 5 37 alpha 31. (* 1 correct *)
Definition a6 := Bp_power 5 37 alpha 6.
Definition a21 := Bp_power 5 37 alpha 21.
Definition a3 := Bp_power 5 37 alpha 3.
Definition a15 := Bp_power 5 37 alpha 15.
Definition a24 := Bp_power 5 37 alpha 24.
Definition a22 := Bp_power 5 37 alpha 22.
Definition P1 := Cop (a6, a21).
Definition P2 := Cop (a3, a15).
Definition P3 := Cop (a24, a22).

Compute bfp_double 5 37 1 P1 . (* 8, 31 correct *)
Compute bfp_mul 5 37 1 P1 2 . (* 8, 31 correct *)
Compute bfp_add 5 37 1 P1 P2 .  (* 30, 21 correct *)
*)
*)
Section pfmultest.
Definition p := hStoN
  "8542D69E 4C044F18 E8B92435 BF6FF7DE 45728391 5C45517D 722EDB8B 08F1DFC3".
Definition field := pf_builder p Logic.eq_refl.
Definition a := hStoN
  "787968B4 FA32C3FD 2417842E 73BBFEFF 2F3C848B 6831D7E0 EC65228B 3937E498".
Definition fa := wrapper field a.
Compute size p.
(*
Definition x1 := hStoN
 "110FCDA5 7615705D 5E7B9324 AC4B856D 23E6D918 8B2AE477 59514657 CE25D112" .
Definition y1 := hStoN
 "1C65D68A 4A08601D F24B431E 0CAB4EBE 084772B3 817E8581 1A8510B2 DF7ECA1A" .
Definition P1 := GE_wp field (x1, y1).
Definition x2 := hStoN "64D20D27 D0632957 F8028C1E 024F6B02 EDF23102 A566C932 AE8BD613 A8E865FE".
Definition y2 := hStoN "64D20D27 D0632957 F8028C1E 024F6B02 EDF23102 A566C932 AE8BD613 A8E865FE".
Definition P2 := GE_wp field (x2, y2).
*)
(*
Time Compute GE_uwp (pf_mul_ac field (wrapper field a) P2 10).
(*14.397 s.  46s if not using GE_uwp, amazing! *)
Time Compute GE_uwp (pf_mul_ac field (wrapper field a) P2 100). (*13.397 s*)
Time Compute GE_uwp (pf_mul_pc field (wrapper field a) P2 10).
(* 3.371s using N, more than 3 mins by field, 3.822s using uwp! *)
Time Compute GE_uwp (pf_mul_pc field (wrapper field a) P2 100).
 (*13.397 s by N, 4.107s using uwp! *)
*)
(*
Time Compute pf_mul_ac p a P2 100. (*12.66 s*)
Time Compute pf_mul_ps p a P2 100. (*3.593 s*)

Time Compute pf_mul_ac p a P2 a. (*26.911 s*)
Time Compute pf_mul_ps p a P2 a. (*617.794 s*)
*)

Definition xG := hStoN
  "421DEBD6 1B62EAB6 746434EB C3CC315E 32220B3B ADD50BDC 4C4E6C14 7FEDD43D".
Definition yG := hStoN
  "0680512B CBB42C07 D47349D2 153B70C4 E5D7FDFC BFA36EA1 A85841B9 E46E09A2".

Definition k := hStoN
  "6CB28D99 385C175C 94F94E93 4817663F C176D925 DD72B727 260DBAAE 1FB2F96F".
Definition G := GE_wp field (xG, yG).
Definition kGac := pf_mul_ac fa G k.
(*Example kGaceqP1 : GE_eqb kGac P1 = true.
Proof. Time vm_compute. reflexivity. Qed.
(*705.683 secs vm_compute *)
*)
Definition kGpc := pf_mul_pc fa G k.
(*
Example kGpceqP1 : GE_eqb kGpc P1 = true.
Proof. Time vm_compute. reflexivity. Qed.
(*35s*)
*)
Definition xA := hStoN "0AE4C779 8AA0F119 471BEE11 825BE462 02BB79E2 A5844495 E97C04FF 4DF2548A".
Definition yA := hStoN "7C0240F8 8F1CD4E1 6352A73C 17B7F16F 07353E53 A176D684 A9FE0C6B B798E857".
Definition PA := GE_wp field (xA, yA).
Definition t := hStoN "2B75F07E D7ECE7CC C1C8986B 991F441A D324D6D6 19FE06DD 63ED32E0 C997C801".
Definition x00 := hStoN "1657FA75 BF2ADCDC 3C1F6CF0 5AB7B45E 04D3ACBE 8E4085CF A669CB25 64F17A9F".
Definition y00 := hStoN "19F0115F 21E16D2F 5C3A485F 8575A128 BBCDDF80 296A62F6 AC2EB842 DD058E50".
Definition P00 := GE_wp field (x00, y00).
Example p00aceqPAt : GE_eqb P00 (pf_mul_ac fa PA t) = true .
Proof. Time vm_compute.  Qed.  (* 679.806 secs *)
End pfmultest.