Require Export Undecidability.FOL.Syntax.Core.
Require Import Undecidability.FOL.Syntax.Theories.
From Undecidability Require Import Shared.ListAutomation.
Import ListAutomationNotations.
Require Import Vector.

Local Set Implicit Arguments.
Local Unset Strict Implicit.

Set Default Proof Using "Type".

Local Notation vec := Vector.t.

Import FragmentSyntax.
Export FragmentSyntax.

(* Tarski Semantics ***)

Section Tarski.

  Context {Σ_funcs : funcs_signature}.
  Context {Σ_preds : preds_signature}.

  (* Semantic notions *)

  Section Semantics.

    Variable domain : Type.

    Class interp := B_I
      {
        i_func : forall f : syms, vec domain (ar_syms f) -> domain ;
        i_atom : forall P : preds, vec domain (ar_preds P) -> Prop
      }.

    Definition env := nat -> domain.

    Context {I : interp}.

    Fixpoint eval (rho : env) (t : term) : domain :=
      match t with
      | var s => rho s
      | func f v => i_func (Vector.map (eval rho) v)
      end.

    Fixpoint sat {ff : falsity_flag} (rho : env) (phi : form) : Prop :=
      match phi with
      | atom P v => i_atom (Vector.map (eval rho) v)
      | falsity => False
      | bin Impl phi psi => sat rho phi -> sat rho psi
      | quant All phi => forall d : domain, sat (d .: rho) phi
      end.

  End Semantics.

  Notation "rho ⊨ phi" := (sat rho phi) (at level 20).

End Tarski.

Arguments sat {_ _ _ _ _} _ _, {_ _ _} _ {_} _ _.
Arguments interp {_ _} _, _ _ _.

Notation "p ⊨ phi" := (sat _ p phi) (at level 20).
Notation "I ⊨= phi" := (forall p, sat I p phi) (at level 20).
Notation "p ⊫ A" := (forall psi, psi el A -> sat _ p psi) (at level 20).

Section Defs.

  Context {Σ_funcs : funcs_signature}.
  Context {Σ_preds : preds_signature}.
  Context {ff : falsity_flag}.

  Definition classical D (I : interp D) :=
    forall rho phi psi, rho ⊨ (((phi → psi) → phi) → phi).

  Definition valid_theory_C (C : forall D (I:interp D), Prop) (T:theory) phi :=
      forall D (I : interp D) rho, C D I -> (forall psi, T psi -> rho ⊨ psi) -> rho ⊨ phi.
  Definition valid_ctx_C (C : forall D (I:interp D), Prop) A phi :=
      forall D (I : interp D) rho, C D I -> rho ⊫ A -> rho ⊨ phi.
  Definition valid_C (C : forall D (I:interp D), Prop) phi :=
      forall D (I : interp D) rho, C D I -> rho ⊨ phi.
  Definition valid_ctx A phi := forall D (I : interp D) rho, rho ⊫ A -> rho ⊨ phi.
  Definition valid_theory (T:theory) phi := forall D (I : interp D) rho, (forall psi, T psi -> rho ⊨ psi) -> rho ⊨ phi.
  Definition valid phi := forall D (I : interp D) rho, rho ⊨ phi.
  Definition valid_L A := forall D (I : interp D) rho, rho ⊫ A.
  Definition satis phi := exists D (I : interp D) rho, rho ⊨ phi.
  Definition satis_L A := exists D (I : interp D) rho, rho ⊫ A.

End Defs.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(** * This module proves the validity of
    - well-founded recursion (also known as course of values)
    - well-founded induction
    from a well-founded ordering on a given set *)

Set Implicit Arguments.

Require Import Notations.
Require Import Logic.
Require Import Datatypes.

(** Well-founded induction principle on [Prop] *)

Section Well_founded.

 Variable A : Type.
 Variable R : A -> A -> Prop.

 (** The accessibility predicate is defined to be non-informative *)
 (** (Acc_rect is automatically defined because Acc is a singleton type) *)

 Inductive Acc (x: A) : Prop :=
     Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x.

 Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y.
  destruct 1; trivial.
 Defined.

 Global Implicit Arguments Acc_inv [x y] [x].

 (** A relation is well-founded if every element is accessible *)

 Definition well_founded := forall a:A, Acc a.

 (** Well-founded induction on [Set] and [Prop] *)

 Hypothesis Rwf : well_founded.

 Theorem well_founded_induction_type :
  forall P:A -> Type,
    (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
  intros; apply Acc_rect; auto.
 Defined.

 Theorem well_founded_induction :
  forall P:A -> Set,
    (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
  exact (fun P:A -> Set => well_founded_induction_type P).
 Defined.

 Theorem well_founded_ind :
  forall P:A -> Prop,
    (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
  exact (fun P:A -> Prop => well_founded_induction_type P).
 Defined.

(** Well-founded fixpoints *)

 Section FixPoint.

  Variable P : A -> Type.
  Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.

  Fixpoint Fix_F (x:A) (a:Acc x) : P x :=
    F (fun (y:A) (h:R y x) => Fix_F (Acc_inv a h)).

  Scheme Acc_inv_dep := Induction for Acc Sort Prop.

  Lemma Fix_F_eq :
   forall (x:A) (r:Acc x),
     F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)) = Fix_F (x:=x) r.
  Proof.
   destruct r using Acc_inv_dep; auto.
  Qed.

  Definition Fix (x:A) := Fix_F (Rwf x).

  (** Proof that [well_founded_induction] satisfies the fixpoint equation.
      It requires an extra property of the functional *)

  Hypothesis
    F_ext :
      forall (x:A) (f g:forall y:A, R y x -> P y),
        (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.

  Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F r = Fix_F s.
  Proof.
   intro x; induction (Rwf x); intros.
   rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros.
   apply F_ext; auto.
  Qed.

  Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y).
  Proof.
   intro x; unfold Fix in |- *.
   rewrite <- Fix_F_eq.
   apply F_ext; intros.
   apply Fix_F_inv.
  Qed.

 End FixPoint.

End Well_founded.

(** Well-founded fixpoints over pairs *)

Section Well_founded_2.

  Variables A B : Type.
  Variable R : A * B -> A * B -> Prop.

  Variable P : A -> B -> Type.

  Section FixPoint_2.

  Variable
    F :
      forall (x:A) (x':B),
        (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x'.

  Fixpoint Fix_F_2 (x:A) (x':B) (a:Acc R (x, x')) : P x x' :=
    F
      (fun (y:A) (y':B) (h:R (y, y') (x, x')) =>
         Fix_F_2 (x:=y) (x':=y') (Acc_inv a (y,y') h)).

  End FixPoint_2.

  Hypothesis Rwf : well_founded R.

  Theorem well_founded_induction_type_2 :
   (forall (x:A) (x':B),
      (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x') ->
   forall (a:A) (b:B), P a b.
  Proof.
   intros; apply Fix_F_2; auto.
  Defined.

End Well_founded_2.

Notation Acc_iter   := Fix_F   (only parsing). (* compatibility *)
Notation Acc_iter_2 := Fix_F_2 (only parsing). (* compatibility *)


Require Import Coq.Lists.List.
Require Import Coq.Classes.EquivDec.
Require Import Coq.Arith.PeanoNat.

Import Coq.Lists.List.ListNotations.

Require Import BWT.Lib.Sumbool.

Section FindIndex.
  Context {A : Type} `{EqDec A}.

  Fixpoint findIndex (x : A) (ls : list A) : nat :=
    match ls with
    | [] => 0
    | hd :: tl =>
      if x == hd then 0
      else S (findIndex x tl)
    end.

  Theorem findIndex_correct : forall x xs d,
      Exists (equiv x) xs -> nth (findIndex x xs) xs d === x.
  Proof.
    intros x xs d E.
    unfold findIndex.
    induction E.
    - destruct (x == x0).
      + simpl. apply equiv_symmetric. auto.
      + contradiction.
    - destruct (x == x0).
      + simpl. apply equiv_symmetric. auto.
      + apply IHE.
  Qed.

  Theorem findIndex_bounds : forall x xs,
      Exists (equiv x) xs -> findIndex x xs < length xs.
  Proof.
    intros x xs E.
    unfold findIndex.
    induction E.
    - destruct (x == x0).
      + simpl. apply Nat.lt_0_succ.
      + contradiction.
    - destruct (x == x0).
      + simpl. apply Nat.lt_0_succ.
      + simpl. apply le_n_S. apply IHE.
  Qed.

  Theorem findIndex_nth : forall i xs d,
      (forall x y, x === y -> x = y) ->
      NoDup xs ->
      i < length xs ->
      findIndex (nth i xs d) xs = i.
  Proof.
    intros i xs d eqv_eq ND HI.
    assert (E : Exists (equiv (nth i xs d)) xs). {
      apply Exists_exists. exists (nth i xs d).
      split; [|easy].
      apply nth_In. easy.
    }
    apply (NoDup_nth xs d);
      [|apply findIndex_bounds|
       |apply eqv_eq; rewrite findIndex_correct]; easy.
  Qed.

  Theorem findIndex_map : forall f xs x,
      (forall x y, x === y -> x = y) ->
      NoDup (map f xs) ->
      Exists (equiv x) xs ->
      findIndex (f x) (map f xs) = findIndex x xs.
  Proof.
    intros f xs x eqv_eq.
    revert x; induction xs; intros x ND E; [easy|].
    cbn.
    destruct (f x == f a).
    - rewrite if_true. easy.
      apply eqv_eq in e.
      cbn in ND. apply NoDup_cons_iff in ND.
      destruct ND as [HNIn ND].
      apply Exists_exists in E.
      destruct E as [x' [HIn HX]].
      apply eqv_eq in HX; subst x'.
      destruct HIn; [subst; easy|].
      apply in_map with (f := f) in H0.
      rewrite e in H0.
      contradiction.
    - destruct (x == a).
      + apply eqv_eq in e.
        rewrite e in c.
        exfalso; apply c; reflexivity.
      + f_equal.
        apply IHxs; [apply NoDup_cons_iff in ND; easy|].
        apply Exists_cons in E.
        destruct E; easy.
  Qed.

  Theorem findIndex_cons : forall xs x y,
      x =/= y ->
      findIndex x (y :: xs) = S (findIndex x xs).
  Proof.
    intros xs x y NE.
    cbn. rewrite if_false by easy.
    easy.
  Qed.
End FindIndex.


From Coq Require Import Lists.List.
From stdpp Require Import list sets.

From Coq Require Import ssreflect.

Lemma Forall_subset {A} f (l1: list A) (l2: list A) :
  l1 ⊆ l2 →
  Forall f l2 →
  Forall f l1.
Proof.
  intros Hsubset Hl2.
  apply List.Forall_forall.
  intros x Hin_l1.
  apply elem_of_list_In in Hin_l1.
  destruct (elem_of_subseteq l1 l2) as (Hsubset_elem_of&_).
  apply Hsubset_elem_of with (x := x) in Hsubset; intuition.
  destruct (List.Forall_forall f l2) as (Hl2_impl&_).
  apply elem_of_list_In in Hsubset.
  apply (Hl2_impl Hl2 x) in Hsubset.
  done.
Qed.

Lemma list_app_subseteq {A} (l1 l2 l : list A) :
  l1 ++ l2 ⊆ l ↔ l1 ⊆ l ∧ l2 ⊆ l.
Proof.
  set_solver.
Qed.

Lemma list_cons_subseteq {A} (x: A) (l1 l2: list A) :
  x :: l1 ⊆ l2 ↔ x ∈ l2 ∧ l1 ⊆ l2.
Proof. set_solver. Qed.

Lemma elem_of_subseteq_concat {A} (x:list A) (l:list (list A)) :
  x ∈ l → x ⊆ concat l.
Proof.
  intros Helem.
  apply elem_of_list_split in Helem as (l1 & l2 & ->).
  rewrite concat_app concat_cons.
  set_solver.
Qed.

Lemma concat_respects_subseteq {A} (l1 l2: list (list A)) :
  l1 ⊆ l2 →
  concat l1 ⊆ concat l2.
Proof.
  generalize dependent l2.
  induction l1 as [|x l1]; intros; simpl.
  - set_solver.
  - apply list_cons_subseteq in H as [Helem ?].
    apply list_app_subseteq. split; [|by eauto].
    apply elem_of_subseteq_concat; auto.
Qed.

Lemma list_fmap_mono {A B} (f: A → B) (l1 l2: list A) :
  l1 ⊆ l2 → f <$> l1 ⊆ f <$> l2.
Proof.
  intros Hsubseteq.
  apply (iffRL (elem_of_subseteq _ _)).
  intros y Hin.
  destruct (elem_of_list_fmap_2 _ _ _ Hin) as (x&Hy&Hx).
  apply ((iffLR (elem_of_subseteq _ _)) Hsubseteq x) in Hx.
  apply (elem_of_list_fmap_1_alt _ _ _ _ Hx Hy).
Qed.

Lemma drop_subseteq {A} (l: list A) n :
  drop n l ⊆ l.
Proof.
  intros x.
  rewrite !elem_of_list_lookup.
  setoid_rewrite lookup_drop.
  naive_solver.
Qed.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
(*                      Evgeny Makarov, INRIA, 2007                     *)
(************************************************************************)

Require Export NMulOrder.

Module Type NSubProp (Import N : NAxiomsMiniSig').
Include NMulOrderProp N.

Theorem sub_0_l : forall n, 0 - n == 0.
Proof.
induct n.
apply sub_0_r.
intros n IH; rewrite sub_succ_r; rewrite IH. now apply pred_0.
Qed.

Theorem sub_succ : forall n m, S n - S m == n - m.
Proof.
intro n; induct m.
rewrite sub_succ_r. do 2 rewrite sub_0_r. now rewrite pred_succ.
intros m IH. rewrite sub_succ_r. rewrite IH. now rewrite sub_succ_r.
Qed.

Theorem sub_diag : forall n, n - n == 0.
Proof.
induct n. apply sub_0_r. intros n IH; rewrite sub_succ; now rewrite IH.
Qed.

Theorem sub_gt : forall n m, n > m -> n - m ~= 0.
Proof.
intros n m H; elim H using lt_ind_rel; clear n m H.
solve_proper.
intro; rewrite sub_0_r; apply neq_succ_0.
intros; now rewrite sub_succ.
Qed.

Theorem add_sub_assoc : forall n m p, p <= m -> n + (m - p) == (n + m) - p.
Proof.
intros n m p; induct p.
intro; now do 2 rewrite sub_0_r.
intros p IH H. do 2 rewrite sub_succ_r.
rewrite <- IH by (apply lt_le_incl; now apply le_succ_l).
rewrite add_pred_r by (apply sub_gt; now apply le_succ_l).
reflexivity.
Qed.

Theorem sub_succ_l : forall n m, n <= m -> S m - n == S (m - n).
Proof.
intros n m H. rewrite <- (add_1_l m). rewrite <- (add_1_l (m - n)).
symmetry; now apply add_sub_assoc.
Qed.

Theorem add_sub : forall n m, (n + m) - m == n.
Proof.
intros n m. rewrite <- add_sub_assoc by (apply le_refl).
rewrite sub_diag; now rewrite add_0_r.
Qed.

Theorem sub_add : forall n m, n <= m -> (m - n) + n == m.
Proof.
intros n m H. rewrite add_comm. rewrite add_sub_assoc by assumption.
rewrite add_comm. apply add_sub.
Qed.

Theorem add_sub_eq_l : forall n m p, m + p == n -> n - m == p.
Proof.
intros n m p H. symmetry.
assert (H1 : m + p - m == n - m) by now rewrite H.
rewrite add_comm in H1. now rewrite add_sub in H1.
Qed.

Theorem add_sub_eq_r : forall n m p, m + p == n -> n - p == m.
Proof.
intros n m p H; rewrite add_comm in H; now apply add_sub_eq_l.
Qed.

(* This could be proved by adding m to both sides. Then the proof would
use add_sub_assoc and sub_0_le, which is proven below. *)

Theorem add_sub_eq_nz : forall n m p, p ~= 0 -> n - m == p -> m + p == n.
Proof.
intros n m p H; double_induct n m.
intros m H1; rewrite sub_0_l in H1. symmetry in H1; false_hyp H1 H.
intro n; rewrite sub_0_r; now rewrite add_0_l.
intros n m IH H1. rewrite sub_succ in H1. apply IH in H1.
rewrite add_succ_l; now rewrite H1.
Qed.

Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p.
Proof.
intros n m; induct p.
rewrite add_0_r; now rewrite sub_0_r.
intros p IH. rewrite add_succ_r; do 2 rewrite sub_succ_r. now rewrite IH.
Qed.

Theorem add_sub_swap : forall n m p, p <= n -> n + m - p == n - p + m.
Proof.
intros n m p H.
rewrite (add_comm n m).
rewrite <- add_sub_assoc by assumption.
now rewrite (add_comm m (n - p)).
Qed.

(** Sub and order *)

Theorem le_sub_l : forall n m, n - m <= n.
Proof.
intro n; induct m.
rewrite sub_0_r; now apply eq_le_incl.
intros m IH. rewrite sub_succ_r.
apply le_trans with (n - m); [apply le_pred_l | assumption].
Qed.

Theorem sub_0_le : forall n m, n - m == 0 <-> n <= m.
Proof.
double_induct n m.
intro m; split; intro; [apply le_0_l | apply sub_0_l].
intro m; rewrite sub_0_r; split; intro H;
[false_hyp H neq_succ_0 | false_hyp H nle_succ_0].
intros n m H. rewrite <- succ_le_mono. now rewrite sub_succ.
Qed.

Theorem sub_add_le : forall n m, n <= n - m + m.
Proof.
intros.
destruct (le_ge_cases n m) as [LE|GE].
rewrite <- sub_0_le in LE. rewrite LE; nzsimpl.
now rewrite <- sub_0_le.
rewrite sub_add by assumption. apply le_refl.
Qed.

Theorem le_sub_le_add_r : forall n m p,
 n - p <= m <-> n <= m + p.
Proof.
intros n m p.
split; intros LE.
rewrite (add_le_mono_r _ _ p) in LE.
apply le_trans with (n-p+p); auto using sub_add_le.
destruct (le_ge_cases n p) as [LE'|GE].
rewrite <- sub_0_le in LE'. rewrite LE'. apply le_0_l.
rewrite (add_le_mono_r _ _ p). now rewrite sub_add.
Qed.

Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p.
Proof.
intros n m p. rewrite add_comm; apply le_sub_le_add_r.
Qed.

Theorem lt_sub_lt_add_r : forall n m p,
 n - p < m -> n < m + p.
Proof.
intros n m p LT.
rewrite (add_lt_mono_r _ _ p) in LT.
apply le_lt_trans with (n-p+p); auto using sub_add_le.
Qed.

(** Unfortunately, we do not have [n < m + p -> n - p < m].
    For instance [1<0+2] but not [1-2<0]. *)

Theorem lt_sub_lt_add_l : forall n m p, n - m < p -> n < m + p.
Proof.
intros n m p. rewrite add_comm; apply lt_sub_lt_add_r.
Qed.

Theorem le_add_le_sub_r : forall n m p, n + p <= m -> n <= m - p.
Proof.
intros n m p LE.
apply (add_le_mono_r _ _ p).
rewrite sub_add. assumption.
apply le_trans with (n+p); trivial.
rewrite <- (add_0_l p) at 1. rewrite <- add_le_mono_r. apply le_0_l.
Qed.

(** Unfortunately, we do not have [n <= m - p -> n + p <= m].
    For instance [0<=1-2] but not [2+0<=1]. *)

Theorem le_add_le_sub_l : forall n m p, n + p <= m -> p <= m - n.
Proof.
intros n m p. rewrite add_comm; apply le_add_le_sub_r.
Qed.

Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p.
Proof.
intros n m p.
destruct (le_ge_cases p m) as [LE|GE].
rewrite <- (sub_add p m) at 1 by assumption.
now rewrite <- add_lt_mono_r.
assert (GE' := GE). rewrite <- sub_0_le in GE'; rewrite GE'.
split; intros LT.
elim (lt_irrefl m). apply le_lt_trans with (n+p); trivial.
 rewrite <- (add_0_l m). apply add_le_mono. apply le_0_l. assumption.
now elim (nlt_0_r n).
Qed.

Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n.
Proof.
intros n m p. rewrite add_comm; apply lt_add_lt_sub_r.
Qed.

Theorem sub_lt : forall n m, m <= n -> 0 < m -> n - m < n.
Proof.
intros n m LE LT.
assert (LE' := le_sub_l n m). rewrite lt_eq_cases in LE'.
destruct LE' as [LT'|EQ]. assumption.
apply add_sub_eq_nz in EQ; [|order].
rewrite (add_lt_mono_r _ _ n), add_0_l in LT. order.
Qed.

Lemma sub_le_mono_r : forall n m p, n <= m -> n-p <= m-p.
Proof.
 intros. rewrite le_sub_le_add_r. transitivity m. assumption. apply sub_add_le.
Qed.

Lemma sub_le_mono_l : forall n m p, n <= m -> p-m <= p-n.
Proof.
 intros. rewrite le_sub_le_add_r.
 transitivity (p-n+n); [ apply sub_add_le | now apply add_le_mono_l].
Qed.

(** Sub and mul *)

Theorem mul_pred_r : forall n m, n * (P m) == n * m - n.
Proof.
intros n m; cases m.
now rewrite pred_0, mul_0_r, sub_0_l.
intro m; rewrite pred_succ, mul_succ_r, <- add_sub_assoc.
now rewrite sub_diag, add_0_r.
now apply eq_le_incl.
Qed.

Theorem mul_sub_distr_r : forall n m p, (n - m) * p == n * p - m * p.
Proof.
intros n m p; induct n.
now rewrite sub_0_l, mul_0_l, sub_0_l.
intros n IH. destruct (le_gt_cases m n) as [H | H].
rewrite sub_succ_l by assumption. do 2 rewrite mul_succ_l.
rewrite (add_comm ((n - m) * p) p), (add_comm (n * p) p).
rewrite <- (add_sub_assoc p (n * p) (m * p)) by now apply mul_le_mono_r.
now apply add_cancel_l.
assert (H1 : S n <= m); [now apply le_succ_l |].
setoid_replace (S n - m) with 0 by now apply sub_0_le.
setoid_replace ((S n * p) - m * p) with 0 by (apply sub_0_le; now apply mul_le_mono_r).
apply mul_0_l.
Qed.

Theorem mul_sub_distr_l : forall n m p, p * (n - m) == p * n - p * m.
Proof.
intros n m p; rewrite (mul_comm p (n - m)), (mul_comm p n), (mul_comm p m).
apply mul_sub_distr_r.
Qed.

(** Alternative definitions of [<=] and [<] based on [+] *)

Definition le_alt n m := exists p, p + n == m.
Definition lt_alt n m := exists p, S p + n == m.

Lemma le_equiv : forall n m, le_alt n m <-> n <= m.
Proof.
split.
intros (p,H). rewrite <- H, add_comm. apply le_add_r.
intro H. exists (m-n). now apply sub_add.
Qed.

Lemma lt_equiv : forall n m, lt_alt n m <-> n < m.
Proof.
split.
intros (p,H). rewrite <- H, add_succ_l, lt_succ_r, add_comm. apply le_add_r.
intro H. exists (m-S n). rewrite add_succ_l, <- add_succ_r.
apply sub_add. now rewrite le_succ_l.
Qed.

Instance le_alt_wd : Proper (eq==>eq==>iff) le_alt.
Proof.
 intros x x' Hx y y' Hy; unfold le_alt.
 setoid_rewrite Hx. setoid_rewrite Hy. auto with *.
Qed.

Instance lt_alt_wd : Proper (eq==>eq==>iff) lt_alt.
Proof.
 intros x x' Hx y y' Hy; unfold lt_alt.
 setoid_rewrite Hx. setoid_rewrite Hy. auto with *.
Qed.

(** With these alternative definition, the dichotomy:

[forall n m, n <= m \/ m <= n]

becomes:

[forall n m, (exists p, p + n == m) \/ (exists p, p + m == n)]

We will need this in the proof of induction principle for integers
constructed as pairs of natural numbers. This formula can be proved
from know properties of [<=]. However, it can also be done directly. *)

Theorem le_alt_dichotomy : forall n m, le_alt n m \/ le_alt m n.
Proof.
intros n m; induct n.
left; exists m; apply add_0_r.
intros n IH.
destruct IH as [[p H] | [p H]].
destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H.
rewrite add_0_l in H. right; exists (S 0); rewrite H, add_succ_l;
 now rewrite add_0_l.
left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H.
right; exists (S p). rewrite add_succ_l; now rewrite H.
Qed.

Theorem add_dichotomy :
  forall n m, (exists p, p + n == m) \/ (exists p, p + m == n).
Proof. exact le_alt_dichotomy. Qed.

End NSubProp.


(** 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 :=
| Succ : natural -> natural
| Zero : natural.

Inductive lst : Set :=
| Cons : natural -> lst -> lst
| Nil : lst.

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

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) {struct append_arg0}
  : lst :=
  match append_arg0 with
  | Cons x y => Cons x (append y append_arg1)
  | Nil => append_arg1
  end.

Fixpoint len (n : lst) {struct n} : natural :=
  match n with
  | Cons _ y => Succ (len y)
  | Nil => Zero
  end.

Definition synth (lf1 : lst) : natural := len lf1.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq. (* SSReflect *)
From Autosubst Require Import Autosubst.    (* !! Autosubst !! *)

Inductive term : Type :=
| Var (x : var)
| App (s t : term)
| Lam (s : {bind term}).

Instance Ids_term : Ids term. derive. Defined.
Instance Rename_term : Rename term. derive. Defined.
Instance Subst_term : Subst term. derive. Defined.
Instance SubstLemmas_term : SubstLemmas term. derive. Qed.

Section Test.

Variables (x y : var)
          (s t : term)
          (σ τ : var -> term)             (* substitution *)
          (ξ : var -> var).                (* rename *)

Check Var x : term.
Check App s t : term.
Check Lam s : term.

(* 定数 *)
Check ids : var -> term.                    (* subst *)
Check rename : (var -> var) -> term -> term.
Check subst  : (var -> term) -> term -> term.

Check (+1) : var -> var.                    (* rename *)
Check up   : (var -> term) -> var -> term.
Check ren  : (var -> var) -> var -> term.

(* Notation *)
Locate "_ .: _".                            (* scons *)
Locate "_ .[ _ ]".                          (* subst *)
Locate "_ >> _".                            (* scomp *)

Check scons : _ -> (var -> _) -> var -> _. (* substitution または rename のcons *)
Check subst : (var -> term) -> term -> term. (* substitution を term に適用する。 *)
Check scomp : (var -> term) -> (var -> term) -> var -> term. (* substitution の合成 *)
Check ren   : (var -> var) -> var -> term. (* rename から substitution をつくる。 *)

(* SubstLemmas に含まれる補題 *)
Check rename_subst : forall (ξ : var -> var) (s : term), rename ξ s = s.[ren ξ].
Check subst_id     : forall s : term, s.[ids] = s.
Check id_subst     : forall (σ : var -> term) (x : var), (ids x).[σ] = σ x.
Check subst_comp   : forall (σ τ : var -> term) (s : term), s.[σ].[τ] = s.[σ >> τ].

Goal ren ξ = ξ >>> ids.                   (* substitution *)
  reflexivity.
Qed.

Goal σ >> τ = σ >>> subst τ.            (* substitution *)
  reflexivity.
Qed.

Goal up σ = (Var 0) .: (σ >> ren (+1)).   (* substitution *)
  by autosubst.                             (* upE *)
Qed.

Goal ids x = Var x.                         (* term *)
  reflexivity.
Qed.

Goal rename ξ s = s.[ren ξ].              (* term *)
    by autosubst.                           (* rename_subst *)
Qed.

Goal s.[ids] = s.                           (* term *)
    by autosubst.                           (* subst_id. *)
Qed.

Goal (ids x).[σ] = σ x.                   (* term *)
    by autosubst.                           (* id_subst *)
Qed.

Goal s.[σ].[τ] = s.[σ >> τ].            (* term *)
    by autosubst.                           (* subst_comp *)
Qed.

Check scons : term -> (var -> term) -> var -> term.
Goal (s .: σ) 0 = s.                       (* term *)
    by [].
Qed.

Goal (s .: σ) x.+1 = σ x.                 (* term *)
    by [].
Qed.

Goal (Var x).[σ] = σ(x).                  (* term *)
    by [].
Qed.

Goal (App s t).[σ] = App s.[σ] t.[σ].    (* term *)
    by [].
Qed.

Goal (Lam s).[σ] = Lam s.[up σ].          (* term *)
    by [].
Qed.

Goal up σ 0 = Var 0.                       (* term *)
  reflexivity.
Qed.

Goal up σ x.+1 = (σ x).[ren (+1)].        (* term *)
  autosubst.
Qed.

Goal (σ >> τ) x = (σ x).[τ].            (* term *)
    by [].
Qed.

Check scons : var -> (var -> var) -> var -> var.
Goal (y .: ξ) 0 = y.                       (* var *)
    by [].
Qed.

Goal (y .: ξ) x.+1 = ξ x.                 (* var *)
    by [].
Qed.

Goal (+1) x = x.+1.                         (* var *)
    by [].
Qed.
End Test.

(** **** One-Step Reduction *)

Inductive step : term -> term -> Prop :=
| step_beta s t :                   step (App (Lam s) t) s.[t .: ids]
| step_appL s1 s2 t : step s1 s2 -> step (App s1 t) (App s2 t)
| step_appR s t1 t2 : step t1 t2 -> step (App s t1) (App s t2)
| step_lam s1 s2 :    step s1 s2 -> step (Lam s1) (Lam s2).

Lemma step_ebeta (s t u : term) : s.[t .: ids] = u -> step (App (Lam s) t) u.
Proof.
  move=> <-.
  exact: step_beta.
Qed.

Lemma step_subst σ s t : step s t -> step s.[σ] t.[σ].
Proof.
  move=> st.
  elim: st σ => /= {s t}; auto using step.
  move=> s t σ.
  apply: step_ebeta.
    by autosubst.                           (* asimpl. *)
Qed.

(* END *)


Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import SchulzeSynthesis.
Require Import Coq.Strings.String.
Require Import ZArith.
Require Import EqNat.

Extraction Language Haskell.

Extract Inductive bool    => "Prelude.Bool" ["Prelude.True" "Prelude.False"].
Extract Inductive sumbool => "Prelude.Bool" ["Prelude.True" "Prelude.False"].
Extract Inductive Datatypes.nat => "Prelude.Int" ["0"
  "(Prelude.succ)"]
  "(\fO fS n -> if n Prelude.<= 0 then fO () else fS (n Prelude.- 1))".

Extract Inlined Constant Nat.ltb   => "(Prelude.<)".

Extraction "LibNative.hs" schulze_winners_pf.


Require Import Problem Coq.Arith.Mult Coq.Arith.Plus.

Theorem solution: task.
Proof.
  unfold task.
  intros.
  assert (S m = 1 + m).
  - reflexivity.
  - rewrite H. rewrite mult_plus_distr_l. rewrite mult_1_r. reflexivity.
Qed.


Require Import init.

Require Import mult_div.
Require Import relation.

Definition common_divisor {U} `{Mult U} a b d := d ∣ a ∧ d ∣ b.
Definition is_gcd {U} `{Mult U} a b d
    := common_divisor a b d ∧ ∀ d', common_divisor a b d' → d' ∣ d.

#[universes(template)]
Class GCDDomain U `{Mult U, Zero U} := {
    gcd : U → U → U;
    gcd_cd : ∀ a b, common_divisor a b (gcd a b);
    gcd_greatest :
        ∀ a b, (0 ≠ a ∨ 0 ≠ b) → ∀ d, common_divisor a b d → d ∣ (gcd a b)
}.

(* begin hide *)
Section GCD.

Context {U} `{Up : Plus U,
                  @PlusAssoc U Up,
                  @PlusComm U Up,
              Uz : Zero U,
                  @PlusLid U Up Uz,
              Un : Neg U,
                  @PlusLinv U Up Uz Un,
              Um : Mult U,
                  @MultAssoc U Um,
                  @MultComm U Um,
                  @Ldist U Up Um,
                  @Rdist U Up Um,
              Uo : One U,
                  @MultLid U Um Uo,
                  @MultRid U Um Uo,
                  @MultLcancel U Uz Um,
                  @MultRcancel U Uz Um
              }.

(* end hide *)
Theorem gcd_associates :
    ∀ a b d1 d2, is_gcd a b d1 → is_gcd a b d2 → associates d1 d2.
Proof.
    intros a b d1 d2 [d1_cd d1_gcd] [d2_cd d2_gcd].
    specialize (d1_gcd d2 d2_cd).
    specialize (d2_gcd d1 d1_cd).
    split; assumption.
Qed.

(* begin hide *)
Context `{@GCDDomain U Um Uz}.

(* end hide *)
Theorem gcd_gcd : ∀ a b, (0 ≠ a ∨ 0 ≠ b) → is_gcd a b (gcd a b).
Proof.
    intros a b nz.
    split.
    -   apply gcd_cd.
    -   intros d d_common.
        apply gcd_greatest; assumption.
Qed.

Lemma gcd_comm_wlog : ∀ a b, (0 ≠ a ∨ 0 ≠ b) → gcd a b ∣ gcd b a.
Proof.
    intros a b nz.
    apply gcd_greatest.
    -   rewrite or_comm.
        exact nz.
    -   unfold common_divisor.
        rewrite and_comm.
        apply gcd_cd.
Qed.
Theorem gcd_comm : ∀ a b, (0 ≠ a ∨ 0 ≠ b) → associates (gcd a b) (gcd b a).
Proof.
    intros a b nz.
    split; apply gcd_comm_wlog.
    2: rewrite or_comm.
    all: exact nz.
Qed.

Theorem irreducible_prime : ∀ p, irreducible p → prime p.
Proof.
    intros p [p_nz [p_nu p_irr]].
    repeat split; [>exact p_nz|exact p_nu|].
    intros a b p_div.
    pose (d := gcd (p * b) (a * b)).
    classic_case (0 = b) as [b_z|b_nz].
    {
        right.
        rewrite <- b_z.
        apply divides_zero.
    }
    classic_case (0 = a * b) as [ab_z|ab_nz].
    {
        rewrite <- (mult_lanni b) in ab_z.
        apply mult_rcancel in ab_z; [>|exact b_nz].
        left.
        rewrite <- ab_z.
        apply divides_zero.
    }
    assert (0 ≠ d) as d_nz.
    {
        intros contr.
        pose proof (gcd_cd (p * b) (a * b)) as [d1 d2].
        unfold d in contr.
        rewrite <- contr in d1, d2.
        destruct d2 as [c eq].
        rewrite mult_ranni in eq.
        contradiction.
    }
    pose proof (mult_div_lself p b) as p_div2.
    pose proof (mult_div_rself b p) as b_div1.
    pose proof (mult_div_rself b a) as b_div2.
    pose proof (gcd_greatest _ _ (make_ror ab_nz) _ (make_and p_div2 p_div))
        as pd.
    pose proof (gcd_greatest _ _ (make_ror ab_nz) _ (make_and b_div1 b_div2))
        as bd.
    fold d in pd, bd.
    destruct pd as [u pd], bd as [v bd].
    assert (v ∣ p) as vp.
    {
        pose proof (gcd_cd (p * b) (a * b)) as [d1 d2].
        fold d in d1, d2.
        rewrite <- bd in d1.
        destruct d1 as [c eq].
        rewrite mult_assoc in eq.
        apply mult_rcancel in eq; [>|exact b_nz].
        exists c.
        exact eq.
    }
    classic_case (unit v) as [v_u|v_nu].
    -   destruct v_u as [v' eq].
        rewrite <- bd in pd.
        apply lmult with v' in pd.
        do 2 rewrite mult_assoc in pd.
        rewrite eq in pd.
        rewrite mult_lid in pd.
        right.
        exists (v' * u).
        exact pd.
    -   assert (p ∣ v) as pv.
        {
            destruct vp as [c vp].
            assert (unit c) as c_u.
            {
                classic_contradiction contr.
                apply (p_irr c v contr v_nu).
                symmetry; exact vp.
            }
            destruct c_u as [c' c_eq].
            exists c'.
            apply lmult with c' in vp.
            rewrite mult_assoc in vp.
            rewrite c_eq in vp.
            rewrite mult_lid in vp.
            symmetry; exact vp.
        }
        left.
        unfold d in bd.
        pose proof (gcd_cd (p * b) (a * b)) as [d1 d2]; clear d1.
        rewrite <- bd in d2.
        apply div_rcancel in d2; [>|exact b_nz].
        exact (trans pv d2).
Qed.
(* begin hide *)

End GCD.
(* end hide *)


(** 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 :=
| Succ : natural -> natural
| Zero : natural.

Inductive lst : Set :=
| Cons : natural -> lst -> lst
| Nil : lst.

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

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) {struct append_arg0}
  : lst :=
  match append_arg0 with
  | Cons x y => Cons x (append y append_arg1)
  | Nil => append_arg1
  end.

Fixpoint len (n : lst) {struct n} : natural :=
  match n with
  | Cons _ y => Succ (len y)
  | Nil => Zero
  end.

Definition synth (x : lst) : natural := len (append x (append Nil x)).


(** * Maps: Total and Partial Maps *)

(** _Maps_ (or _dictionaries_) are ubiquitous data structures both
    generally and in the theory of programming languages in
    particular; we're going to need them in many places in the coming
    chapters.  They also make a nice case study using ideas we've seen
    in previous chapters, including building data structures out of
    higher-order functions (from [Basics] and [Poly]) and the use of
    reflection to streamline proofs (from [IndProp]).

    We'll define two flavors of maps: _total_ maps, which include a
    "default" element to be returned when a key being looked up
    doesn't exist, and _partial_ maps, which return an [option] to
    indicate success or failure.  The latter is defined in terms of
    the former, using [None] as the default element. *)

(* ################################################################# *)
(** * The Coq Standard Library *)

(** One small digression before we begin...

    Unlike the chapters we have seen so far, this one does not
    [Require Import] the chapter before it (and, transitively, all the
    earlier chapters).  Instead, in this chapter and from now, on
    we're going to import the definitions and theorems we need
    directly from Coq's standard library stuff.  You should not notice
    much difference, though, because we've been careful to name our
    own definitions and theorems the same as their counterparts in the
    standard library, wherever they overlap. *)

From Coq Require Import Arith.Arith.
From Coq Require Import Bool.Bool.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lists.List.
Import ListNotations.

(** Documentation for the standard library can be found at
    http://coq.inria.fr/library/.

    The [Search] command is a good way to look for theorems involving
    objects of specific types.  Take a minute now to experiment with it. *)

(* ################################################################# *)
(** * Identifiers *)

(** First, we need a type for the keys that we use to index into our
    maps.  In [Lists.v] we introduced a fresh type [id] for a similar
    purpose; here and for the rest of _Software Foundations_ we will
    use the [string] type from Coq's standard library. *)

(** To compare strings, we define the function [eqb_nat], which
    internally uses the function [Nat.eq_dec] from Coq's string
    library. *)

Definition eqb_nat (x y : nat) : bool :=
  if Nat.eq_dec x y then true else false.

(** (The function [Nat.eq_dec] comes from Coq's string library.
    If you check the result type of [Nat.eq_dec], you'll see that it
    does not actually return a [bool], but rather a type that looks
    like [{x = y} + {x <> y}], called a [sumbool], which can be
    thought of as an "evidence-carrying boolean."  Formally, an
    element of [sumbool] is either a proof that two things are equal
    or a proof that they are unequal, together with a tag indicating
    which.  But for present purposes you can think of it as just a
    fancy [bool].) *)

(** Now we need a few basic properties of string equality... *)
Theorem eqb_nat_refl : forall s : nat, true = eqb_nat s s.
Proof. intros s. unfold eqb_nat. destruct (Nat.eq_dec s s) as [|Hs].
  - reflexivity.
  - destruct Hs. reflexivity.
Qed.

(** The following useful property follows from an analogous
    lemma about strings: *)

Theorem eqb_nat_true_iff : forall x y : nat,
    eqb_nat x y = true <-> x = y.
Proof.
   intros x y.
   unfold eqb_nat.
   destruct (Nat.eq_dec x y) as [|Hs].
   - subst. split. reflexivity. reflexivity.
   - split.
     + intros contra. discriminate contra.
     + intros H. rewrite H in Hs. destruct Hs. reflexivity.
Qed.

(** Similarly: *)

Theorem eqb_nat_false_iff : forall x y : nat,
    eqb_nat x y = false <-> x <> y.
Proof.
  intros x y. rewrite <- eqb_nat_true_iff.
  rewrite not_true_iff_false. reflexivity. Qed.

(** This handy variant follows just by rewriting: *)

Theorem false_eqb_nat : forall x y : nat,
   x <> y -> eqb_nat x y = false.
Proof.
  intros x y. rewrite eqb_nat_false_iff.
  intros H. apply H. Qed.

(* ################################################################# *)
(** * Total Maps *)

(** Our main job in this chapter will be to build a definition of
    partial maps that is similar in behavior to the one we saw in the
    [Lists] chapter, plus accompanying lemmas about its behavior.

    This time around, though, we're going to use _functions_, rather
    than lists of key-value pairs, to build maps.  The advantage of
    this representation is that it offers a more _extensional_ view of
    maps, where two maps that respond to queries in the same way will
    be represented as literally the same thing (the very same function),
    rather than just "equivalent" data structures.  This, in turn,
    simplifies proofs that use maps. *)

(** We build partial maps in two steps.  First, we define a type of
    _total maps_ that return a default value when we look up a key
    that is not present in the map. *)

Definition total_map (A : Type) := nat -> A.

(** Intuitively, a total map over an element type [A] is just a
    function that can be used to look up [string]s, yielding [A]s. *)

(** The function [t_empty] yields an empty total map, given a default
    element; this map always returns the default element when applied
    to any string. *)

Definition t_empty {A : Type} (v : A) : total_map A :=
  (fun _ => v).

(** More interesting is the [update] function, which (as before) takes
    a map [m], a key [x], and a value [v] and returns a new map that
    takes [x] to [v] and takes every other key to whatever [m] does. *)

Definition t_update {A : Type} (m : total_map A)
                    (x : nat) (v : A) :=
  fun x' => if eqb_nat x x' then v else m x'.

(** This definition is a nice example of higher-order programming:
    [t_update] takes a _function_ [m] and yields a new function
    [fun x' => ...] that behaves like the desired map. *)

(** For example, we can build a map taking [string]s to [bool]s, where
    ["foo"] and ["bar"] are mapped to [true] and every other key is
    mapped to [false], like this: *)

Definition examplemap :=
  t_update (t_update (t_empty false) 1 true)
           2 true.

(** Next, let's introduce some new notations to facilitate working
    with maps. *)

(** First, we will use the following notation to create an empty
    total map with a default value. *)
Notation "'_' '!->' v" := (t_empty v)
  (at level 100, right associativity).

Example example_empty := (_ !-> false).

(** We then introduce a convenient notation for extending an existing
    map with some bindings. *)
Notation "x '!->' v ';' m" := (t_update m x v)
                              (at level 100, v at next level, right associativity).

(** The [examplemap] above can now be defined as follows: *)

Definition examplemap' :=
  ( 1 !-> true;
    2 !-> true;
    _     !-> false
  ).

(** This completes the definition of total maps.  Note that we
    don't need to define a [find] operation because it is just
    function application! *)

Example update_example1 : examplemap' 3 = false.
Proof. reflexivity. Qed.

Example update_example2 : examplemap' 2 = true.
Proof. reflexivity. Qed.

Example update_example3 : examplemap' 3 = false.
Proof. reflexivity. Qed.

Example update_example4 : examplemap' 1 = true.
Proof. reflexivity. Qed.

(** To use maps in later chapters, we'll need several fundamental
    facts about how they behave. *)

(** Even if you don't work the following exercises, make sure
    you thoroughly understand the statements of the lemmas! *)

(** (Some of the proofs require the functional extensionality axiom,
    which is discussed in the [Logic] chapter.) *)

(** **** Exercise: 1 star, standard, optional (t_apply_empty)

    First, the empty map returns its default element for all keys: *)

Lemma t_apply_empty : forall (A : Type) (x : nat) (v : A),
    (_ !-> v) x = v.
Proof.  intros. unfold t_empty. auto.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_eq)

    Next, if we update a map [m] at a key [x] with a new value [v]
    and then look up [x] in the map resulting from the [update], we
    get back [v]: *)

Lemma t_update_eq : forall (A : Type) (m : total_map A) x v,
    (x !-> v ; m) x = v.
Proof. intros.
  unfold t_update.
  assert (true = eqb_nat x x).
  apply eqb_nat_refl.
  replace (eqb_nat x x) with true.
  auto.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_neq)

    On the other hand, if we update a map [m] at a key [x1] and then
    look up a _different_ key [x2] in the resulting map, we get the
    same result that [m] would have given: *)

Theorem t_update_neq : forall (A : Type) (m : total_map A) x1 x2 v,
    x1 <> x2 ->
    (x1 !-> v ; m) x2 = m x2.
Proof.
  intros.
  unfold t_update.
  assert (eqb_nat x1 x2 = false).
  apply eqb_nat_false_iff.
  auto.
  replace (eqb_nat x1 x2) with false.
  auto.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (t_update_shadow)

    If we update a map [m] at a key [x] with a value [v1] and then
    update again with the same key [x] and another value [v2], the
    resulting map behaves the same (gives the same result when applied
    to any key) as the simpler map obtained by performing just
    the second [update] on [m]: *)

Lemma t_update_shadow : forall (A : Type) (m : total_map A) x v1 v2,
    (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m).
Proof.
  intros.
  unfold t_update.
  apply functional_extensionality_dep; intros.
  destruct (eqb_nat x x0); auto.
Qed.
(** [] *)

(** For the final two lemmas about total maps, it's convenient to use
    the reflection idioms introduced in chapter [IndProp].  We begin
    by proving a fundamental _reflection lemma_ relating the equality
    proposition on [id]s with the boolean function [eqb_id]. *)

(** **** Exercise: 2 stars, standard, optional (eqb_natP)

    Use the proof of [eqbP] in chapter [IndProp] as a template to
    prove the following: *)

Lemma eqb_natP : forall x y : nat,
    reflect (x = y) (eqb_nat x y).
Proof.
  intros.
  apply iff_reflect.
  split; intros.
  rewrite H.
  symmetry.
  apply eqb_nat_refl.
  apply eqb_nat_true_iff; auto.
Qed.
(** [] *)

(** Now, given [string]s [x1] and [x2], we can use the tactic
    [destruct (eqb_natP x1 x2)] to simultaneously perform case
    analysis on the result of [eqb_nat x1 x2] and generate
    hypotheses about the equality (in the sense of [=]) of [x1]
    and [x2]. *)

(** **** Exercise: 2 stars, standard (t_update_same)

    With the example in chapter [IndProp] as a template, use
    [eqb_natP] to prove the following theorem, which states that
    if we update a map to assign key [x] the same value as it already
    has in [m], then the result is equal to [m]: *)

Theorem t_update_same : forall (A : Type) (m : total_map A) x,
    (x !-> m x ; m) = m.
Proof.
  intros.
  unfold t_update.
  apply functional_extensionality_dep; intros.
  destruct (eqb_natP x x0); auto.
Qed.
(** [] *)

(** **** Exercise: 3 stars, standard, recommended (t_update_permute)

    Use [eqb_natP] to prove one final property of the [update]
    function: If we update a map [m] at two distinct keys, it doesn't
    matter in which order we do the updates. *)

Theorem t_update_permute : forall (A : Type) (m : total_map A)
                                  v1 v2 x1 x2,
    x2 <> x1 ->
    (x1 !-> v1 ; x2 !-> v2 ; m)
    =
    (x2 !-> v2 ; x1 !-> v1 ; m).
Proof.
  intros.
  unfold t_update.
  apply functional_extensionality_dep; intros.
  destruct (eqb_natP x1 x).
  destruct (eqb_natP x2 x).
  rewrite <- e in e0.
  rewrite e0 in H.
  exfalso.
  apply H; auto.
  auto.
  destruct (eqb_nat x2 x); auto.
Qed.
(** [] *)

(* ################################################################# *)
(** * Partial maps *)

(** Finally, we define _partial maps_ on top of total maps.  A partial
    map with elements of type [A] is simply a total map with elements
    of type [option A] and default element [None]. *)

Definition partial_map (A : Type) := total_map (option A).

Definition empty {A : Type} : partial_map A :=
  t_empty None.

Definition update {A : Type} (m : partial_map A)
           (x : nat) (v : A) :=
  (x !-> Some v ; m).

(** We introduce a similar notation for partial maps: *)
Notation "x '|->' v ';' m" := (update m x v)
  (at level 100, v at next level, right associativity).

(** We can also hide the last case when it is empty. *)
Notation "x '|->' v" := (update empty x v)
  (at level 100).

Example examplepmap :=
  (1 |-> true ; 2 |-> false).

(** We now straightforwardly lift all of the basic lemmas about total
    maps to partial maps.  *)

Lemma apply_empty : forall (A : Type) (x : nat),
    @empty A x = None.
Proof.
  intros. unfold empty. rewrite t_apply_empty.
  reflexivity.
Qed.

Lemma update_eq : forall (A : Type) (m : partial_map A) x v,
    (x |-> v ; m) x = Some v.
Proof.
  intros. unfold update. rewrite t_update_eq.
  reflexivity.
Qed.

Theorem update_neq : forall (A : Type) (m : partial_map A) x1 x2 v,
    x2 <> x1 ->
    (x2 |-> v ; m) x1 = m x1.
Proof.
  intros A m x1 x2 v H.
  unfold update. rewrite t_update_neq. reflexivity.
  apply H. Qed.

Lemma update_shadow : forall (A : Type) (m : partial_map A) x v1 v2,
    (x |-> v2 ; x |-> v1 ; m) = (x |-> v2 ; m).
Proof.
  intros A m x v1 v2. unfold update. rewrite t_update_shadow.
  reflexivity.
Qed.

Theorem update_same : forall (A : Type) (m : partial_map A) x v,
    m x = Some v ->
    (x |-> v ; m) = m.
Proof.
  intros A m x v H. unfold update. rewrite <- H.
  apply t_update_same.
Qed.

Theorem update_permute : forall (A : Type) (m : partial_map A)
                                x1 x2 v1 v2,
    x2 <> x1 ->
    (x1 |-> v1 ; x2 |-> v2 ; m) = (x2 |-> v2 ; x1 |-> v1 ; m).
Proof.
  intros A m x1 x2 v1 v2. unfold update.
  apply t_update_permute.
Qed.

(* Thu Feb 7 20:09:22 EST 2019 *)


(*
        #####################################################
        ###  PLEASE DO NOT DISTRIBUTE SOLUTIONS PUBLICLY  ###
        #####################################################
*)

Set Default Goal Selector "!".

Require Import Coq.Lists.List.
Require Import Coq.Strings.Ascii.
Require Import Turing.Lang.
Require Import Turing.Regular.
Require Import Turing.Regex.
Require Import Turing.Util.
Require Import Lia.
Import ListNotations.
Import RegexNotations.
Import Lang.LangNotations.
Open Scope char_scope.
Open Scope lang_scope.
Open Scope regex_scope.

(* ---------------------- END OF PREAMBLE ------------------ *)

(**

  The objective of this homework assignment is to prove that
  language L5 is not regular, where L5 is a^n b^m where n < m.

  WARNING: DO NOT CHANGE DEFINITION L5, otherwise you will get 0 points for
  this assignment.

*)
Definition L5 : language := fun w => exists n m, w = pow1 "a" n ++ (pow1 "b" ((S m) + n)).

Lemma pow1_app_cons_inv_eq_1:
forall {T} (a b:T),
a <> b ->
forall x y v w,
pow1 a x ++ b :: y = pow1 a v ++ b :: w ->
x = v.
Proof.
intros ? a b.
induction x; intros. {
    simpl in *.
    destruct v; auto.
    simpl in *.
    inversion H0.
    subst.
    contradiction.
}
simpl in *.
destruct v; simpl in *. {
    inversion H0.
    subst.
    contradiction.
}
inversion H0; subst; clear H0.
apply IHx in H2.
subst; reflexivity.
Qed.

(* ---------------------------------------------------------------------------*)

(**

Easy. Show that the word that clogs is in L5.

 *)
Theorem l5_not_regular_1:
  forall p, In (pow1 "a" p ++ pow1 "b" (S p)) L5.
Proof.
  simpl.
  intros A.
  unfold In.
  unfold L5.
  exists A.
  exists 0.
  simpl.
  reflexivity.
Qed.

(**

Easy. Show that the clogged word has at least p-characters.

 *)

Check app_length.

Theorem l5_not_regular_2:
  forall p, length (pow1 "a" p ++ pow1 "b" (S p)) >= p.
Proof.
  simpl.
  intros A.
  induction A.
  - simpl.
    intuition.
  - simpl.
    rewrite -> app_length.
    rewrite -> pow1_length.
    lia.
Qed.

(**

Difficult. The proof for Regular.Examples.l4_not_regular_alt is similar to what you should be doing. The only theorem you need to use is Regular.Examples.xyz_rw_ex.

 *)
Theorem l5_not_regular_4_1:
  forall p x y z n m, p >= 1 -> y <> [] -> pow1 "a" p ++ "b" :: pow1 "b" p = x ++ y ++ z -> length (x ++ y) <= p -> x ++ (y ++ y) ++ z = pow1 "a" n ++ pow1 "b" (S m + n) -> exists nx ny o,
    ny <> 0 /\
    pow1 "a" nx ++
    (pow1 "a" ny ++ pow1 "a" ny) ++
    pow1 "a" o ++
    "b" :: pow1 "b" (length (pow1 "a" nx ++ pow1 "a" ny) + o)
    =
    pow1 "a" n ++ pow1 "b" (S m + n).
Proof.
  simpl.
  intros A.
  intros B.
  intros C.
  intros D.

Admitted.

(**

Easy. Use rewriting rules (eg, app_assoc).

 *)

Check pow1_plus.
Check pow1_length.

Theorem l5_not_regular_4_2:
  forall nx ny n m o, pow1 "a" nx ++ (pow1 "a" ny ++ pow1 "a" ny) ++ pow1 "a" o ++ "b" :: pow1 "b" (length (pow1 "a" nx ++ pow1 "a" ny) + o) = pow1 "a" n ++ pow1 "b" (S m + n) -> pow1 "a" (nx + ny + ny + o) ++ "b" :: pow1 "b" (nx + ny + o) = pow1 "a" n ++ "b" :: pow1 "b" (m + n).
Proof.
  simpl.
  intros A.
  intros B.
  intros C.
  intros D.
  intros E.
  intros F.
  repeat rewrite app_assoc in F.
  repeat rewrite pow1_plus in F.
  repeat rewrite pow1_length in F.
  assumption.
Qed.

(**

Hard. This is the final step of the proof. You want to start by showing that the powers of "a" are equal (for which you'll need pow1_app_cons_inv_eq_1). After that you want to remove the left-hand side of the equality with app_inv_head. Your final step should be to conclude that both powers must be equal. Once you have an equality over naturals, then use `omega` to conclude.

 *)
Theorem l5_not_regular_4_3:
  forall nx ny o n m, ny <> 0 -> pow1 "a" (nx + ny + ny + o) ++ "b" :: pow1 "b" (nx + ny + o) <>
    pow1 "a" n ++ "b" :: pow1 "b" (m + n).
Proof.

Admitted.

(**

Easy. Use the lemmas that start with l5_not_regular_4_

 *)
Theorem l5_not_regular_4:
  forall p m n x y z, p >= 1 -> y <> [] -> pow1 "a" p ++ "b" :: pow1 "b" p = x ++ y ++ z -> length (x ++ y) <= p -> x ++ (y ++ y) ++ z <> pow1 "a" n ++ pow1 "b" (S m + n).
Proof.
  simpl.
  intros A.
  intros B.
  intros C.
  intros D.
  intros E.
  intros F.
  intros G.
  intros H.
  intros K.
  intros M.
  intros N.
  apply l5_not_regular_4_1 with (p := A) in N.
  - simpl.
    destruct N.
    destruct H0.
    destruct H0.
    destruct H0.
    apply l5_not_regular_4_2 in H1.
    apply l5_not_regular_4_3 in H1. (* assume it is proved *)
    + simpl.
      assumption.
    + simpl.
      assumption.
  - simpl.
    lia.
  - simpl.
    assumption.
  - simpl.
    assumption.
  - simpl.
    assumption.
Qed.

(**

Easy. Show that a^p b^(p+1) clogs L5. Conclude the proof using Lemma l5_not_regular_4 to conclude.

 *)
Theorem l5_not_regular_3:
  forall p, p >= 1 -> In (pow1 "a" p ++ pow1 "b" (S p)) (Clogs L5 p).
Proof.
  simpl.
  unfold Clogs, In.
  intros A.
  intros B.
  intros C.
  intros D.
  intros E.
  intros F.
  intros G.
  intros H.
  exists 2.
  intros K.
  unfold In in K.
  unfold L5 in K.
  destruct K.
  destruct H0.
  simpl in H0.
  rewrite app_nil_r in H0.
  apply l5_not_regular_4 with (p := A) in H0.
  - simpl.
    apply H0.
  - simpl.
    assumption.
  - simpl.
    assumption.
  - simpl.
    assumption.
  - simpl.
    assumption.
Qed.

(**

Easy. Show that L5 is not regular.

 *)

Check clogged_def.

Theorem l5_not_regular:
  ~ Regular L5.
Proof.
  simpl.
  unfold L5.
  apply not_regular.
  intros A.
  intros B.

Admitted.


Require Import Arith.
Require Import Hoare.Map.
Require Import Tactics.Crush.
Require Import Tactics.Tactics.

Set Implicit Arguments.

Definition var := nat.
Definition valuation := map var nat.
Opaque var.  (** for later Coercion *)

(** Since we don't have memory allocation and deallocation, we can treat
    our heap as a total mapping from [nat] to [nat]. All memory not set
    has a default value 0. *)
Definition heap := map nat nat.

Definition assertion := valuation -> heap -> Prop.

Inductive exp :=
| Const (n : nat)
| Var (x : var)
| Read (e : exp)
| Plus (e1 e2 : exp)
| Minus (e1 e2 : exp)
| Mult (e1 e2 : exp).

Inductive bexp :=
| Equal (e1 e2 : exp)
| Less (e1 e2 : exp)
| LessOrEqual (e1 e2 : exp).

(** A command is something that can cause a valuation/heap change. *)
Inductive cmd :=
| Skip
| Assign (x : var) (e : exp)
| Write (e1 e2 : exp)
| Seq (c1 c2 : cmd)
| If (cond : bexp) (br1 br2 : cmd)
| While (I : assertion) (cond : bexp) (body : cmd)
| Assert (a : assertion).

(** Semantics of (bool) expressions. *)
Fixpoint eval (e : exp) (v : valuation) (h : heap) : nat :=
  match e with
  | Const n => n
  | Var x => lookup v x
  | Read e => lookup h (eval e v h)
  | Plus e1 e2 => eval e1 v h + eval e2 v h
  | Minus e1 e2 => eval e1 v h - eval e2 v h
  | Mult e1 e2 => eval e1 v h * eval e2 v h
  end.

Fixpoint beval (b : bexp) (v : valuation) (h : heap) : bool :=
  match b with
  | Equal e1 e2 => (eval e1 v h) =? (eval e2 v h)
  | Less e1 e2 => (eval e1 v h) <? (eval e2 v h)
  | LessOrEqual e1 e2 => (eval e1 v h) <=? (eval e2 v h)
  end.

(** Big-step semantics. *)
Inductive execute : valuation -> heap -> cmd -> valuation -> heap -> Prop :=
| ExeSkip : forall v h,
    execute v h Skip v h
| ExeAssign : forall v h x e,
    execute v h (Assign x e) (add v x (eval e v h)) h
| ExeWrite : forall v h e1 e2,
    execute v h (Write e1 e2) v (add h (eval e1 v h) (eval e2 v h))
| ExeSeq : forall v1 h1 c1 v2 h2 c2 v3 h3,
    execute v1 h1 c1 v2 h2 ->
    execute v2 h2 c2 v3 h3 ->
    execute v1 h1 (Seq c1 c2) v3 h3
| ExeIfTrue : forall v1 h1 cond br1 br2 v2 h2,
    beval cond v1 h1 = true ->
    execute v1 h1 br1 v2 h2 ->
    execute v1 h1 (If cond br1 br2) v2 h2
| ExeIfFalse : forall v1 h1 cond br1 br2 v2 h2,
    beval cond v1 h1 = false ->
    execute v1 h1 br2 v2 h2 ->
    execute v1 h1 (If cond br1 br2) v2 h2
| ExeWhileFalse : forall I v h cond body,
    beval cond v h = false ->
    execute v h (While I cond body) v h
| ExeWhileTrue : forall I v1 h1 cond body v2 h2 v3 h3,
    beval cond v1 h1 = true ->
    execute v1 h1 body v2 h2 ->
    execute v2 h2 (While I cond body) v3 h3 ->
    execute v1 h1 (While I cond body) v3 h3
| ExeAssert : forall v h (a : assertion),
    a v h ->
    execute v h (Assert a) v h.

Definition assertion_implies (P Q : assertion) : Prop :=
  forall v h, P v h -> Q v h.

Definition valuation_sub (P : assertion) (x : var) (e : exp) : assertion :=
  fun v h => P (add v x (eval e v h)) h.

Definition heap_sub (P : assertion) (e1 e2 : exp) : assertion :=
  fun v h => P v (add h (eval e1 v h) (eval e2 v h)).

(** Hoare triple, as LogicProp. *)
Inductive htriple : assertion -> cmd -> assertion -> Prop :=
| HtSkip : forall P,
    htriple P Skip P
| HtAssign : forall P x e,
    htriple (valuation_sub P x e) (Assign x e) P
| HtWrite : forall P e1 e2,
    htriple (heap_sub P e1 e2) (Write e1 e2) P
| HtSeq : forall P Q R c1 c2,
    htriple Q c2 R ->
    htriple P c1 Q ->
    htriple P (Seq c1 c2) R
| HtIf : forall P Q cond br1 br2,
    htriple (fun v h => P v h /\ beval cond v h = true) br1 Q ->
    htriple (fun v h => P v h /\ beval cond v h = false) br2 Q ->
    htriple P (If cond br1 br2) Q
| HtWhile : forall I P cond body,
    htriple (fun v h => I v h /\ beval cond v h = true) body I (* invariant keeps *) ->
    assertion_implies (fun v h => I v h /\ beval cond v h = false) P ->
    htriple I (While I cond body) P
| HtAssert : forall I P,
    assertion_implies P I ->
    htriple P (Assert I) P
| HtConsequence : forall P Q P' Q' c,
    htriple P c Q ->
    assertion_implies P' P ->
    assertion_implies Q Q' ->
    htriple P' c Q'.

Hint Unfold assertion_implies valuation_sub heap_sub.
Hint Constructors execute htriple.

(** Surface syntax for expression and command. Borrowed from FRAP. *)
Coercion Const : nat >-> exp.
Coercion Var : var >-> exp.

Notation "*[ e ]" := (Read e) : cmd_scope.
Infix "+" := Plus : cmd_scope.
Infix "-" := Minus : cmd_scope.
Infix "*" := Mult : cmd_scope.
Infix "=" := Equal : cmd_scope.
Infix "<" := Less : cmd_scope.
Infix "<=" := LessOrEqual : cmd_scope.

Infix "<-" := Assign (no associativity, at level 70) : cmd_scope.
Infix "(-" := Write (no associativity, at level 70) : cmd_scope.
Infix ";;" := Seq (right associativity, at level 75) : cmd_scope.
Notation "'when' cond 'then' br1 'else' br2 'end'" := (If cond br1 br2) (at level 75, cond at level 0) : cmd_scope.
Notation "{{ I }} 'while' cond 'loop' body 'end'" := (While I cond body) (at level 75) : cmd_scope.
Notation "'assert' {{ I }}" := (Assert I) (at level 75) : cmd_scope.
Delimit Scope cmd_scope with cmd.

(** Reset scope in nested in cmd scope for assertion on heap and valutation. *)
Infix "+" := plus : reset_scope.
Infix "-" := minus : reset_scope.
Infix "*" := mult : reset_scope.
Infix "=" := eq : reset_scope.
Infix "<" := lt : reset_scope.
Infix "<=" := le : reset_scope.
Delimit Scope reset_scope with reset.
Open Scope reset_scope.

Lemma HtConsequencePre :
  forall P Q P' c,
    htriple P c Q ->
    assertion_implies P' P ->
    htriple P' c Q.
Proof.
  intros; apply HtConsequence with (P := P) (Q := Q); crush.
Qed.

Lemma HtConsequencePost :
  forall P Q Q' c,
    htriple P c Q ->
    assertion_implies Q Q' ->
    htriple P c Q'.
Proof.
  intros; apply HtConsequence with (P := P) (Q := Q); crush.
Qed.

(* Instead of (e)constructor, we use this dedicated tactics to replace [HtConsequence]
   to [HtConsequencePre]. *)
Ltac ht1 := apply HtSkip ||
            apply HtAssign ||
            apply HtWrite ||
            eapply HtSeq ||
            eapply HtIf ||
            eapply HtWhile ||
            eapply HtAssert ||
            eapply HtConsequencePre.

Ltac a := unfold assertion_implies; intros; unfold valuation_sub, heap_sub;
          crush.

Ltac ht := repeat ht1;
           match goal with
           | [ |- assertion_implies _ _ ] => a
           end.

Lemma hoare_while_sound :
  forall I cond body,
    (forall v h v' h',
      execute v h body v' h' ->
      I v h /\ beval cond v h = true ->
      I v' h') ->
    forall v h v' h',
      execute v h (While I cond body) v' h' ->
      I v h ->
      I v' h' /\ beval cond v' h' = false.
Proof.
  intros I cond body Hwhile.
  intros v h v' h' H.
  remember (While I cond body) as e; induction H;
    inversion Heqe; subst; try pose proof (Hwhile v1 h1 v2 h2); crush.
Qed.

Theorem hoare_sound :
  forall c P Q,
    htriple P c Q ->
      forall v h v' h', execute v h c v' h' -> P v h -> Q v' h'.
Proof.
  induction 1; intros v h v' h' Hex; inversion Hex; crush; firstorder.
  try eassumption; eauto.
  pose proof (hoare_while_sound IHhtriple Hex H11);
  pose proof (H0 v' h'); crush.
Qed.

(** Hoare triple formalization, from definition to theorems, then we don't need
    to the soundness of hoare logic. *)
Module Hoare2.
  Definition htriple (P : assertion) (c : cmd) (Q : assertion) : Prop :=
    forall v h v' h', execute v h c v' h' -> P v h -> Q v' h'.

  Ltac h := unfold htriple; intros;
            match goal with
            | [ H : execute _ _ _ _ _ |- _ ] => inversion H; subst
            end; subst; auto.

  Theorem HtSkip :
    forall P,
      htriple P Skip P.
  Proof.
    h.
  Qed.

  Theorem HtAssign :
    forall P x e,
      htriple (valuation_sub P x e) (Assign x e) P.
  Proof.
    h.
  Qed.

  Theorem HtWrite :
    forall P e1 e2,
      htriple (heap_sub P e1 e2) (Write e1 e2) P.
  Proof.
    h.
  Qed.

  Theorem HtSeq :
    forall P Q R c1 c2,
      htriple Q c2 R -> htriple P c1 Q -> htriple P (Seq c1 c2) R.
  Proof.
    h. eapply H; eauto.
  Qed.

  Theorem HtIf :
    forall P Q cond br1 br2,
      htriple (fun v h => P v h /\ beval cond v h = true) br1 Q ->
      htriple (fun v h => P v h /\ beval cond v h = false) br2 Q ->
      htriple P (If cond br1 br2) Q.
  Proof.
    h; firstorder.
  Qed.

  Theorem HtWhile :
    forall I P cond body,
      htriple (fun v h => I v h /\ beval cond v h = true) body I ->
      assertion_implies (fun v h => I v h /\ beval cond v h = false) P ->
      htriple I (While I cond body) P.
  Proof.
    unfold htriple; intros.
    remember (While I cond body) as E.
    induction H1; inversion HeqE; crush.
    clear IHexecute1 HeqE.
    firstorder.
  Qed.

  Theorem HtAssert :
    forall I P,
      assertion_implies P I ->
      htriple P (Assert I) P.
  Proof.
    h.
  Qed.

  Theorem HtConsequence :
    forall P Q P' Q' c,
      htriple P c Q ->
      assertion_implies P' P ->
      assertion_implies Q Q' ->
      htriple P' c Q'.
  Proof.
    unfold htriple; intros.
    apply H1. eapply H; eauto.
  Qed.
End Hoare2.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable tS_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable tP_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable par_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable pG_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable oS_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable meet_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable defparallelogram_1 : (forall A B C D : Universe, (pG_ A B C D -> (par_ A B C D /\ par_ A D B C))).
Variable defparallelogram2_2 : (forall A B C D : Universe, ((par_ A B C D /\ par_ A D B C) -> pG_ A B C D)).
Variable lemma_parallelsymmetric_3 : (forall A B C D : Universe, (par_ A B C D -> par_ C D A B)).
Variable lemma_paralleldef2B_4 : (forall A B C D : Universe, (par_ A B C D -> tP_ A B C D)).
Variable deftarski_parallel_5 : (forall A B C D : Universe, (tP_ A B C D -> (A <> B /\ (C <> D /\ (~(meet_ A B C D) /\ oS_ C D A B))))).
Variable deftarski_parallel2_6 : (forall A B C D : Universe, ((A <> B /\ (C <> D /\ (~(meet_ A B C D) /\ oS_ C D A B))) -> tP_ A B C D)).
Variable lemma_samesidesymmetric_7 : (forall A B P Q : Universe, (oS_ P Q A B -> (oS_ Q P A B /\ (oS_ P Q B A /\ oS_ Q P B A)))).
Variable lemma_betweennotequal_8 : (forall A B C : Universe, (betS_ A B C -> (B <> C /\ (A <> B /\ A <> C)))).
Variable defcollinear_9 : (forall A B C : Universe, (col_ A B C -> (A = B \/ (A = C \/ (B = C \/ (betS_ B A C \/ (betS_ A B C \/ betS_ A C B))))))).
Variable defcollinear2a_10 : (forall A B C : Universe, (A = B -> col_ A B C)).
Variable defcollinear2b_11 : (forall A B C : Universe, (A = C -> col_ A B C)).
Variable defcollinear2c_12 : (forall A B C : Universe, (B = C -> col_ A B C)).
Variable defcollinear2d_13 : (forall A B C : Universe, (betS_ B A C -> col_ A B C)).
Variable defcollinear2e_14 : (forall A B C : Universe, (betS_ A B C -> col_ A B C)).
Variable defcollinear2f_15 : (forall A B C : Universe, (betS_ A C B -> col_ A B C)).
Variable lemma_collinear4_16 : (forall A B C D : Universe, ((col_ A B C /\ (col_ A B D /\ A <> B)) -> col_ B C D)).
Variable lemma_collinearorder_17 : (forall A B C : Universe, (col_ A B C -> (col_ B A C /\ (col_ B C A /\ (col_ C A B /\ (col_ A C B /\ col_ C B A)))))).
Variable lemma_parallelNC_18 : (forall A B C D : Universe, (par_ A B C D -> (~(col_ A B C) /\ (~(col_ A C D) /\ (~(col_ B C D) /\ ~(col_ A B D)))))).
Variable lemma_NCorder_19 : (forall A B C : Universe, (~(col_ A B C) -> (~(col_ B A C) /\ (~(col_ B C A) /\ (~(col_ C A B) /\ (~(col_ A C B) /\ ~(col_ C B A))))))).
Variable defoppositeside_20 : (forall P A B Q : Universe, (exists X : Universe, (tS_ P A B Q -> (betS_ P X Q /\ (col_ A B X /\ ~(col_ A B P)))))).
Variable defoppositeside2_21 : (forall P A B Q X : Universe, ((betS_ P X Q /\ (col_ A B X /\ ~(col_ A B P))) -> tS_ P A B Q)).
Variable lemma_planeseparation_22 : (forall A B C D E : Universe, ((oS_ C D A B /\ tS_ D A B E) -> tS_ C A B E)).
Variable axiom_betweennesssymmetry_23 : (forall A B C : Universe, (betS_ A B C -> betS_ C B A)).
Variable defparallel_24 : (forall A B C D : Universe, (exists U V Su Sv X : Universe, (par_ A B C D -> (A <> B /\ (C <> D /\ (col_ A B U /\ (col_ A B V /\ (U <> V /\ (col_ C D Su /\ (col_ C D Sv /\ (Su <> Sv /\ (~(meet_ A B C D) /\ (betS_ U X Sv /\ betS_ Su X V))))))))))))).
Variable defparallel2_25 : (forall A B C D U V Su Sv X : Universe, ((A <> B /\ (C <> D /\ (col_ A B U /\ (col_ A B V /\ (U <> V /\ (col_ C D Su /\ (col_ C D Sv /\ (Su <> Sv /\ (~(meet_ A B C D) /\ (betS_ U X Sv /\ betS_ Su X V)))))))))) -> par_ A B C D)).
Variable defmeet_26 : (forall A B C D : Universe, (exists X : Universe, (meet_ A B C D -> (A <> B /\ (C <> D /\ (col_ A B X /\ col_ C D X)))))).
Variable defmeet2_27 : (forall A B C D X : Universe, ((A <> B /\ (C <> D /\ (col_ A B X /\ col_ C D X))) -> meet_ A B C D)).
Variable lemma_inequalitysymmetric_28 : (forall A B : Universe, (A <> B -> B <> A)).
Variable lemma_collinearbetween_29 : (forall A B C D E F H : Universe, ((col_ A E B /\ (col_ C F D /\ (A <> B /\ (C <> D /\ (A <> E /\ (F <> D /\ (~(meet_ A B C D) /\ (betS_ A H D /\ col_ E F H)))))))) -> betS_ E H F)).

Theorem lemma_parallelPasch_30 : (forall A B C D E : Universe, (exists X : Universe, ((pG_ A B C D /\ betS_ A D E) -> (betS_ B X E /\ betS_ C X D)))).
Proof.
  time tac.
Qed.

End FOFProblem.


(* This file is generated by Why3's Coq 8.4 driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require int.Abs.
Require int.ComputerDivision.

Axiom mod_div_unique : forall (x:Z) (y:Z) (q:Z) (r:Z), ((0%Z <= x)%Z /\
  ((0%Z < y)%Z /\ ((x = ((q * y)%Z + r)%Z) /\ ((0%Z <= r)%Z /\
  (r < y)%Z)))) -> ((q = (ZArith.BinInt.Z.quot x y)) /\
  (r = (ZArith.BinInt.Z.rem x y))).

Import Zquot.
Open Scope Z_scope.

(* Why3 goal *)
Theorem mod_succ_1 : forall (x:Z) (y:Z), ((0%Z <= x)%Z /\ (0%Z < y)%Z) ->
  ((~ ((ZArith.BinInt.Z.rem (x + 1%Z)%Z y) = 0%Z)) ->
  ((ZArith.BinInt.Z.rem (x + 1%Z)%Z y) = ((ZArith.BinInt.Z.rem x y) + 1%Z)%Z)).
(* Why3 intros x y (h1,h2) h3. *)
intros x y (Hx,Hy) H.
assert (h: y>0) by omega.
generalize (Z_quot_rem_eq x y); intro h1.
generalize (Z_quot_rem_eq (x+1) y); intro h2.
assert (h3:x = y * (Z.quot (x + 1) y) + (Z.rem (x + 1) y - 1)) by omega.
generalize (mod_div_unique x y (Z.quot (x + 1) y) (Z.rem (x + 1) y - 1)).
intuition.
destruct H1 ; auto with zarith.
rewrite h3 at 1.
ring.
assert (0 <= Z.rem (x + 1) y < y).
  apply Zrem_lt_pos_pos; omega.
omega.
Qed.