Require Import String.
Require Import Ascii.
Require Import Arith.
Require Import OrderedType.
Require Import OrderedTypeEx.

Require Import StructTact.StructTactics.

Inductive lex_lt: string -> string -> Prop :=
| lex_lt_lt : forall (c1 c2 : ascii) (s1 s2 : string),
    nat_of_ascii c1 < nat_of_ascii c2 ->
    lex_lt (String c1 s1) (String c2 s2)
| lex_lt_eq : forall (c : ascii) (s1 s2 : string),
    lex_lt s1 s2 ->
    lex_lt (String c s1) (String c s2)
| lex_lt_empty : forall (c : ascii) (s : string),
    lex_lt EmptyString (String c s).

Inductive lex_order : string -> string -> Prop :=
| lex_order_empty :
    lex_order EmptyString EmptyString
| lex_order_char_lt :
    forall (c1 c2: ascii) (s1 s2: string),
      nat_of_ascii c1 < nat_of_ascii c2 ->
      lex_order (String c1 s1) (String c2 s2)
| lex_order_char_eq :
    forall (c: ascii) (s1 s2: string),
      lex_order s1 s2 ->
      lex_order (String c s1) (String c s2)
| lex_order_empty_string :
    forall s, lex_order EmptyString s.

Definition lex_le (s1 s2 : string) : Prop := lex_lt s1 s2 \/ s1 = s2.

Lemma lex_le_in_lex_order : forall (s1 s2 : string),
    lex_order s1 s2 -> lex_le s1 s2.
Proof.
  intros s1 s2 H.
  induction H.
  - right.
    reflexivity.
  - left.
    apply lex_lt_lt.
    assumption.
  - case IHlex_order; intro H_le.
    * left.
      apply lex_lt_eq.
      assumption.
    * rewrite H_le.
      right.
      reflexivity.
  - case s.
    * right.
      reflexivity.
    * intros c s0.
      left.
      apply lex_lt_empty.
Qed.

Lemma lex_order_refl : forall (s : string), lex_order s s.
Proof.
  induction s.
  * apply lex_order_empty_string.
  * intros.
    apply lex_order_char_eq.
    assumption.
Qed.

Lemma lex_order_lex_le : forall (s1 s2 : string),
    lex_le s1 s2 -> lex_order s1 s2.
intros s1 s2 H_le.
case H_le; intro H_le'.
- induction H_le'.
  * apply lex_order_char_lt.
    assumption.
  * apply lex_order_char_eq.
    apply IHH_le'.
    left.
    assumption.
  * apply lex_order_empty_string.
- rewrite <- H_le'.
  apply lex_order_refl.
Qed.

Theorem lex_lt_trans : forall s0 s1 s2,
    lex_lt s0 s1 -> lex_lt s1 s2 -> lex_lt s0 s2.
Proof.
induction s0.
- intros.
  inversion H; subst.
  inversion H0; subst.
  * apply lex_lt_empty.
  * apply lex_lt_empty.
- intros.
  inversion H; subst; inversion H0; subst.
  * apply lex_lt_lt.
    eauto with arith.
  * apply lex_lt_lt.
    assumption.
  * apply lex_lt_lt.
    assumption.
  * apply lex_lt_eq.
    eapply IHs0; eauto.
Qed.

Theorem lex_lt_not_eq : forall s0 s1,
    lex_lt s0 s1 -> s0 <> s1.
Proof.
  induction s0.
  - intros.
    inversion H; subst.
    congruence.
  - intros.
    inversion H; subst.
    * intro H_eq.
      find_injection.
      contradict H3.
      auto with arith.
    * intro H_eq.
      find_injection.
      specialize (IHs0 s3).
      concludes.
      auto.
Qed.

Lemma nat_of_ascii_injective:
  forall c1 c2, nat_of_ascii c1 = nat_of_ascii c2 -> c1 = c2.
Proof.
  intros; simpl.
  assert (ascii_of_nat (nat_of_ascii c1) =
          ascii_of_nat (nat_of_ascii c2))
      as Hinvol. auto.
  repeat rewrite ascii_nat_embedding in Hinvol.
  trivial.
Qed.

Fixpoint string_compare_lex_compat (s0 s1 : string) : Compare lex_lt eq s0 s1.
refine
  (match s0 as ss0, s1 as ss1 return (_ = ss0 -> _ = ss1 -> _) with
   | EmptyString, EmptyString => fun H_eq H_eq' => EQ _
   | EmptyString, String c' s'1 => fun H_eq H_eq' => LT _
   | String c s'0, EmptyString => fun H_eq H_eq' => GT _
   | String c s'0, String c' s'1 => fun H_eq H_eq' =>
     match Nat.compare (nat_of_ascii c) (nat_of_ascii c') as cmp return (_ = cmp -> _) with
     | Lt => fun H_eq_cmp => LT _
     | Eq => fun H_eq_cmp =>
       match string_compare_lex_compat s'0 s'1 with
       | LT H_lt => LT _
       | EQ H_eq_lex => EQ _
       | GT H_gt => GT _
       end
     | Gt => fun H_eq_cmp => GT _
     end (refl_equal _)
   end (refl_equal _) (refl_equal _)); try (rewrite H_eq; rewrite H_eq'); auto.
- apply lex_lt_empty.
- apply lex_lt_empty.
- apply nat_compare_eq in H_eq_cmp.
  apply nat_of_ascii_injective in H_eq_cmp.
  rewrite H_eq_cmp.
  apply lex_lt_eq.
  assumption.
- apply nat_compare_eq in H_eq_cmp.
  apply nat_of_ascii_injective in H_eq_cmp.
  subst.
  reflexivity.
- apply nat_compare_eq in H_eq_cmp.
  apply nat_of_ascii_injective in H_eq_cmp.
  rewrite H_eq_cmp.
  apply lex_lt_eq.
  assumption.
- apply nat_compare_lt in H_eq_cmp.
  apply lex_lt_lt.
  assumption.
- apply nat_compare_gt in H_eq_cmp.
  apply lex_lt_lt.
  auto with arith.
Defined.

Module string_lex_as_OT_compat <: UsualOrderedType.
  Definition t := string.
  Definition eq := @eq string.
  Definition lt := lex_lt.
  Definition eq_refl := @eq_refl string.
  Definition eq_sym := @eq_sym string.
  Definition eq_trans := @eq_trans string.
  Definition lt_trans := lex_lt_trans.
  Definition lt_not_eq := lex_lt_not_eq.
  Definition compare := string_compare_lex_compat.
  Definition eq_dec := string_dec.
End string_lex_as_OT_compat.

Require Import Orders.

Lemma lex_lt_irrefl : Irreflexive lex_lt.
Proof.
  intros s0 H_lt.
  apply lex_lt_not_eq in H_lt.
  auto.
Qed.

Theorem lex_lt_strorder : StrictOrder lex_lt.
Proof.
  exact (Build_StrictOrder _ lex_lt_irrefl lex_lt_trans).
Qed.

Theorem lex_lt_lt_compat : Proper (eq ==> eq ==> iff) lex_lt.
Proof.
intros s0 s1 H_eq s2 s3 H_eq'.
split; intro H_imp; subst; auto.
Qed.

Fixpoint string_compare_lex (s0 s1 : string) : { cmp : comparison | CompSpec eq lex_lt s0 s1 cmp }.
refine
  (match s0 as ss0, s1 as ss1 return (_ = ss0 -> _ = ss1 -> _) with
   | EmptyString, EmptyString => fun H_eq H_eq' => exist _ Eq _
   | EmptyString, String c' s'1 => fun H_eq H_eq' => exist _ Lt _
   | String c s'0, EmptyString => fun H_eq H_eq' => exist _ Gt _
   | String c s'0, String c' s'1 => fun H_eq H_eq' =>
     match Nat.compare (nat_of_ascii c) (nat_of_ascii c') as cmp0 return (_ = cmp0 -> _)  with
     | Lt => fun H_eq_cmp0 => exist _ Lt _
     | Eq => fun H_eq_cmp0 =>
       match string_compare_lex s'0 s'1 with
       | exist _ cmp H_cmp' =>
         match cmp as cmp1 return (cmp = cmp1 -> _) with
         | Lt => fun H_eq_cmp1 => exist _ Lt _
         | Eq => fun H_eq_cmp1 => exist _ Eq _
         | Gt => fun H_eq_cmp1 => exist _ Gt _
         end (refl_equal _)
       end
     | Gt => fun H_eq_cmp0 => exist _ Gt _
     end (refl_equal _)
   end (refl_equal _) (refl_equal _)); try (rewrite H_eq; rewrite H_eq').
- apply CompEq; auto.
- apply CompLt.
  apply lex_lt_empty.
- apply CompGt.
  apply lex_lt_empty.
- apply nat_compare_eq in H_eq_cmp0.
  apply nat_of_ascii_injective in H_eq_cmp0.
  rewrite H_eq_cmp1 in H_cmp'.
  inversion H_cmp'; subst.
  apply CompEq.
  reflexivity.
- apply nat_compare_eq in H_eq_cmp0.
  apply nat_of_ascii_injective in H_eq_cmp0.
  rewrite H_eq_cmp1 in H_cmp'.
  inversion H_cmp'.
  subst.
  apply CompLt.
  apply lex_lt_eq.
  assumption.
- apply nat_compare_eq in H_eq_cmp0.
  apply nat_of_ascii_injective in H_eq_cmp0.
  rewrite H_eq_cmp1 in H_cmp'.
  subst.
  inversion H_cmp'.
  apply CompGt.
  apply lex_lt_eq.
  assumption.
- apply nat_compare_lt in H_eq_cmp0.
  apply CompLt.
  apply lex_lt_lt.
  assumption.
- apply nat_compare_gt in H_eq_cmp0.
  apply CompGt.
  apply lex_lt_lt.
  auto with arith.
Defined.

Module string_lex_as_OT <: UsualOrderedType.
  Definition t := string.
  Definition eq := @eq string.
  Definition eq_equiv := @eq_equivalence string.
  Definition lt := lex_lt.
  Definition lt_strorder := lex_lt_strorder.
  Definition lt_compat := lex_lt_lt_compat.
  Definition compare := fun x y => proj1_sig (string_compare_lex x y).
  Definition compare_spec := fun x y => proj2_sig (string_compare_lex x y).
  Definition eq_dec := string_dec.
End string_lex_as_OT.


Require Export GeoCoq.Elements.OriginalProofs.lemma_supplementsymmetric.
Require Export GeoCoq.Elements.OriginalProofs.lemma_ABCequalsCBA.
Require Export GeoCoq.Elements.OriginalProofs.lemma_equalanglestransitive.

Section Euclid.

Context `{Ax:euclidean_neutral_ruler_compass}.

Lemma lemma_RTsymmetric :
   forall A B C D E F,
   RT A B C D E F ->
   RT D E F A B C.
Proof.
intros.
let Tf:=fresh in
assert (Tf:exists a b c d e, (Supp a b c d e /\ CongA A B C a b c /\ CongA D E F d b e)) by (conclude_def RT );destruct Tf as [a[b[c[d[e]]]]];spliter.
assert (Supp e b d c a) by (conclude lemma_supplementsymmetric).
assert (nCol d b e) by (conclude lemma_equalanglesNC).
assert (CongA d b e e b d) by (conclude lemma_ABCequalsCBA).
assert (nCol a b c) by (conclude lemma_equalanglesNC).
assert (CongA a b c c b a) by (conclude lemma_ABCequalsCBA).
assert (CongA D E F e b d) by (conclude lemma_equalanglestransitive).
assert (CongA A B C c b a) by (conclude lemma_equalanglestransitive).
assert (RT D E F A B C) by (conclude_def RT ).
close.
Qed.

End Euclid.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (y : natural) (x : natural) : natural := plus Zero (plus y x).


Require Import List ZArith.

(* RSMachine definition *)

Inductive rsReg : Set :=
| RS0
| RS1.

Definition beq_rsReg (r0 r1 : rsReg) : bool :=
  match r0, r1 with
    | RS0, RS0 => true
    | RS1, RS1 => true
    | _, _ => false
  end.

Inductive rsArg : Set :=
| RSArg : nat -> rsArg.

Inductive rsBop : Set :=
| RSAdd : rsBop
| RSSub : rsBop
| RSMul : rsBop.

Inductive rsInstr : Set :=
| PushReg : rsReg -> rsInstr
| PushArg : rsArg -> rsInstr
| Pop : rsReg -> rsInstr
| RSBinop : rsBop -> rsReg -> rsReg -> rsInstr.

Record rsMachine :=
  {
    rsRegValMap : rsReg -> Z;
    rsArgValMap : rsArg -> Z;
    rsStk : list Z
  }.

Definition rsProgram := list rsInstr.

(* RSMachine program evaluation *)

Open Scope Z_scope.

Definition evalRSBop (b : rsBop) (v0 v1 : Z) :=
  match b with
    | RSAdd => v0 + v1
    | RSSub => v0 - v1
    | RSMul => v0 * v1
  end.

Inductive rsBopEvalR : rsBop-> Z -> Z -> Z -> Prop :=
| RSBopEvalR : forall b v0 v1, rsBopEvalR b v0 v1 (evalRSBop b v0 v1).

Inductive rsInstrEvalR : rsMachine -> rsInstr -> rsMachine -> Prop :=
| RSInstrEvalR_pushReg :
    forall r rvm ram stk,
      rsInstrEvalR
        (Build_rsMachine rvm ram stk)
        (PushReg r)
        (Build_rsMachine rvm ram (rvm r :: stk))
| RSInstrEvalR_pushArg :
    forall a rvm ram stk,
      rsInstrEvalR
        (Build_rsMachine rvm ram stk)
        (PushArg a)
        (Build_rsMachine rvm ram (ram a :: stk))
| RSInstrEvalR_pop :
    forall v r rvm ram stk,
      rsInstrEvalR
        (Build_rsMachine rvm ram (v :: stk))
        (Pop r)
        (Build_rsMachine
           (fun x => if beq_rsReg x r then v else rvm x) ram stk)
| RSInstrEvalR_rsBinop :
    forall r0 r1 b rvm ram stk r,
      rsBopEvalR b (rvm r1) (rvm r0) r ->
      rsInstrEvalR
        (Build_rsMachine rvm ram stk)
        (RSBinop b r0 r1)
        (Build_rsMachine
           (fun x => if beq_rsReg x r1 then r else rvm x)
           ram
           stk).


From mathcomp Require Import all_ssreflect fingroup ssralg poly ssrnum.
Require Import signed.

(******************************************************************************)
(* This file equips the product of two normedZmodTypes with a canonical       *)
(* normedZmodType structure. It is a short file that has been added here for  *)
(* convenience during the rebase of MathComp-Analysis on top of MathComp 1.1. *)
(* The contents is likely to be moved elsewhere.                              *)
(******************************************************************************)

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

Local Open Scope ring_scope.
Import Order.TTheory GRing.Theory Num.Theory.

Module ProdNormedZmodule.
Section ProdNormedZmodule.
Context {R : numDomainType} {U V : normedZmodType R}.

Definition norm (x : U * V) : R := Num.max `|x.1| `|x.2|.

Lemma normD x y : norm (x + y) <= norm x + norm y.
Proof.
rewrite /norm num_le_maxl !(le_trans (ler_norm_add _ _)) ?ler_add//;
by rewrite comparable_le_maxr ?lexx ?orbT// real_comparable.
Qed.

Lemma norm_eq0 x : norm x = 0 -> x = 0.
Proof.
case: x => x1 x2 /eqP; rewrite eq_le num_le_maxl 2!normr_le0 -andbA/=.
by case/and3P => /eqP -> /eqP ->.
Qed.

Lemma normMn x n : norm (x *+ n) = (norm x) *+ n.
Proof. by rewrite /norm pairMnE -mulr_natl maxr_pmulr ?mulr_natl ?normrMn. Qed.

Lemma normrN x : norm (- x) = norm x.
Proof. by rewrite /norm/= !normrN. Qed.

Definition normedZmodMixin :
  @Num.normed_mixin_of R [zmodType of U * V] (Num.NumDomain.class R) :=
  @Num.NormedMixin _ _ _ norm normD norm_eq0 normMn normrN.

Canonical normedZmodType := NormedZmodType R (U * V) normedZmodMixin.

Lemma prod_normE (x : normedZmodType) : `|x| = Num.max `|x.1| `|x.2|.
Proof. by []. Qed.

End ProdNormedZmodule.

Module Exports.
Canonical normedZmodType.
Definition prod_normE := @prod_normE.
End Exports.

End ProdNormedZmodule.
Export ProdNormedZmodule.Exports.


Require Import Arith.
Import Nat.

Load hoare.

(*
euclid(a, b):
  while a != b do
    if a > b then
      a := a - b
    else
      b := b - a
 *)

Definition gt01 n m := if gt_dec n m then 1 else 0.
Definition ne01 n m := if eq_dec n m then 0 else 1.

Notation "[ e1 `-` e2 ]" := (expr_op e1 sub e2).
Notation "[ e1 `>` e2 ]" := (expr_op e1 gt01 e2).
Notation "[ e1 `!=` e2 ]" := (expr_op e1 ne01 e2).

Definition euclid_cmd :=
  while [expr_var a `!=` expr_var b]
        (if_then_else [expr_var a `>` expr_var b]
                      (assign a [expr_var a `-` expr_var b])
                      (assign b [expr_var b `-` expr_var a])).

(* Definition of divisibility + some syntactic sugar *)
Definition divides a b := exists k, a * k = b.
Notation "( a | b )" := (divides a b).

Module MainProof.

  Definition c := if_then_else [expr_var a `>` expr_var b]
                               (assign a [expr_var a `-` expr_var b])
                               (assign b [expr_var b `-` expr_var a]).

  Definition linv a0 b0 :=
    fun s => forall z, (z | a0) /\ (z | b0) <-> (z | s a) /\ (z | s b).

  (* Control the behavior of `simpl` to allow more unfoldings. *)
  Arguments subst P v e /.
  Arguments set s v / z.
  Arguments var_eq_dec !v1 !v2.
  Arguments gt01 n m / : simpl nomatch.
  Arguments ne01 n m / : simpl nomatch.

  Require Import Omega.

  Lemma gt0_le x y : gt01 x y = 0 <-> x <= y.
  Proof.
    unfold gt01.
    destruct (gt_dec x y); firstorder.
  Qed.

  Lemma gt1_gt x y : gt01 x y <> 0 <-> x > y.
  Proof.
    unfold gt01.
    destruct (gt_dec x y); firstorder.
  Qed.

  Lemma div_sub a b z : (z | a) -> (z | b) -> (z | a - b).
  Proof.
    firstorder. exists (x1 - x0).
    rewrite Nat.mul_sub_distr_l.
    firstorder.
  Qed.

  Lemma sub_div1 a b z : a >= b -> (z | a) -> (z | a - b) -> (z | b).
  Proof.
    firstorder. exists (x1 - x0).
    rewrite Nat.mul_sub_distr_l.
    firstorder.
  Qed.

  Lemma sub_div2 a b z : a >= b -> (z | b) -> (z | a - b) -> (z | a).
  Proof.
    firstorder. exists (x0 + x1).
    rewrite Nat.mul_add_distr_l.
    firstorder.
  Qed.

  Lemma warm_up a0 b0 : hoare (fun s => s a = a0 /\ s b = b0)
                              (assign a [expr_var a `-` expr_var b])
                              (fun s => s a = a0 - b0).
  Proof.
    eapply hoare_weaken_l.
    2: constructor.
    intros s [H1 H2].
    simpl. firstorder.
  Qed.

  Lemma aux1 a0 b0 a b: (forall z, (z | a0) /\ (z | b0) <-> (z | a) /\ (z | b)) ->
                        a > b ->
                        forall z, (z | a0) /\ (z | b0) <-> (z | a - b) /\ (z | b).
  Admitted.

  Lemma aux2 a0 b0 a b: (forall z, (z | a0) /\ (z | b0) <-> (z | a) /\ (z | b)) ->
                        a < b ->
                        forall z, (z | a0) /\ (z | b0) <-> (z | a) /\ (z | b - a).
  Admitted.

  Lemma euclid_inv a0 b0 : hoare (fun s => linv a0 b0 s /\ s a <> s b)
                                 c
                                 (linv a0 b0).
  Proof.
    constructor.
    - eapply hoare_weaken_l.        (* "then" branch -- a > b *)
      2: constructor.
      unfold linv; simpl.
      intros; apply aux1.
      + firstorder.
      + firstorder. apply gt1_gt. assumption.
      (*
      firstorder.
      + apply div_sub.
        * apply H. firstorder.
        * apply H. firstorder.
      + apply H. split.
        * { eapply sub_div2 with (b:=s b).
            - apply gt1_gt in H0. omega.
            - firstorder.
            - firstorder.
          }
        * eexists; eassumption.
      + apply H. split. (* identical to previous branch *)
        * { eapply sub_div2 with (b:=s b).
            - apply gt1_gt in H0. omega.
            - firstorder.
            - firstorder.
          }
        * eexists; eassumption.
      *)
    - eapply hoare_weaken_l.        (* "else" branch -- a < b *)
      2: constructor.
      unfold linv; simpl.
      intros; apply aux2.
      + firstorder.
      + firstorder.
        apply le_neq.
        firstorder using gt0_le.
      (*
      intros s [[H0 H1] H2].  (* can be a bit more economical by *)
      split.                  (* postponing use of firstorder    *)
      + split.
        * apply H0. assumption.
        * apply div_sub; firstorder.
      + intro; apply H0. split.
        * firstorder.
        * { eapply sub_div2.
            - apply gt0_le. eassumption.
            - firstorder.
            - firstorder.
          }
      *)
  Qed.

  Theorem euclid_post a0 b0 : hoare (fun s => s a = a0 /\ s b = b0)
                                    euclid_cmd
                                    (fun s => forall z, (z | a0) /\ (z | b0) <-> (z | s a)).
  Proof.
    eapply hoare_weaken.
    Focus 2.
    {
      apply hoare_while with (P:=linv a0 b0).
      eapply hoare_weaken_l.
      2: apply euclid_inv.
      unfold linv; simpl. firstorder.
      unfold ne01 in H0.
      destruct (eq_dec (s a) (s b)).
      - firstorder.
      - firstorder.
    }
    Unfocus.
    - unfold linv. intros s [A B]. subst; firstorder.
    - unfold linv; simpl. intros s [H1 H2].
      unfold ne01 in H2; destruct (eq_dec (s a) (s b)).
      + split; intro; apply H1.
        firstorder.
        split. assumption. rewrite <- e; assumption.
      + firstorder.
  Qed.

End MainProof.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import Arith Eqdep_dec.

From Undecidability.Shared Require Import DLW.Utils.utils DLW.Vec.vec DLW.Vec.pos.
From Undecidability.MuRec.Util Require Import recalg.

Set Implicit Arguments.

Reserved Notation "  '[' f ';' v ']' '-[' n '>>' x " (at level 70).

(* The intuitive meaning of [f;v] -[n>> x is

      There is a computation of f(v) which costs n and results in x

    We define it in such a way that
      1/ the cost is never 0,
      2/ the cost of compound computation is greater than
         the sum of the costs of its sub-computations
      3/ the cost and the result are unique (if they exist)

 **)

Inductive ra_ca : forall k, recalg k -> vec nat k -> nat -> nat -> Prop :=
    | in_ra_ca_cst  : forall n v,             [ra_cst n;        v] -[ 1           >> n
    | in_ra_ca_zero : forall v,               [ra_zero;         v] -[ 1           >> 0
    | in_ra_ca_succ : forall v,               [ra_succ;         v] -[ 1           >> S (vec_head v)
    | in_ra_ca_proj : forall k v j,           [@ra_proj k j;    v] -[ 1           >> vec_pos v j

    | in_ra_ca_comp : forall k i f (gj : vec (recalg i) k) v q w p x,
                                   (forall j, [vec_pos gj j;    v] -[ vec_pos q j >> vec_pos w j)
                               ->             [f;               w] -[ p           >> x
                               ->             [ra_comp f gj;    v] -[1+p+vec_sum q>> x

    | in_ra_ca_rec_0 : forall k f (g : recalg (S (S k))) v n x,
                                              [f;               v] -[ n           >> x
                               ->             [ra_rec f g;   0##v] -[ S n         >> x

    | in_ra_ca_rec_S : forall k f (g : recalg (S (S k))) v n p x q y,
                                              [ra_rec f g;   n##v] -[ p           >> x
                               ->             [g;         n##x##v] -[ q           >> y
                               ->             [ra_rec f g; S n##v] -[ 1+p+q       >> y

    | in_ra_ca_min : forall k (f : recalg (S k)) v x p w q ,
                           (forall j : pos x, [f;    pos2nat j##v] -[ vec_pos q j >> S (vec_pos w j))
                               ->             [f;            x##v] -[ p           >> 0
                               ->             [ra_min f;        v] -[1+p+vec_sum q>> x
where " [ f ; v ] -[ n >> x " := (@ra_ca _ f v n x).

Section inversion_lemmas.

  (* The inversion tactic won't work for the dependent predicate ra_ca so
      we build the inversion lemma by hand.

      Notice the presence of type-castings (eq_rect ...) which disappear
      when we instanciate that lemma on the individual cases
      (the lemmas ra_ca_*_inv below)

      The statement of the lemma is complicated but the proof is trivial !!
  *)

  Lemma ra_ca_inv k (f : recalg k) v n x :
    [f;v] -[n>> x -> (n = 1 /\ exists (H : k = 0), eq_rect _ _ f _ H = ra_cst x)
                  \/ (n = 1 /\ x = 0 /\ exists (H : k = 1), eq_rect _ _ f _ H = ra_zero)
                  \/ (n = 1 /\ exists (H : k = 1), x = S (vec_head (eq_rect _ _ v _ H)) /\ eq_rect _ _ f _ H = ra_succ)
                  \/ (n = 1 /\ exists p, x = vec_pos v p /\ f = ra_proj p)
                  \/ (exists i (h : recalg i) gj w q m, n = 1+q+vec_sum m /\ [h;w] -[q>> x
                              /\ (forall p, [vec_pos gj p;v] -[vec_pos m p>> vec_pos w p)
                              /\ f = ra_comp h gj)
                  \/ (exists k' (H : k = S k') (h : recalg k') g m,
                                 n = S m
                              /\ vec_head (eq_rect _ _ v _ H) = 0
                              /\ [h;vec_tail (eq_rect _ _ v _ H)] -[m>> x
                              /\ eq_rect _ _ f _ H = ra_rec h g)
                  \/ (exists k' (H : k = S k') m y (h : recalg k') g p q,
                                 vec_head (eq_rect _ _ v _ H) = S m
                              /\ n = 1+p+q
                              /\ [ra_rec h g; m##vec_tail (eq_rect _ _ v _ H)] -[p>> y
                              /\ [g; m##y##vec_tail (eq_rect _ _ v _ H)] -[q>> x
                              /\ eq_rect _ _ f _ H = ra_rec h g)
                  \/ (exists (g : recalg (S k)) (m w : vec _ x) q,
                                 n = 1+q+vec_sum m
                              /\ (forall p, [g; pos2nat p##v] -[vec_pos m p>> S (vec_pos w p))
                              /\ [g; x##v] -[q>> 0
                              /\ f = ra_min g)
                 .
  Proof.
    induction 1 as [ | |
                   | k v j
                   | k i f gj v q w p x
                   | k f g v n x
                   | k f g v n p x q y
                   | k f v x p w q
                   ].
    do 0 right; left; split; auto; exists eq_refl; auto.
    do 1 right; left; do 2 (split; auto); exists eq_refl; auto.
    do 2 right; left; split; auto; exists eq_refl; split; simpl; auto.
    do 3 right; left; split; auto; exists j; auto.
    do 4 right; left; exists k, f, gj, w, p, q; auto.
    do 5 right; left; exists k, eq_refl, f, g, n; auto.
    do 6 right; left; exists k, eq_refl, n, x, f, g, p, q; auto.
    do 7 right; exists f, q, w, p; auto.
  Qed.

  (* The next proofs by hand are long but not complicated ... we simply have to
     discard all the unnecessary cases generated by the general
     inversion lemma using the discriminate tactic *)

  (* Automation is our friend here *)

  (* This is to destruct the inversion lemma

     This lemma creates variables which are partly hard coded ...
     this is not ideal and could be improved
   *)

  Local Ltac myinv :=
    let H := fresh in
    intros H;
    apply ra_ca_inv in H;
    destruct H as   [ (? & ? & ?)
                  | [ (? & ? & ? & ?)
                  | [ (? & ? & ? & ?)
                  | [ (? & ? & ? & ?)
                  | [ (? & ? & ? & w' & q' & m' & ? & ? & ? & ?)
                  | [ (? & ? & ? & ? & m' & ? & ? & ? & ?)
                  | [ (? & ? & ? & y' & ? & ? & p' & q' & ? & ? & ? & ? & ?)
                    | (? & m' & w' & q' & ? & ? & ? & ?)
                    ] ] ] ] ] ] ].

  Ltac injc H := injection H; clear H;
                 repeat match goal with
                          |- _ = _ -> _ =>
                          intro; subst end.

  Ltac eqgoal :=
    match goal with
      |- ?a -> ?b => replace a with b; auto
    end.

  Ltac inst H :=
    let K := fresh in
    match goal with
    | [ G : ?x -> _ |- _ ] =>
      match G with
        H => assert (x) as K; [ clear H | specialize (H K); clear K ]
      end
    end.

  Fact eq_gen { X } (P : X -> Type) x : (forall y, y = x -> P y) -> P x.
  Proof. intros H; apply H, eq_refl. Qed.

  Ltac gen_eq t := apply eq_gen with (x := t).

  Fact eq_nat_pirr (n m : nat) (H1 H2 : n = m) : H1 = H2.
  Proof. apply UIP_dec, eq_nat_dec. Qed.

  (* Remove identities of the form H : n = n :> nat and eliminates H
   by replacing it with eq_refl *)

  Ltac natid :=
    repeat
      match goal with
      |  [ H: ?x = ?x :> nat |- _ ]  => let G := fresh
                                    in generalize (@eq_nat_pirr _ _ H eq_refl);
                                       intros G; subst H
      end;
    simpl eq_rect in * |- *.

  Local Ltac natSimpl :=
    repeat match goal with [ H : S _ = S _ |- _ ] => let G := fresh in injection H; intro G; subst; natid end.

  Local Ltac mydiscr :=
     repeat match goal with
            | H : _ = _ :> nat      |- _  => discriminate H; fail
            | H : _ = _ :> recalg _ |- _  => discriminate H; fail
            end.

  Local Ltac myauto := myinv; subst; natid; natSimpl; mydiscr; auto.

  Lemma ra_ca_cst_inv i v n x : [ra_cst i;v] -[n>> x -> n = 1 /\ x = i.
  Proof. inversion_clear 1; auto. Qed.

  Lemma ra_ca_zero_inv v n x : [ra_zero;v] -[n>> x -> n = 1 /\ x = 0.
  Proof. inversion_clear 1; auto. Qed.

  Lemma ra_ca_succ_inv v n x : [ra_succ;v] -[n>> x -> n = 1 /\ x = S (vec_head v).
  Proof. myauto. Qed.

  Local Ltac ra_inj :=
    match goal with
       | H : ra_proj _   = ra_proj _   |- _ => apply ra_proj_inj in H
       | H : ra_comp _ _ = ra_comp _ _ |- _ => apply ra_comp_inj in H; destruct H as (? & ? & ?)
       | H : ra_rec _ _  = ra_rec _ _  |- _ => apply ra_rec_inj in H; destruct H
       | H : ra_min _    = ra_min _    |- _ => apply ra_min_inj in H
    end; subst; simpl in * |- *.

  Lemma ra_ca_proj_inv k (p : pos k) v n x : [ra_proj p;v] -[n>> x -> n = 1 /\ x = vec_pos v p.
  Proof.
    myauto; ra_inj; auto.
  Qed.

  (* These 4 proofs use variable names which are hard coded
     in the tactic myinv ... they should not conflict with
     other variables names but be warned that this is not
     an ideal situation for the stability of those proofs
   *)

  Lemma ra_ca_comp_inv k i f (gj : vec (recalg i) k) v n x :
     [ra_comp f gj;v] -[n>> x -> exists p w q,
                                   n = 1+p+vec_sum q
                                /\ (forall j, [vec_pos gj j;v] -[vec_pos q j>> vec_pos w j)
                                /\ [f;w] -[p>> x.
  Proof.
    myauto; ra_inj.
    exists q', w', m'; auto.
  Qed.

  Lemma ra_ca_rec_0_inv k f g v n x :
    [@ra_rec k f g; 0##v] -[n>> x -> exists m, n = S m /\ [f;v] -[m>> x.
  Proof.
    myauto; ra_inj.
    exists m'; auto.
  Qed.

  Lemma ra_ca_rec_S_inv k f g v i n x :
     [@ra_rec k f g; S i##v] -[n>> x -> exists y p q,
                                          n = 1+q+p
                                       /\ [ra_rec f g; i##v] -[q>> y
                                       /\ [g; i##y##v] -[p>> x.
  Proof.
    myauto; ra_inj; natSimpl.
    exists y', q', p'; auto.
  Qed.

  Lemma ra_ca_min_inv k f v n x :
     [@ra_min k f;v] -[n>> x -> exists p w q,
                                 n = 1+p+vec_sum q
                              /\ [f;x##v] -[p>> 0
                              /\ forall j, [f;pos2nat j##v] -[vec_pos q j>> S (@vec_pos _ x w j).
  Proof.
    myauto; ra_inj.
    exists q', w', m'; auto.
  Qed.

End inversion_lemmas.


Set Implicit Arguments.

Definition myTrue : Prop := forall P:Prop, P->P. (* impredicative definition : refers to itself *)

Definition myFalse: Prop := forall P:Prop, P.    (* impredicative definition *)
(* It can be shown that no proof of myFalse exists from empty context *)

Theorem myTrue_holds: myTrue.
Proof.
  intros P p; assumption.
Qed.

Theorem myFalse_ind: forall P:Prop, myFalse -> P.
Proof.
  intros P H. apply H.
Qed.

Definition myNot (P:Prop) : Prop := P->myFalse.

Lemma L1 : myNot myFalse.
Proof.
  unfold myNot. intro H. exact H.
Qed.

Definition myAnd (P Q:Prop) :=
  forall R:Prop, (P->Q->R)->R.

Definition myOr (P Q:Prop) :=
  forall R:Prop, (P->R)->(Q->R)->R.

Definition myEx (A:Type)(P: A->Prop) :=
  forall R:Prop, (forall x:A, P x -> R)->R.

Lemma L2 : forall P Q:Prop, myAnd P Q -> P.
Proof.
  intros P Q H. unfold myAnd in H. apply H. intros p q. exact p.
Qed.

Lemma L3 : forall P Q:Prop, myAnd P Q -> Q.
Proof.
  intros P Q H. unfold myAnd in H. apply H. intros p q. exact q.
Qed.

Check and_ind. (* forall A B P : Prop, (A -> B -> P) -> A /\ B -> P *)
Lemma myAnd_ind : forall P Q R : Prop, (P->Q->R)-> myAnd P Q -> R.
Proof.
  intros P Q R H and. unfold myAnd in and. apply and. exact H.
Qed.

Lemma L4 : forall P Q: Prop, P-> myOr P Q.
Proof.
  intros P Q p. unfold myOr. intros R Hp Hq. apply Hp. exact p.
Qed.

Lemma L5 : forall P Q: Prop, Q-> myOr P Q.
Proof.
  intros P Q q. unfold myOr. intros R Hp Hq. apply Hq. exact q.
Qed.

Check or_ind. (* forall A B P : Prop, (A -> P) -> (B -> P) -> A \/ B -> P *)
Lemma myOr_ind : forall P Q R: Prop, (P->R) -> (Q->R) -> myOr P Q -> R.
Proof.
  intros P Q R Hp Hq H. apply H. exact Hp. exact Hq.
Qed.

Lemma L6 : forall P:Prop, myOr P myFalse -> P.
Proof.
  intros P H. unfold myOr in H. apply H. intro p. exact p. apply myFalse_ind.
Qed.

Lemma L7 : forall P Q:Prop, myOr P Q -> myOr Q P.
Proof.
  intros P Q H. unfold myOr in H. apply H.
  apply L5 with (Q:=P)(P:=Q). apply L4 with (Q:=P)(P:=Q).
Qed.

Check ex_ind. (* forall (A : Type) (P : A -> Prop) (P0 : Prop),
                (forall x : A, P x -> P0) -> (exists x, P x) -> P0 *)

Check ex_intro. (* forall (A : Type) (P : A -> Prop) (x : A), P x -> exists x, P x *)

Lemma myEX_intro : forall (A:Type)(P:A->Prop)(a:A), P a -> myEx P.
Proof.
  intros A P a H. unfold myEx. intros R All. apply All with (x:=a). exact H.
Qed.

Lemma L8 : forall (A:Type)(P:A->Prop),
  myNot (myEx P) -> forall a:A, myNot (P a).
Proof.
  intros A P H a. unfold myNot. unfold myNot in H. intro Pa. apply H. unfold myEx.
  intros R all. apply all with (x:=a). exact Pa.
Qed.

Definition myLe (n p:nat) :=
  forall P:nat->Prop, P n -> (forall q:nat, P q -> P (S q)) -> P p.

Check le_n. (* forall n : nat, n <= n *)

Lemma myLe_n : forall n:nat, myLe n n.
Proof.
  unfold myLe. intros n P H0 H1. exact H0.
Qed.

Check le_S. (* forall n m : nat, n <= m -> n <= S m *)

Lemma myLe_S : forall n m:nat, myLe n m -> myLe n (S m).
Proof.
  intros n m H. unfold myLe in H. apply H. unfold myLe.
  intros P Pn Stable. apply Stable. exact Pn. intros q H0.
  unfold myLe. intros P Pn Stable. unfold myLe in H0. apply Stable.
  apply H0. exact Pn. exact Stable.
Qed.

Lemma myLe_le : forall n m:nat, myLe n m -> n <=  m.
Proof.
  intros n m H. unfold myLe in H. apply H. apply le_n.
  intros q H0. apply le_S. exact H0.
Qed.

Check nat_ind. (* forall P : nat -> Prop,
       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n *)

Lemma le_myLe : forall n m: nat, n <= m -> myLe n m.
Abort.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Core logical definitions (all imported from the Prelude)                *
**************************************************************************)

Set Implicit Arguments.

(* ********************************************************************** *)
(** * Basic logical connectives *)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [True] *)

(** From Prelude:

    Inductive True : Prop :=
      | I : True.

    Hint Constructors True : core.

  Remark: [constructor] should be renamed to [True_intro].
  Single-letter variable names should be reserved to the user.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [False] *)

(** From Prelude:

    Inductive False : Prop := .

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [not] *)

(** From Prelude:

  Definition not (P : Prop) := P -> False.

  Notation "~ x" := (not x) : type_scope.

  Hint Unfold not : core.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [and] *)

(** From Prelude:

    Inductive and (P Q : Prop) : Prop :=
      | conj : P -> Q -> and P Q.

    Notation "P /\ Q" := (and P Q) : type_scope.

    Hint Constructors and : core.

    Lemma proj1 : forall (P Q : Prop), P /\ Q -> P.
    Proof using. autos*. Qed.

    Lemma proj2 : forall (P Q : Prop), P /\ Q -> Q.
    Proof using. autos*. Qed.

  Remark: to follow conventions, [conj] should be renamed to [and_intro].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [or] *)

(** From Prelude:

    Inductive or (P Q : Prop) : Prop :=
      | or_introl : P -> or P Q
      | or_intror : Q -> or P Q.

    Notation "A \/ B" := (or A B) : type_scope.

    Hint Constructors or : core.

  Remark: to follow conventions, constructors should be [or_l] and [or_r].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [iff] *)

(** From Prelude:

      Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

      Notation "P <-> Q" := (iff P Q) : type_scope.

      Hint Unfold iff.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [eq] *)

(** From Prelude:

      Inductive eq (A:Type) (x:A) : A -> Prop :=
        | eq_refl : eq x y.

      Notation "x = y :> A" := (@eq A x y) : type_scope.
      Notation "x = y" := (eq x y) : type_scope.
      Notation "x <> y :> A" := (~ @eq A x y) : type_scope.
      Notation "x <> y" := (~ eq x y) : type_scope.

      Arguments eq_ind [A].
      Arguments eq_rec [A].
      Arguments eq_rect [A].

      Hint Constructors eq : core.

  Remark : to follow conventions, constructors should be named [eq_intro],
  or [refl_eq].
*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [exists x, P] *)

(** From Prelude:

    Inductive ex (A : Type) (P : A->Prop) : Prop :=
      | ex_intro : forall x, P x -> ex P.

    Notation "'exists' x , p" := (ex (fun x => p))
      (at level 200, x ident, right associativity) : type_scope.
    Notation "'exists' x : t , p" := (ex (fun x:t => p))
      (at level 200, x ident, right associativity,
        format "'[' 'exists'  '/  ' x  :  t ,  '/  ' p ']'")
      : type_scope.

    Hint Constructors ex : core.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [forall x, P] and [P -> Q] *)

(** [forall] and [->] are builtin in the logic.
    [P -> Q] is short for [forall (_:P), Q]. *)

(** From Prelude:

    Definition all (A : Type) (P : A->Prop) := forall (x:A), P x.

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [{x | P}] (subset type) *)

(** From Prelude:

    Inductive sig (A : Type) (P : A->Prop) : Type :=
      | exist : forall x, P x -> sig P.

    Notation "{ x | P }" := (sig (fun x => P)) : type_scope.
    Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope.
    Add Printing Let sig.

  Remark : to follow conventions, constructor should be named [sig_intro].

*)

(* ---------------------------------------------------------------------- *)
(** ** Definition of [{x & P}] (subset type in Type) *)

(** From Prelude:

    Inductive sigT (A : Type) (P : A -> Type) : Type :=
      | existT : forall x, P x -> sigT P.

    Notation "{ x & P }" := (sigT (fun x:A => P)) : type_scope.
    Notation "{ x : A & P }" := (sigT (fun x:A => P)) : type_scope.
    Add Printing Let sigT.

  Remark : to follow conventions, constructor should be named [sigT_intro].

*)


Definition divides (n m : nat) := exists p : nat, p*n = m.

Require Import Arith.
Require Import Omega.

Theorem divides_0 : forall n : nat, divides n 0.
Proof.
  intros n. unfold divides. exists 0. auto with arith.
Qed.

Theorem divides_plus : forall n m : nat, divides n m -> divides n (n + m).
Proof.
  intros n m H; elim H; intros p H'; exists (S p). simpl. auto with arith.
Qed.

Theorem not_divides_plus : forall n m : nat, ~divides n m -> ~divides n (n + m).
Proof.
  intros n m H; unfold not; intros H'; elim H'; intros x.
  case x; simpl.
  intros H''; apply H.
  cut (m=0).
  intros H'''; rewrite H'''; apply divides_0.
  omega.
  intros n0 H''; apply H.
  unfold divides; exists n0.
  omega.
Qed.

Theorem not_divides_tl : forall n m : nat, 0 < m -> m < n -> ~ divides n m.
Proof.
  intros n m H H0 H1.
  elim H1; intros x H2.
  rewrite <- H2 in H.
  rewrite <- H2 in H0.
  generalize H H0.
  case x.
  intros H'; absurd (0 < 0 * n); auto with arith.
  intros n0. simpl.
  intros H3 H4.
  absurd (n <= n + n0 * n); auto with arith.
Qed.

Theorem not_lt_2_divides :
  forall n m : nat, n <> 1 -> n < 2 -> 0 < m ->
                    ~ divides n m.
Proof.
  intros n m h h0.
  cut (n = 0).
  intros h1.
  rewrite h1.
  case m.
  intros h2; absurd (0 < 0); [auto with arith | trivial].
  intros n0 h3 h4. elim h4.
  intros n1. omega.
  omega.
Qed.

Theorem  le_plus_minus : forall n m:nat, le n m -> m = n+(m-n).
Proof.  intros n m h.  omega. Qed.

Theorem  lt_lt_or_eq : forall n m:nat, n < S m ->  n<m \/  n=m.
Proof.  intros n m. omega. Qed.

 (*
Zpos_xI  : forall p:positive, Zpos (xI p) = (2 * Zpos p + 1)%Z
Zpos_xO  : forall p:positive, Zpos (xO p) = (2 * Zpos p)%Z
  *)

Ltac repeat_rewrite :=
  match goal with
    |- context [Zpos (xO ?p)] =>
    match p with
      | xH => fail 1
      | ?x2 => rewrite (Zpos_xO x2); repeat_rewrite
    end
  | |- context [Zpos (xI ?p)] =>
    match p with
    | xH => fail 1
    | ?x2 => rewrite (Zpos_xI x2); repeat_rewrite
    end
  | |- _ => idtac
  end.


(*
  Some experiments with equality.
  1. About the definitionand the usual properties of equality.
  2. The Axiom of Extensionality for equality.
*)

Print eq.

Eval simpl in (eq 2 2).   (* 2=2:Prop *)

Eval simpl in 1=2 /\ 2=2.

(* Coq out-of-the-box example first *)

Lemma coq_equality_is_transitive : forall (T : Type) (x y z: T),
 x = y /\ y = z -> x = z.
Proof.
  intros T x y z H.
  inversion H as [Hx Hy].
  rewrite -> Hx.
  rewrite -> Hy.
  reflexivity.
Qed.

(* similarly,  = is transitive   *)

Module My_Equality.  (* equality test kitchen *)

(* Print eql. *)   (* not defined *)

Inductive eql {T : Type} (x : T) : T -> Prop :=
  eql_refl : eql x x.

Print eq.
Print eql.

Lemma eql_is_transitive_trans : forall (T : Type) (x y z: T),
 eql x y /\ eql y z -> eql x z.
Proof.
  intros T x y z H.
  inversion H as [Hx Hy].
  (* rewrite -> Hx.  NO!  *)
  induction Hx.
  induction Hy.
  (* reflexivity.  NO! *)
  apply eql_refl.
Qed.

Lemma eql_is_symmetric : forall (T : Type) (x y : T),
 eql x y -> eql y x.
Proof.
  intros X x y H.  (* i.e. call T X *)
  induction H.
  (* reflexivity.  NO! *)
  apply eql_refl.
Qed.

Lemma eql_is_leibniz_equality : forall (T : Type) (x y: T),
 eql x y -> forall P : T -> Prop, P x -> P y.
Proof.  (* same as for builtin Coq = *)
intros X x y H.
induction H.
intros P H. apply H.
Qed.

(* eql has same definition as eq so, of course ... *)
Theorem eql_is_eq : forall (T: Type) (x y : T),
   eql x y <-> x = y.
Proof.
intros T x y.
split.
(* -> *)
intros H. induction H. reflexivity.
(* <- *)
intros H. subst.
apply eql_refl.
Qed.

(* extensionality for our eql *)
Axiom eql_extensionality :
  forall {X Y: Type} {f g : X -> Y},
    (forall (x: X), f x = g x) ->  eql f g.

Definition f (m : nat) : nat := m+1.
Definition g (n : nat) : nat := 1+n.
Definition h (o : nat) : nat := o+1.

Lemma plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* known *) Admitted.

Lemma a : eql f g.
Proof. apply eql_extensionality.
(* work from inside out *)
intros.  unfold f. unfold g. apply plus_comm.
Qed.

Lemma b : f = h.
Proof. reflexivity.  (* definitions of f and h unify *)
Qed.

Lemma c : f = g.
Proof. (* error reflexivity. *)
unfold f. unfold g. (* STUCK  *)
Abort. (* because = has no extensionality axiom *)

End My_Equality.


(* proplogicST.v - ver 0.1 - Steven Tschantz - 2/3/22*)
(* Laguage, sematics, and proofs for proposition logic *)
(* Lukasiewicz axiom system with countably many variables *)
(* PL = Propositional Logic *)

Require Import List.
Require Import Arith.

Section PL_options.

(* Index variables by nat.  Or switch? *)

Definition PL_VarIndex : Type := nat.

Theorem PL_decidableVarIndex : forall {x y : PL_VarIndex}, {x = y} + {~ x = y}.
Proof.
decide equality.
Qed.

Definition PL_varO := O.

Definition PL_varS := S.

Definition PL_varle := le.

Definition PL_varlt := lt.

Definition PL_varmax := max.

(* Take valuations in type bool.  For now? *)

Definition PL_Value : Type := bool.

Definition PL_neg_interpretation (b : PL_Value) : PL_Value :=  negb b.

Definition PL_imp_interpretation (b c : PL_Value) : PL_Value := orb (negb b) c.

Definition PL_top_interpretation : PL_Value := true.

Definition PL_bot_interpretation : PL_Value := false.

End PL_options.

Section PL_language.

(* We give an inductive definition of formulas *)
Inductive PL_Formula: Type :=
| PL_var : PL_VarIndex->PL_Formula
| PL_neg : PL_Formula->PL_Formula
| PL_imp : PL_Formula->PL_Formula->PL_Formula
.

Definition PL_and (A B : PL_Formula) : PL_Formula :=
PL_neg (PL_imp A (PL_neg B)).

Definition PL_or (A B : PL_Formula) : PL_Formula :=
PL_imp (PL_neg A) B.

Definition PL_iff (A B : PL_Formula) : PL_Formula :=
PL_and (PL_imp A B) (PL_imp B A).

Definition PL_top : PL_Formula := PL_imp (PL_var 0) (PL_var 0).

Definition PL_bot : PL_Formula := PL_neg PL_top.

Definition PL_listor (S : list PL_Formula) : PL_Formula :=
  fold_right PL_or PL_bot S.

Definition PL_listand (S : list PL_Formula) : PL_Formula :=
  fold_right PL_and PL_top S.

Definition PL_decidableFormula (A B : PL_Formula) : {A = B} + {~ A = B}.
Proof.
decide equality.
apply PL_decidableVarIndex.
Defined.

Definition PL_SubstFunction : Type := PL_VarIndex -> PL_Formula.

Fixpoint PL_subst (s : PL_SubstFunction) (A : PL_Formula) : PL_Formula :=
match A with
| PL_var n => s n
| PL_neg X => PL_neg (PL_subst s X)
| PL_imp X Y => PL_imp (PL_subst s X) (PL_subst s Y)
end.

Definition PL_subst1 (A : PL_Formula) : PL_SubstFunction :=
fun (n : nat) =>
match n with
| O => A
| _ => PL_var n
end.

Definition PL_subst2 (A B : PL_Formula) : PL_SubstFunction :=
fun (n : nat) =>
match n with
| O => A
| 1 => B
| _ => PL_var n
end.

Definition PL_subst3 (A B C : PL_Formula) : PL_SubstFunction :=
fun (n : nat) =>
match n with
| O => A
| 1 => B
| 2 => C
| _ => PL_var n
end.

Definition PL_subst_compose (s t : PL_SubstFunction) : PL_SubstFunction :=
fun (n : PL_VarIndex) => PL_subst s (t n).

Theorem PL_subst_subst :
forall (s t : PL_SubstFunction) (A : PL_Formula),
  PL_subst (PL_subst_compose s t) A = PL_subst s (PL_subst t A).
Proof.
intros s t A.
induction A as [n | A H1 | A H2 B H3].
reflexivity.
simpl.
rewrite H1.
reflexivity.
simpl.
rewrite H2.
rewrite H3.
reflexivity.
Qed.

(* Important formulas as examples *)

Definition PL_axiom1prototype : PL_Formula :=
(PL_imp (PL_var 0) (PL_imp (PL_var 1) (PL_var 0))).

Definition PL_axiom2prototype : PL_Formula :=
PL_imp
 (PL_imp (PL_var 0) (PL_imp (PL_var 1) (PL_var 2)))
 (PL_imp (PL_imp (PL_var 0) (PL_var 1)) (PL_imp (PL_var 0) (PL_var 2))).

Definition PL_axiom3prototype : PL_Formula :=
PL_imp
  (PL_imp (PL_neg (PL_var 0)) (PL_neg (PL_var 1)))
  (PL_imp (PL_var 1) (PL_var 0)).

Definition PL_axiom1instance (A B : PL_Formula) : PL_Formula :=
PL_subst (PL_subst2 A B) PL_axiom1prototype.

Definition PL_axiom2instance (A B C : PL_Formula) : PL_Formula :=
PL_subst (PL_subst3 A B C) PL_axiom2prototype.

Definition PL_axiom3instance (A B : PL_Formula) : PL_Formula :=
PL_subst (PL_subst2 A B) PL_axiom3prototype.

End PL_language.

Section PL_semantics.

(* These are the "models" *)
Definition PL_Valuation : Type := PL_VarIndex -> PL_Value.

(* This is the interpretation of a formula in a "model" *)
Fixpoint PL_interpretation (f : PL_Valuation) (A : PL_Formula) : PL_Value :=
match A with
| PL_var n => f n
| PL_neg X => PL_neg_interpretation (PL_interpretation f X)
| PL_imp X Y => PL_imp_interpretation (PL_interpretation f X) (PL_interpretation f Y)
end.

(* This is then $f\models A$ *)
Definition PL_models (f : PL_Valuation) (A : PL_Formula) : Prop :=
PL_interpretation f A = PL_top_interpretation.

(* We start with only finite lists of assumptions.  We might like to generalize this. *)
(* This is when a (finite) set of formulas semantically entails a formula, $S\models A$ *)
Definition PL_list_models (S : list PL_Formula) (A : PL_Formula) : Prop :=
forall (f : PL_Valuation),
  Forall (PL_models f) S -> PL_models f A.

Theorem PL_sublist_models :
forall (S T : list PL_Formula) (A : PL_Formula),
  incl S T -> PL_list_models S A -> PL_list_models T A.
Proof.
intros S T A H1 H2 f H3.
apply H2.
apply incl_Forall with T.
assumption.
assumption.
Qed.

Definition PL_valid (A : PL_Formula) : Prop := PL_list_models nil A.

Theorem PL_valid_list_models:
forall (S : list PL_Formula) (A : PL_Formula),
  PL_valid A -> PL_list_models S A.
Proof.
intros S A.
apply PL_sublist_models.
apply incl_nil_l.
Qed.

Definition PL_valuation_subst (f : PL_Valuation) (s : PL_SubstFunction) : PL_Valuation :=
fun (n : PL_VarIndex) => PL_interpretation f (s n).

Theorem PL_interpretation_subst :
forall (f : PL_Valuation) (s : PL_SubstFunction) (A : PL_Formula),
  PL_interpretation f (PL_subst s A) = PL_interpretation (PL_valuation_subst f s) A.
Proof.
intros f s A.
induction A as [n|X H1|X H2 Y H3].
reflexivity.
simpl.
rewrite H1.
reflexivity.
simpl.
rewrite H2.
rewrite H3.
reflexivity.
Qed.

Theorem PL_models_subst :
forall (f : PL_Valuation) (s : PL_SubstFunction) (A : PL_Formula),
  PL_models f (PL_subst s A) <-> PL_models (PL_valuation_subst f s) A.
Proof.
intros f s A.
unfold PL_models.
rewrite PL_interpretation_subst.
tauto.
Qed.

Theorem PL_valid_subst_valid :
forall (s : PL_SubstFunction) (A : PL_Formula),
  PL_valid A -> PL_valid (PL_subst s A).
Proof.
intros s A H1 f H2.
assert (H3 : PL_models (PL_valuation_subst f s) A).
apply H1.
auto.
rewrite PL_models_subst.
assumption.
Qed.

Theorem PL_axiom1prototypevalid : PL_valid PL_axiom1prototype.
Proof.
intros f H.
vm_compute.
destruct (f 0); destruct (f 1); reflexivity.
Qed.

Theorem PL_axiom2prototypevalid : PL_valid PL_axiom2prototype.
Proof.
intros f H.
vm_compute.
destruct (f 0); destruct (f 1); destruct (f 2); reflexivity.
Qed.

Theorem PL_axiom3prototypevalid : PL_valid PL_axiom3prototype.
Proof.
intros f H.
vm_compute.
destruct (f 0); destruct (f 1); reflexivity.
Qed.

Theorem PL_axiom1instancevalid :
forall (A B : PL_Formula), PL_valid (PL_axiom1instance A B).
Proof.
intros A B.
unfold PL_axiom1instance.
apply PL_valid_subst_valid.
apply PL_axiom1prototypevalid.
Qed.

Theorem PL_axiom2instancevalid :
forall (A B C : PL_Formula), PL_valid (PL_axiom2instance A B C).
Proof.
intros A B C.
unfold PL_axiom2instance.
apply PL_valid_subst_valid.
apply PL_axiom2prototypevalid.
Qed.

Theorem PL_axiom3instancevalid :
forall (A B : PL_Formula), PL_valid (PL_axiom3instance A B).
Proof.
intros A B.
unfold PL_axiom3instance.
apply PL_valid_subst_valid.
apply PL_axiom3prototypevalid.
Qed.

Theorem PL_MPvalid :
forall (S : list PL_Formula) (A B : PL_Formula),
  PL_list_models S A -> PL_list_models S (PL_imp A B) -> PL_list_models S B.
Proof.
intros S A B H1 H2 f H3.
assert (H4 := H2 f H3).
revert H4.
assert (H5 := H1 f H3).
revert H5.
unfold PL_models.
simpl.
destruct (PL_interpretation f A);
destruct (PL_interpretation f B);
auto.
Qed.

End PL_semantics.

Section PL_decidable_semantics.

(* We don't acutally need arbitrary functions on all variables to decide truth. *)
(* Only finitely many variables occur in any list of formulas. *)
(* Consider then funtions that are eventually constant. *)

Fixpoint PL_formula_var_bound (b : PL_VarIndex) (A : PL_Formula) : Prop :=
match A with
| PL_var n => PL_varlt n b
| PL_neg X => PL_formula_var_bound b X
| PL_imp X Y => PL_formula_var_bound b X /\ PL_formula_var_bound b Y
end.

Definition PL_formula_list_var_bound (b : PL_VarIndex) (S : list PL_Formula) : Prop :=
Forall (PL_formula_var_bound b) S.

Theorem PL_formula_list_var_bound_nil_iff :
forall (b : PL_VarIndex), PL_formula_list_var_bound b nil <-> True.
Proof.
unfold PL_formula_list_var_bound.
intros b. split.
tauto.
intros H1.
apply Forall_nil.
Qed.

Theorem PL_formula_list_var_bound_cons_iff :
forall (b : PL_VarIndex) (S : list PL_Formula) (A : PL_Formula),
  PL_formula_list_var_bound b (A::S) <->
  PL_formula_var_bound b A /\ PL_formula_list_var_bound b S.
Proof.
unfold PL_formula_list_var_bound.
intros b. split.
intros H1.
split.
apply (Forall_inv H1).
apply (Forall_inv_tail H1).
intros [H2 H3].
apply Forall_cons.
assumption.
assumption.
Qed.

Fixpoint PL_formula_var_max (A : PL_Formula) : PL_VarIndex :=
match A with
| PL_var n => PL_varS n
| PL_neg X => PL_formula_var_max X
| PL_imp X Y => PL_varmax (PL_formula_var_max X) (PL_formula_var_max Y)
end.

Definition PL_formula_list_var_max (S : list PL_Formula) : PL_VarIndex :=
fold_right PL_varmax PL_varO (map PL_formula_var_max S).

Theorem PL_formula_list_var_max_nil_eq :
PL_formula_list_var_max nil = PL_varO.
Proof.
reflexivity.
Qed.

Theorem PL_formula_list_var_max_cons_eq :
forall (S : list PL_Formula) (A : PL_Formula),
  PL_formula_list_var_max (A::S) =
  PL_varmax (PL_formula_var_max A) (PL_formula_list_var_max S).
Proof.
unfold PL_formula_list_var_max.
intros S A.
reflexivity.
Qed.

Theorem PL_formula_var_bound_monotonic :
forall (m n : PL_VarIndex) (A : PL_Formula),
  PL_varle m n -> PL_formula_var_bound m A -> PL_formula_var_bound n A.
Proof.
intros m n.
induction A as [k|X H1|X H2 Y H3].
vm_compute. intros. apply le_trans with m; assumption.
simpl. assumption.
simpl. tauto.
Qed.

Theorem PL_formula_list_var_bound_monotonic :
forall (m n : PL_VarIndex) (S : list PL_Formula),
  PL_varle m n -> PL_formula_list_var_bound m S -> PL_formula_list_var_bound n S.
Proof.
unfold PL_formula_list_var_bound.
intros m n S H1 H2. induction H2 as [|A T H3 H4 H5].
apply Forall_nil.
apply Forall_cons.
apply PL_formula_var_bound_monotonic with m.
assumption.
assumption.
assumption.
Qed.

Theorem PL_formula_var_bound_max :
forall (A : PL_Formula),
  PL_formula_var_bound (PL_formula_var_max A) A.
Proof.
induction A as [n|X H1|X H2 Y H3].
vm_compute. apply le_n.
simpl. assumption.
simpl. split.
apply PL_formula_var_bound_monotonic with (PL_formula_var_max X).
apply Nat.le_max_l. assumption.
apply PL_formula_var_bound_monotonic with (PL_formula_var_max Y).
apply Nat.le_max_r. assumption.
Qed.

Theorem PL_formula_list_var_bound_max :
forall (S : list PL_Formula),
  PL_formula_list_var_bound (PL_formula_list_var_max S) S.
Proof.
induction S as [|A T H1].
apply Forall_nil.
rewrite PL_formula_list_var_bound_cons_iff.
split.
apply PL_formula_var_bound_monotonic with (PL_formula_var_max A).
unfold PL_formula_list_var_max. simpl.
apply Nat.le_max_l.
apply PL_formula_var_bound_max.
apply PL_formula_list_var_bound_monotonic with (PL_formula_list_var_max T).
apply Nat.le_max_r.
assumption.
Qed.

Theorem PL_formula_var_max_list_var_max :
  forall (B : PL_Formula) (S : list PL_Formula),
  In B S -> le (PL_formula_var_max B) (PL_formula_list_var_max S).
Proof.
intros B S.
induction S as [|B1 S1 H1].
intros H2.
exfalso.
revert H2.
apply in_nil.
unfold PL_formula_list_var_max.
simpl fold_right. simpl In.
intros [H3|H4].
rewrite <- H3.
apply Nat.le_max_l.
apply le_trans with (PL_formula_list_var_max S1).
apply H1.
assumption.
apply Nat.le_max_r.
Qed.

Definition PL_valuations_eq_before (b : PL_VarIndex) (f g : PL_Valuation) : Prop :=
forall (n : PL_VarIndex), PL_varlt n b -> f n = g n.

Theorem PL_interpretations_eq_before :
forall (b : PL_VarIndex) (f g : PL_Valuation) (A : PL_Formula),
  PL_valuations_eq_before b f g ->
  PL_formula_var_bound b A ->
  PL_interpretation f A = PL_interpretation g A.
Proof.
intros b f g A H1. revert A.
induction A as [n|X H2|X H3 Y H4].
simpl. apply H1.
simpl. intros H5. assert (H6 := H2 H5).
destruct (PL_interpretation f X); destruct (PL_interpretation g X);
try (reflexivity); discriminate H6.
simpl. intros [H7 H8]. assert (H9 := H3 H7). assert (H10 := H4 H8).
destruct (PL_interpretation f X); destruct (PL_interpretation g X);
destruct (PL_interpretation f Y); destruct (PL_interpretation g Y);
try (reflexivity); try (discriminate H9); discriminate H10.
Qed.

Theorem PL_models_eq_before :
forall (b : PL_VarIndex) (f g : PL_Valuation) (A : PL_Formula),
  PL_valuations_eq_before b f g ->
  PL_formula_var_bound b A ->
  PL_models f A <-> PL_models g A.
Proof.
intros b f g A H1 H2.
unfold PL_models.
split.
intros H3.
rewrite <- (PL_interpretations_eq_before b f _ _ H1 H2).
assumption.
intros H4.
rewrite (PL_interpretations_eq_before b f _ _ H1 H2).
assumption.
Qed.

Theorem PL_models_list_eq_before :
forall (b : PL_VarIndex) (f g : PL_Valuation) (S : list PL_Formula),
  PL_valuations_eq_before b f g ->
  PL_formula_list_var_bound b S ->
  Forall (PL_models f) S <-> Forall (PL_models g) S.
Proof.
intros b f g S H1.
unfold PL_formula_list_var_bound.
do 3 rewrite Forall_forall.
unfold PL_models.
intros H2.
split.
intros H3 A H4.
rewrite <- (PL_interpretations_eq_before b f _ _ H1 (H2 A H4)).
apply H3.
assumption.
intros H5 A H6.
rewrite (PL_interpretations_eq_before b f _ _ H1 (H2 A H6)).
apply H5.
assumption.
Qed.

Definition PL_valuation_shift_down (f : PL_Valuation) : PL_Valuation :=
fun (n : PL_VarIndex) => f (S n).

Theorem PL_valuations_eq_before_S_iff :
forall (b : PL_VarIndex) (f g : PL_Valuation),
  PL_valuations_eq_before (S b) f g <->
  f PL_varO = g PL_varO /\
  PL_valuations_eq_before b (PL_valuation_shift_down f) (PL_valuation_shift_down g).
Proof.
intros b f g.
split.
intros H1.
split.
apply (H1 0).
apply le_n_S.
apply le_O_n.
intros n H2.
unfold PL_valuation_shift_down.
apply H1.
apply le_n_S.
assumption.
intros [H3 H4] n H5.
destruct n as [|n1].
apply H3.
apply H4.
apply le_S_n.
assumption.
Qed.

Definition PL_valuation_top : PL_Valuation := fun (n : PL_VarIndex) => PL_top_interpretation.

Definition PL_valuation_bot : PL_Valuation := fun (n : PL_VarIndex) => PL_bot_interpretation.

Definition PL_valuation_shift_up_top (f : PL_Valuation) : PL_Valuation :=
fun (n : PL_VarIndex) =>
  match n with
  | O => PL_top_interpretation
  | S n1 => f n1
  end.

Definition PL_valuation_shift_up_bot (f : PL_Valuation) : PL_Valuation :=
fun (n : PL_VarIndex) =>
  match n with
  | O => PL_bot_interpretation
  | S n1 => f n1
  end.

Fixpoint PL_test_valuations (n : PL_VarIndex) : list (PL_Valuation) :=
match n with
| O => PL_valuation_top :: PL_valuation_bot :: nil
| S n1 => (map PL_valuation_shift_up_top (PL_test_valuations n1)) ++
          (map PL_valuation_shift_up_bot (PL_test_valuations n1))
end.

(* A test
Eval compute in (map (fun (f:PL_Valuation)=>f 0 :: f 1 :: f 2 ::nil) (PL_test_valuations 2)).
*)

Lemma PL_shift_up_top_shift_down:
forall (f : PL_Valuation),
  f 0 = PL_top_interpretation ->
  forall (n : PL_VarIndex),
    f n = PL_valuation_shift_up_top (PL_valuation_shift_down f) n.
Proof.
intros f H1 n.
destruct n as [|n1].
assumption.
reflexivity.
Qed.

Lemma PL_shift_up_bot_shift_down:
forall (f : PL_Valuation),
  f 0 = PL_bot_interpretation ->
  forall (n : PL_VarIndex),
    f n = PL_valuation_shift_up_bot (PL_valuation_shift_down f) n.
Proof.
intros f H1 n.
destruct n as [|n1].
assumption.
reflexivity.
Qed.

Lemma PL_shift_back_top :
forall (b : PL_VarIndex) (f g : PL_Valuation),
  f O = PL_top_interpretation ->
  PL_valuations_eq_before b (PL_valuation_shift_down f) g ->
  PL_valuations_eq_before (S b) f (PL_valuation_shift_up_top g).
Proof.
intros b f g H1 H2 n H3.
destruct n as [|n1].
assumption.
rewrite (PL_shift_up_top_shift_down f H1).
simpl.
apply H2.
apply le_S_n.
assumption.
Qed.

Lemma PL_shift_back_bot :
forall (b : PL_VarIndex) (f g : PL_Valuation),
  f O = PL_bot_interpretation ->
  PL_valuations_eq_before b (PL_valuation_shift_down f) g ->
  PL_valuations_eq_before (S b) f (PL_valuation_shift_up_bot g).
Proof.
intros b f g H1 H2 n H3.
destruct n as [|n1].
assumption.
rewrite (PL_shift_up_bot_shift_down f H1).
simpl.
apply H2.
apply le_S_n.
assumption.
Qed.

Theorem PL_bounded_valuations_listed :
forall (b : PL_VarIndex) (f : PL_Valuation),
  exists (g : PL_Valuation), In g (PL_test_valuations b) /\ PL_valuations_eq_before b f g.
Proof.
induction b as [|b1 H1].
intros f. exists PL_valuation_top.
split.
simpl.
auto.
intros n H2.
exfalso.
apply (le_Sn_O _ H2).
intros f.
destruct (H1 (PL_valuation_shift_down f)) as [g1 [H3 H4]].
destruct (f O) eqn: H5.
exists (PL_valuation_shift_up_top g1).
split.
simpl PL_test_valuations.
apply in_or_app.
left.
apply in_map.
assumption.
rewrite PL_valuations_eq_before_S_iff.
split.
assumption.
apply H4.
exists (PL_valuation_shift_up_bot g1).
split.
simpl PL_test_valuations.
apply in_or_app.
right.
apply in_map.
assumption.
rewrite PL_valuations_eq_before_S_iff.
split.
assumption.
apply H4.
Qed.

Definition PL_list_models_b (S : list PL_Formula) (A : PL_Formula) : bool :=
forallb
  (fun (f : PL_Valuation) =>
     PL_imp_interpretation (forallb (PL_interpretation f) S) (PL_interpretation f A))
  (PL_test_valuations (PL_varmax (PL_formula_list_var_max S) (PL_formula_var_max A))).

Definition PL_list_models_b_reflects_PL_list_models:
forall (S : list PL_Formula) (A : PL_Formula),
  PL_list_models_b S A = true <-> PL_list_models S A.
Proof.
intros S A.
set (b := PL_varmax (PL_formula_list_var_max S) (PL_formula_var_max A)).
set (test := PL_test_valuations b).
split.
intros H1 f H2.
destruct (PL_bounded_valuations_listed b f) as [g [H3 H4]].
assert (H5 : Forall (PL_models g) S).
rewrite <- (PL_models_list_eq_before b f g S).
assumption.
assumption.
unfold b.
apply PL_formula_list_var_bound_monotonic with (PL_formula_list_var_max S).
apply Nat.le_max_l.
apply PL_formula_list_var_bound_max.
rewrite Forall_forall in H5.
unfold PL_models in H5.
unfold PL_list_models_b in H1.
rewrite forallb_forall in H1.
unfold PL_models.
rewrite (PL_interpretations_eq_before b f g).
assert (H6 := H1 g H3).
destruct (PL_interpretation g A) eqn: H7;
destruct (forallb (PL_interpretation g) S) eqn: H8;
try reflexivity; try discriminate H6.
assert (H9 := (forallb_forall (PL_interpretation g) S)).
destruct H9 as [H10 H11].
rewrite H11 in H8.
discriminate H8.
assumption.
assumption.
unfold b.
apply PL_formula_var_bound_monotonic with (PL_formula_var_max A).
apply Nat.le_max_r.
apply PL_formula_var_bound_max.
unfold PL_list_models, PL_models.
unfold PL_list_models_b.
rewrite forallb_forall.
intros H12 g H13.
destruct (forallb (PL_interpretation g) S) eqn: H14;
destruct (PL_interpretation g A) eqn: H15;
try reflexivity.
rewrite H12 in H15.
discriminate H15.
rewrite Forall_forall.
rewrite forallb_forall in H14.
assumption.
Defined.

Definition PL_list_models_decidable (S : list PL_Formula) (A : PL_Formula) :
  {PL_list_models S A} + {~ PL_list_models S A}.
Proof.
destruct (PL_list_models_b S A) eqn: H1.
left.
apply PL_list_models_b_reflects_PL_list_models.
assumption.
right.
rewrite <- PL_list_models_b_reflects_PL_list_models.
intros H2.
rewrite H2 in H1.
discriminate H1.
Defined.

Definition PL_valid_decidable (A : PL_Formula) :
  {PL_valid A} + {~ PL_valid A}.
Proof.
apply PL_list_models_decidable.
Defined.

End PL_decidable_semantics.

Section PL_proofs.

Inductive PL_list_proof (S : list PL_Formula) : PL_Formula -> Type :=
| PL_assumption : forall (A : PL_Formula), In A S -> PL_list_proof S A
| PL_axiom1 : forall (A B : PL_Formula), PL_list_proof S (PL_axiom1instance A B)
| PL_axiom2 : forall (A B C : PL_Formula), PL_list_proof S (PL_axiom2instance A B C)
| PL_axiom3 : forall (A B : PL_Formula), PL_list_proof S (PL_axiom3instance A B)
| PL_MP : forall (A B : PL_Formula),
    PL_list_proof S A -> PL_list_proof S (PL_imp A B) -> PL_list_proof S B
.

Definition PL_list_proves (S : list PL_Formula) (A : PL_Formula) :=
  inhabited (PL_list_proof S A).

Definition PL_list_proof_weaken (S T : list PL_Formula)
  (subsetST : forall (X : PL_Formula), In X S -> In X T) (A : PL_Formula)
  (p : PL_list_proof S A) : PL_list_proof T A.
Proof.
induction p as [A0 H1|A1 B1|A2 B2 C2|A3 B3|A4 B4 H2 H3 H4 H5].
apply PL_assumption.
apply subsetST.
assumption.
apply PL_axiom1.
apply PL_axiom2.
apply PL_axiom3.
apply (PL_MP _ A4).
assumption.
assumption.
Qed.

Definition PL_subst_proof (s : PL_SubstFunction) (S : list PL_Formula) (A : PL_Formula)
  (p : PL_list_proof S A) : PL_list_proof (map (PL_subst s) S) (PL_subst s A).
Proof.
induction p as [A0 H1|A1 B1|A2 B2 C2|A3 B3|A4 B4 H2 H3 H4 H5].
apply PL_assumption.
apply in_map_iff.
exists A0.
split.
reflexivity.
assumption.
unfold PL_axiom1instance.
rewrite <- PL_subst_subst.
apply PL_axiom1.
unfold PL_axiom2instance.
rewrite <- PL_subst_subst.
apply PL_axiom2.
unfold PL_axiom3instance.
rewrite <- PL_subst_subst.
apply PL_axiom3.
apply (PL_MP _ (PL_subst s A4)).
assumption.
assumption.
Defined.

Definition PL_lemma1 : PL_Formula := PL_imp (PL_var 0) (PL_var 0).

Definition PL_lemma1_proof : PL_list_proof nil PL_lemma1.
Proof.
apply (PL_MP _ (PL_subst (PL_subst2 (PL_var 0) (PL_var 0)) PL_axiom1prototype)).
apply PL_axiom1.
apply (PL_MP _ (PL_subst (PL_subst2 (PL_var 0) PL_lemma1) PL_axiom1prototype)).
apply PL_axiom1.
apply PL_axiom2.
Defined.

Definition PL_deduction_thm_forward_proof (S : list PL_Formula) (A B : PL_Formula)
  (p : PL_list_proof S (PL_imp A B)) : PL_list_proof (A :: S) B.
Proof.
apply (PL_MP _ A).
apply PL_assumption.
apply in_eq.
apply (PL_list_proof_weaken S).
intros X.
apply in_cons.
assumption.
Defined.

Definition PL_deduction_thm_reverse_proof (S : list PL_Formula) (A B : PL_Formula)
  (p : PL_list_proof (A :: S) B) : PL_list_proof S (PL_imp A B).
Proof.
induction p as [A0 H1|A1 B1|A2 B2 C2|A3 B3|A4 B4 H2 H3 H4 H5].
destruct (PL_decidableFormula A A0) as [H6|H7].
rewrite H6.
apply (PL_list_proof_weaken nil).
intros X H8.
exfalso.
revert H8.
apply in_nil.
apply (PL_subst_proof (PL_subst1 A0) _ _ PL_lemma1_proof).
apply (PL_MP S A0).
apply PL_assumption.
destruct H1 as [H1a|H1b].
contradiction H7.
assumption.
apply (PL_axiom1 S A0 A).
apply (PL_MP _ (PL_axiom1instance A1 B1)).
apply PL_axiom1.
apply PL_axiom1.
apply (PL_MP _ (PL_axiom2instance A2 B2 C2)).
apply PL_axiom2.
apply PL_axiom1.
apply (PL_MP _ (PL_axiom3instance A3 B3)).
apply PL_axiom3.
apply PL_axiom1.
apply (PL_MP _ (PL_imp A A4)).
assumption.
apply (PL_MP _ (PL_imp A (PL_imp A4 B4))).
assumption.
apply PL_axiom2.
Defined.

Theorem PL_deduction_thm :
forall (S : list PL_Formula) (A B : PL_Formula),
  PL_list_proves S (PL_imp A B) <-> PL_list_proves (A :: S) B.
Proof.
intros S A B.
split.
intros H1.
destruct H1 as [p1].
exists.
apply PL_deduction_thm_forward_proof.
assumption.
intros H2.
destruct H2 as [p2].
exists.
apply PL_deduction_thm_reverse_proof.
assumption.
Qed.

Definition PL_lemma2 : PL_Formula :=
  PL_imp (PL_neg (PL_var 0)) (PL_imp (PL_var 0) (PL_var 1)).

Definition PL_lemma2_proof : PL_list_proof nil PL_lemma2.
Proof.
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_imp (PL_neg (PL_var 1)) (PL_neg (PL_var 0)))).
apply (PL_MP _ (PL_neg (PL_var 0))).
apply PL_assumption.
apply in_eq.
apply PL_axiom1.
apply PL_axiom3.
Defined.

Definition PL_lemma3 : PL_Formula := PL_imp (PL_neg (PL_neg (PL_var 0))) (PL_var 0).

Definition PL_lemma3_proof : PL_list_proof nil PL_lemma3.
Proof.
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_neg (PL_neg (PL_var 0)))).
apply PL_assumption.
apply in_eq.
apply (PL_MP _ (PL_imp (PL_neg (PL_var 0)) (PL_neg (PL_neg (PL_neg (PL_var 0)))))).
apply (PL_MP _ (PL_imp (PL_neg (PL_neg (PL_neg (PL_neg (PL_var 0)))))
  (PL_neg (PL_neg (PL_var 0))))).
apply (PL_MP _ (PL_neg (PL_neg (PL_var 0)))).
apply PL_assumption.
apply in_eq.
apply PL_axiom1.
apply PL_axiom3.
apply PL_axiom3.
Defined.

Definition PL_lemma4 : PL_Formula := PL_imp (PL_var 0) (PL_neg (PL_neg (PL_var 0))).

Definition PL_lemma4_proof : PL_list_proof nil PL_lemma4.
Proof.
apply (PL_MP _ (PL_imp (PL_neg (PL_neg (PL_neg (PL_var 0)))) (PL_neg (PL_var 0)))).
apply (PL_subst_proof (PL_subst1 (PL_neg (PL_var 0))) _ _ PL_lemma3_proof).
apply PL_axiom3.
Defined.

Definition PL_lemma5 : PL_Formula :=
  PL_imp (PL_imp (PL_var 0) (PL_var 1)) (PL_imp (PL_neg (PL_var 1)) (PL_neg (PL_var 0))).

Definition PL_lemma5_proof : PL_list_proof nil PL_lemma5.
Proof.
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_imp (PL_neg (PL_neg (PL_var 0))) (PL_neg (PL_neg (PL_var 1))))).
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_var 1)).
apply (PL_MP _ (PL_var 0)).
apply (PL_MP _ (PL_neg (PL_neg (PL_var 0)))).
apply PL_assumption.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H1.
exfalso.
revert H1.
apply in_nil.
apply PL_lemma3_proof.
apply PL_assumption.
apply in_cons.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H1.
exfalso.
revert H1.
apply in_nil.
apply (PL_subst_proof (PL_subst1 (PL_var 1)) _ _ PL_lemma4_proof).
apply PL_axiom3.
Defined.

Definition PL_lemma6 : PL_Formula :=
  PL_imp (PL_var 0) (PL_imp (PL_neg (PL_var 1)) (PL_neg (PL_imp (PL_var 0) (PL_var 1)))).

Definition PL_lemma6_proof : PL_list_proof nil PL_lemma6.
Proof.
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_imp (PL_imp (PL_var 0) (PL_var 1)) (PL_var 1))).
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_var 0)).
apply PL_assumption.
apply in_cons.
apply in_eq.
apply PL_assumption.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H1.
exfalso.
revert H1.
apply in_nil.
apply (PL_subst_proof (PL_subst2 _ _) _ _ PL_lemma5_proof).
Defined.

Definition PL_lemma7 : PL_Formula :=
  PL_imp (PL_imp (PL_neg (PL_var 0)) (PL_var 0)) (PL_var 0).

Definition PL_lemma7_proof : PL_list_proof nil PL_lemma7.
Proof.
apply (PL_MP _
  (PL_imp (PL_neg (PL_var 0)) (PL_neg (PL_imp (PL_neg (PL_var 0)) (PL_var 0))))).
apply PL_deduction_thm_reverse_proof.
apply PL_list_proof_weaken with ((PL_neg (PL_var 0))::(PL_neg (PL_var 0))::nil).
intros X H1.
destruct (in_inv H1) as [H2|H3].
rewrite <- H2.
apply in_eq.
destruct (in_inv H3) as [H4|H5].
rewrite <- H4.
apply in_eq.
exfalso.
revert H5.
apply in_nil.
apply PL_deduction_thm_forward_proof.
apply (PL_MP _ (PL_imp (PL_imp (PL_neg (PL_var 0)) (PL_var 0)) (PL_var 0))).
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_neg (PL_var 0))).
apply PL_assumption.
apply in_cons.
apply in_eq.
apply PL_assumption.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H6.
exfalso.
revert H6.
apply in_nil.
apply (PL_subst_proof (PL_subst2 _ _) _ _ PL_lemma5_proof).
apply PL_axiom3.
Defined.

Definition PL_lemma8 : PL_Formula :=
  PL_imp (PL_imp (PL_neg (PL_var 1)) (PL_var 0))
    (PL_imp (PL_imp (PL_var 1) (PL_var 0)) (PL_var 0)).

Definition PL_lemma8_proof : PL_list_proof nil PL_lemma8.
Proof.
apply PL_deduction_thm_reverse_proof.
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_imp (PL_neg (PL_var 0)) (PL_neg (PL_var 1)))).
apply (PL_MP _ (PL_imp (PL_var 1) (PL_var 0))).
apply PL_assumption.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H1.
exfalso.
revert H1.
apply in_nil.
apply (PL_subst_proof (PL_subst2 _ _) _ _ PL_lemma5_proof).
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_imp (PL_neg (PL_var 0)) (PL_var 0))).
apply PL_deduction_thm_reverse_proof.
apply (PL_MP _ (PL_neg (PL_var 1))).
apply (PL_MP _ (PL_neg (PL_var 0))).
apply PL_assumption.
apply in_eq.
apply PL_assumption.
apply in_cons.
apply in_eq.
apply PL_assumption.
apply in_cons.
apply in_cons.
apply in_cons.
apply in_eq.
apply PL_list_proof_weaken with nil.
intros X H2.
exfalso.
revert H2.
apply in_nil.
apply PL_lemma7_proof.
Defined.

End PL_proofs.

Section PL_soundness.

Theorem PL_soundness :
forall (S : list PL_Formula) (A : PL_Formula),
  PL_list_proves S A -> PL_list_models S A.
Proof.
intros S A H1.
destruct H1 as [P1].
intros f H2.
induction P1 as [A H3|A B|A B C|A B|A B PA H4 PAB H5].
rewrite Forall_forall in H2.
apply H2.
assumption.
apply PL_axiom1instancevalid.
apply Forall_nil.
apply PL_axiom2instancevalid.
apply Forall_nil.
apply PL_axiom3instancevalid.
apply Forall_nil.
unfold PL_models in H4,H5|-*.
simpl in H5.
destruct (PL_interpretation f A); destruct (PL_interpretation f B);
try reflexivity; try (discriminate H4); discriminate H5.
Qed.

End PL_soundness.

Section PL_completeness.

Definition PL_one_case_proof (f : PL_Valuation) (b : PL_VarIndex) (S : list PL_Formula)
  (varvalues : forall (n : PL_VarIndex), PL_varlt n b ->
     (f n = true -> In (PL_var n) S) /\ (f n = false -> In (PL_neg (PL_var n)) S))
  (A : PL_Formula) (varbound : PL_varle (PL_formula_var_max A) b) :
  if (PL_interpretation f A) then (PL_list_proof S A) else (PL_list_proof S (PL_neg A)).
Proof.
revert varbound.
induction A as [n1|A H1|A H2 B H3].
intros varbound.
destruct (PL_interpretation f (PL_var n1)) eqn: H4.
apply PL_assumption.
apply varvalues.
apply Nat.lt_le_trans with (PL_formula_var_max (PL_var n1)).
apply le_n.
assumption.
assumption.
apply PL_assumption.
apply varvalues.
apply Nat.lt_le_trans with (PL_formula_var_max (PL_var n1)).
apply le_n.
assumption.
assumption.
intros varbound.
simpl.
destruct (PL_interpretation f A) eqn: H5.
apply (PL_MP _ A).
apply H1.
assumption.
apply PL_list_proof_weaken with nil.
intros X H6.
exfalso.
revert H6.
apply in_nil.
apply (PL_subst_proof (PL_subst1 A) _ _ PL_lemma4_proof).
apply H1.
assumption.
simpl.
intros H7.
simpl.
destruct (PL_interpretation f A) eqn: H8.
destruct (PL_interpretation f B) eqn: H9.
simpl.
apply (PL_MP _ B).
apply H3.
apply le_trans with (PL_varmax (PL_formula_var_max A) (PL_formula_var_max B)).
apply Nat.le_max_r.
assumption.
apply PL_axiom1.
apply (PL_MP _ (PL_neg B)).
apply H3.
apply le_trans with (PL_varmax (PL_formula_var_max A) (PL_formula_var_max B)).
apply Nat.le_max_r.
assumption.
apply (PL_MP _ A).
apply H2.
apply le_trans with (PL_varmax (PL_formula_var_max A) (PL_formula_var_max B)).
apply Nat.le_max_l.
assumption.
apply PL_list_proof_weaken with nil.
intros X H10.
exfalso.
revert H10.
apply in_nil.
apply (PL_subst_proof (PL_subst2 A B) _ _ PL_lemma6_proof).
simpl.
apply (PL_MP _ (PL_neg A)).
apply H2.
apply le_trans with (PL_varmax (PL_formula_var_max A) (PL_formula_var_max B)).
apply Nat.le_max_l.
assumption.
apply PL_list_proof_weaken with nil.
intros X H11.
exfalso.
revert H11.
apply in_nil.
apply (PL_subst_proof (PL_subst2 A B) _ _ PL_lemma2_proof).
Defined.

Definition PL_merge_case_proof (S : list PL_Formula) (A B : PL_Formula)
  (p1 : PL_list_proof (B :: S) A) (p2 : PL_list_proof ((PL_neg B) :: S) A) :
  PL_list_proof S A.
Proof.
apply (PL_MP _ (PL_imp B A)).
apply PL_deduction_thm_reverse_proof.
assumption.
apply (PL_MP _ (PL_imp (PL_neg B) A)).
apply PL_deduction_thm_reverse_proof.
assumption.
apply PL_list_proof_weaken with nil.
intros X H1.
exfalso.
revert H1.
apply in_nil.
apply (PL_subst_proof (PL_subst2 _ _) _ _ PL_lemma8_proof).
Defined.

Definition PL_valuation_k_to_top (k : PL_VarIndex) (f : PL_Valuation) : PL_Valuation :=
fun (n : PL_VarIndex) =>
match eq_nat_dec k n with
| left _ => PL_top_interpretation
| right _ => f n
end.

Definition PL_valuation_k_to_bot (k : PL_VarIndex) (f : PL_Valuation) : PL_Valuation :=
fun (n : PL_VarIndex) =>
match eq_nat_dec k n with
| left _ => PL_bot_interpretation
| right _ => f n
end.

Fixpoint PL_test_valuations2 (b : PL_VarIndex) : list PL_Valuation :=
match b with
| O => PL_valuation_bot :: nil
| S b1 => concat
  (map
    (fun (f : PL_Valuation) =>
      (PL_valuation_k_to_top b1 f) :: (PL_valuation_k_to_bot b1 f) :: nil)
     (PL_test_valuations2 b1))
end.

Theorem PL_bounded_valuations2_listed :
forall (b : PL_VarIndex) (f : PL_Valuation),
  exists (g : PL_Valuation), In g (PL_test_valuations2 b) /\ PL_valuations_eq_before b f g.
Proof.
induction b as [|b1 H1].
intros f.
exists PL_valuation_bot.
split.
apply in_eq.
intros n H2.
exfalso.
revert H2.
apply le_Sn_0.
intros f.
destruct (H1 f) as [g1 [H3 H4]].
destruct (f b1) eqn: H5.
exists (PL_valuation_k_to_top b1 g1).
split.
apply in_concat.
exists ((PL_valuation_k_to_top b1 g1) :: (PL_valuation_k_to_bot b1 g1) :: nil).
split.
apply in_map_iff.
exists g1.
split.
reflexivity.
assumption.
apply in_eq.
intros n H6.
unfold PL_valuation_k_to_top.
destruct (eq_nat_dec b1 n) as [H7|H8].
rewrite <- H7.
assumption.
apply H4.
unfold PL_varlt, lt in H6.
rewrite Nat.le_lteq in H6.
destruct H6 as [H9|H10].
apply le_S_n.
assumption.
exfalso.
apply H8.
inversion H10 as [H11].
reflexivity.
exists (PL_valuation_k_to_bot b1 g1).
split.
apply in_concat.
exists ((PL_valuation_k_to_top b1 g1) :: (PL_valuation_k_to_bot b1 g1) :: nil).
split.
apply in_map_iff.
exists g1.
split.
reflexivity.
assumption.
apply in_cons.
apply in_eq.
intros n H6.
unfold PL_valuation_k_to_bot.
destruct (eq_nat_dec b1 n) as [H7|H8].
rewrite <- H7.
assumption.
apply H4.
unfold PL_varlt, lt in H6.
rewrite Nat.le_lteq in H6.
destruct H6 as [H9|H10].
apply le_S_n.
assumption.
exfalso.
apply H8.
inversion H10 as [H11].
reflexivity.
Qed.

Fixpoint PL_prepend_var_for_valuation
  (k : PL_VarIndex) (f : PL_Valuation) (S : list PL_Formula) : list PL_Formula :=
match k with
| O => S
| S k1 => (if (f k1) then (PL_var k1) else (PL_neg (PL_var k1))) ::
  (PL_prepend_var_for_valuation k1 f S)
end.

Fixpoint PL_completeness_lemma_prod_type
  (k : PL_VarIndex) (S : list PL_Formula) (A : PL_Formula) (F : list PL_Valuation) : Type :=
match F with
| nil => True
| f1 :: F1 => PL_list_proof (PL_prepend_var_for_valuation k f1 S) A *
  PL_completeness_lemma_prod_type k S A F1
end.

Definition PL_models_lemma (f : PL_Valuation) (S : list PL_Formula) (A : PL_Formula)
  (H : PL_list_models S A) :
  {B : PL_Formula & In B S /\ PL_interpretation f B = false} +
  (PL_interpretation f A = true).
Proof.
assert (Hf := H f).
clear H.
induction S as [|B1 S1 H1].
right.
apply Hf.
apply Forall_nil.
destruct (PL_interpretation f B1) eqn: H2.
assert (H3 : Forall (PL_models f) S1 -> PL_models f A).
intros H3.
apply Hf.
apply Forall_cons.
assumption.
assumption.
destruct (H1 H3) as [[B2 [H4 H5]]|H6].
left.
exists B2.
split.
apply in_cons.
assumption.
assumption.
right.
assumption.
left.
exists B1.
split.
apply in_eq.
assumption.
Defined.

Theorem PL_prepend_var_for_valuation_lemma2 :
forall (f : PL_Valuation) (B : PL_Formula) (S : list PL_Formula),
  In B S -> forall (k : PL_VarIndex), In B (PL_prepend_var_for_valuation k f S).
Proof.
intros f B S H k.
induction k as [|k1 H1].
assumption.
apply in_cons.
assumption.
Qed.

Theorem PL_prepend_var_for_valuation_lemma3 :
  forall (f : PL_Valuation) (S : list PL_Formula) (b n : PL_VarIndex),
    PL_varlt n b ->
    (f n = true -> In (PL_var n) (PL_prepend_var_for_valuation b f S)) /\
    (f n = false -> In (PL_neg (PL_var n)) (PL_prepend_var_for_valuation b f S)).
Proof.
intros f S b.
induction b as [|b1 H1].
intros n H1.
exfalso.
revert H1.
apply le_Sn_0.
intros n H2.
unfold PL_varlt, lt in H2.
rewrite Nat.le_lteq in H2.
destruct H2 as [H3|H4].
assert (H5 : n < b1).
apply le_S_n.
assumption.
destruct (H1 n H5) as [H6 H7].
destruct (f n) eqn: H8.
split.
intros H9.
apply in_cons.
apply H6.
assumption.
intros H10.
apply in_cons.
apply H7.
assumption.
split.
intros H9.
apply in_cons.
apply H6.
assumption.
intros H10.
apply in_cons.
apply H7.
assumption.
rewrite <- H4.
simpl PL_prepend_var_for_valuation.
destruct (f n) eqn: H11.
split.
intros H12.
apply in_eq.
intros H13.
discriminate H13.
split.
intros H14.
discriminate H14.
intros H15.
apply in_eq.
Qed.

Definition PL_completeness_lemma1 (S : list PL_Formula) (A : PL_Formula)
  (H : PL_list_models S A) (F : list PL_Valuation) :
  PL_completeness_lemma_prod_type (max (PL_formula_list_var_max S) (PL_formula_var_max A))
    S A F.
Proof.
induction F as [|f1 F1 H1].
exact I.
split.
destruct (PL_models_lemma f1 _ _ H) as [[B1 [H2 H3]]|H4].
assert (H5 := PL_one_case_proof f1
  (Init.Nat.max (PL_formula_list_var_max S) (PL_formula_var_max A))
  (PL_prepend_var_for_valuation
     (Init.Nat.max (PL_formula_list_var_max S) (PL_formula_var_max A)) f1 S)
  (PL_prepend_var_for_valuation_lemma3 f1 S _)
  B1
  ).
rewrite H3 in H5.
apply (PL_MP _ B1).
apply PL_assumption.
apply PL_prepend_var_for_valuation_lemma2.
assumption.
apply (PL_MP _ (PL_neg B1)).
apply H5.
apply le_trans with (PL_formula_list_var_max S).
apply PL_formula_var_max_list_var_max.
assumption.
apply Nat.le_max_l.
apply PL_list_proof_weaken with nil.
intros X H6.
exfalso.
revert H6.
apply in_nil.
apply (PL_subst_proof (PL_subst2 _ _) _ _ PL_lemma2_proof).
assert (H7 := PL_one_case_proof f1
  (Init.Nat.max (PL_formula_list_var_max S) (PL_formula_var_max A))
  (PL_prepend_var_for_valuation
     (Init.Nat.max (PL_formula_list_var_max S) (PL_formula_var_max A)) f1 S)
  (PL_prepend_var_for_valuation_lemma3 f1 S _)
  A
  ).
rewrite H4 in H7.
apply H7.
apply Nat.le_max_r.
assumption.
Defined.

Theorem PL_prepend_var_for_valuation_lemma4 :
forall (v : PL_Value) (f : PL_Valuation) (S : list PL_Formula) (k m : PL_VarIndex),
  le k m ->
  PL_prepend_var_for_valuation k
    (fun (n : PL_VarIndex) => if Nat.eq_dec m n then v else f n) S =
  PL_prepend_var_for_valuation k f S.
Proof.
intros v f S k.
induction k as [|k1 H1].
intros m H2.
reflexivity.
intros m H3.
simpl.
destruct (Nat.eq_dec m k1) as [H4|H5].
exfalso.
revert H3.
rewrite H4.
apply le_Sn_n.
rewrite H1.
reflexivity.
apply le_trans with (Datatypes.S k1).
apply le_n_Sn.
assumption.
Defined.

Definition PL_completeness_lemma2 (k : PL_VarIndex) (S : list PL_Formula) (A : PL_Formula)
  (F : list PL_Valuation)
  (p : PL_completeness_lemma_prod_type (Datatypes.S k) S A
    (concat (map
      (fun (f : PL_Valuation) =>
        (PL_valuation_k_to_top k f) :: (PL_valuation_k_to_bot k f) :: nil)
      F))) :
  PL_completeness_lemma_prod_type k S A F.
Proof.
induction F as [|f1 F1 p1].
exact I.
split.
assert (p2 := fst p).
assert (p3 := fst (snd p)).
simpl in p2, p3.
unfold PL_valuation_k_to_top in p2.
unfold PL_valuation_k_to_bot in p3.
destruct (Nat.eq_dec k k) as [H1|H2].
simpl in p2, p3.
rewrite PL_prepend_var_for_valuation_lemma4 in p2.
rewrite PL_prepend_var_for_valuation_lemma4 in p3.
apply (PL_merge_case_proof _ _ _ p2 p3).
apply le_n.
apply le_n.
exfalso.
apply H2.
reflexivity.
apply p1.
apply (snd (snd p)).
Defined.

Definition PL_completeness_lemma3 (S : list PL_Formula) (A : PL_Formula)
  (p : PL_completeness_lemma_prod_type 0 S A (PL_test_valuations2 0)) :
  PL_list_proof S A.
Proof.
destruct p.
assumption.
Defined.

Definition PL_completeness_proof_induction (S : list PL_Formula) (A : PL_Formula)
  (H : PL_list_models S A) (k : PL_VarIndex) :
  PL_completeness_lemma_prod_type k S A (PL_test_valuations2 k) -> PL_list_proof S A.
Proof.
induction k as [|k1 H1].
apply PL_completeness_lemma3.
intros p1.
apply H1.
apply PL_completeness_lemma2.
assumption.
Defined.

Definition PL_completeness_proof (S : list PL_Formula) (A : PL_Formula)
  (H : PL_list_models S A) : PL_list_proof S A.
Proof.
apply PL_completeness_proof_induction with
  (max (PL_formula_list_var_max S) (PL_formula_var_max A)).
assumption.
apply PL_completeness_lemma1.
assumption.
Defined.

Theorem PL_completeness :
forall (S : list PL_Formula) (A : PL_Formula),
  PL_list_models S A -> PL_list_proves S A.
Proof.
intros S A H.
exists.
apply PL_completeness_proof.
assumption.
Qed.

End PL_completeness.

Section PL_decidable_proofs.

Definition PL_list_proves_decidable (S : list PL_Formula) (A : PL_Formula) :
  {PL_list_proves S A} + {~ PL_list_proves S A}.
Proof.
destruct (PL_list_models_decidable S A) as [H1|H2].
left.
apply PL_completeness.
assumption.
right.
intros H3.
apply H2.
apply PL_soundness.
assumption.
Defined.

End PL_decidable_proofs.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf1 : natural) (y : natural) (x : natural) : natural :=
  plus x y.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (z : natural) (y : natural) : natural := plus Zero (mult y z).