(** 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 (lf2 : natural) (z : natural) (x : natural) : natural :=
  plus lf2 (mult z x).


From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq fintype.

Section SeqSet.

  (* Let T be any type with decidable equality. *)
  Context {T: eqType}.

  (* We define a set as a sequence that has no duplicates. *)
  Record set :=
  {
    _set_seq :> seq T ;
    _ : uniq _set_seq (* no duplicates *)
  }.

  (* Now we add the ssreflect boilerplate code. *)
  Canonical Structure setSubType := [subType for _set_seq].
  Definition set_eqMixin := [eqMixin of set by <:].
  Canonical Structure set_eqType := EqType set set_eqMixin.
  Canonical Structure mem_set_predType := mkPredType (fun (l : set) => mem_seq (_set_seq l)).
  Definition set_of of phant T := set.

End SeqSet.

Notation " {set R } " := (set_of (Phant R)).

Section Lemmas.

  Context {T: eqType}.
  Variable s: {set T}.

  Lemma set_uniq : uniq s.
  Proof.
    by destruct s.
  Qed.

  Lemma set_mem : forall x, (x \in s) = (x \in _set_seq s).
  Proof.
    by intros x; destruct s.
  Qed.

End Lemmas.

Section LemmasFinType.

  Context {T: finType}.
  Variable s: {set T}.

  Lemma set_card : #|s| = size s.
  Proof.
    have UNIQ: uniq s by destruct s.
    by move: UNIQ => /card_uniqP ->.
  Qed.

End LemmasFinType.


Require Export Basics.

Theorem plus_n_0_firsttry : forall n:nat,
  n = n + 0.

Proof.
  intros n.
  simpl.
Abort.

Theorem plus_n_0_secondtry : forall n:nat,
  n = n + 0.
Proof.
  intros n. destruct n as [| n'].
  reflexivity.
  simpl.
Abort.

Theorem plus_n_0 : forall n:nat, n = n+0.
Proof.
  intros n. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Theorem minus_diag : forall n, minus n n = 0.
Proof.
  intros n. induction n as [| n' IHn' ].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  intros n m. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Theorem plus_comm : forall n m : nat, n + m = m + n.
Proof.
  intros n m. induction n as [| n' IHn'].
  - simpl. rewrite <- plus_n_0. reflexivity.
  - simpl. rewrite <- plus_n_Sm. rewrite <- IHn'. reflexivity.
Qed.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Fixpoint double (n:nat) :=
  match n with
  | 0 => 0
  | S n' => S (S (double n'))
  end.

Lemma double_plus : forall n, double n = n + n.
Proof.
  intros n. induction n as [| n' IHn' ].
  - reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
Qed.

Theorem evenb_S : forall n : nat, evenb (S n) = negb (evenb n).
Proof.
  intros n. induction n as [| n' IHn' ].
  - simpl. reflexivity.
  - rewrite -> IHn'. simpl. rewrite -> negb_involute. reflexivity.
Qed.

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n). { reflexivity. }
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_rearrange_firsttry: forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  rewrite -> plus_comm.
Abort.

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H : n + m = m + n).
  { rewrite -> plus_comm. reflexivity. }
  rewrite -> H. reflexivity.
Qed.

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [| n' IHn' ].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.


Require Export TopologicalSpaces.
Require Export OpenBases.
From ZornsLemma Require Export FiniteTypes.
From ZornsLemma Require Export EnsemblesSpec.

Section Subbasis.

Variable X:TopologicalSpace.
Variable SB:Family (point_set X).

Record subbasis : Prop := {
  subbasis_elements: forall U:Ensemble (point_set X),
    In SB U -> open U;
  subbasis_cover: forall (U:Ensemble (point_set X)) (x:point_set X),
    In U x -> open U ->
    exists A:Type, FiniteT A /\
    exists V:A->Ensemble (point_set X),
      (forall a:A, In SB (V a)) /\
      In (IndexedIntersection V) x /\
      Included (IndexedIntersection V) U
}.

Lemma open_basis_is_subbasis: open_basis SB -> subbasis.
Proof.
intros.
destruct H.
constructor.
exact open_basis_elements.
intros.
destruct (open_basis_cover x U); trivial.
destruct H1 as [? [? ?]].
exists True.
split.
apply True_finite.
exists (True_rect x0).
repeat split; intros.
destruct a.
simpl.
assumption.
destruct a.
simpl.
assumption.
red; intros.
destruct H4.
apply H2.
exact (H4 I).
Qed.

Lemma finite_intersections_of_subbasis_form_open_basis:
  subbasis ->
  open_basis [ U:Ensemble (point_set X) |
              exists A:Type, FiniteT A /\
              exists V:A->Ensemble (point_set X),
              (forall a:A, In SB (V a)) /\
              U = IndexedIntersection V ].
Proof.
constructor.
intros.
destruct H0.
destruct H0 as [A [? [V' [? ?]]]].
rewrite H2.
apply open_finite_indexed_intersection; trivial.
intros.
apply H; trivial.

intros.
pose proof (subbasis_cover H U x).
destruct H2 as [A [? [V [? [? ?]]]]]; trivial.
exists (IndexedIntersection V).
repeat split; trivial.
exists A; split; trivial.
exists V; trivial.
split; trivial.
destruct H4.
exact H4.
Qed.

End Subbasis.

Arguments subbasis {X}.

Section build_from_subbasis.

Variable X:Type.
Variable S:Family X.

From ZornsLemma Require Import FiniteIntersections.

Definition Build_TopologicalSpace_from_subbasis : TopologicalSpace.
refine (Build_TopologicalSpace_from_open_basis
  (finite_intersections S) _ _).
red; intros.
exists (Intersection U V); repeat split; trivial.
apply intro_intersection; trivial.
destruct H1; assumption.
destruct H1; assumption.
destruct H2; assumption.
destruct H2; assumption.

red; intro.
exists Full_set.
split; constructor.
Defined.

Lemma Build_TopologicalSpace_from_subbasis_subbasis:
  @subbasis Build_TopologicalSpace_from_subbasis S.
Proof.
assert (@open_basis Build_TopologicalSpace_from_subbasis
  (finite_intersections S)).
apply Build_TopologicalSpace_from_open_basis_basis.
constructor.
intros.
simpl in U.
apply open_basis_elements with (finite_intersections S); trivial.
constructor; trivial.

intros.
destruct (@open_basis_cover _ _ H x U) as [V]; trivial.
destruct H2 as [? [? ?]].
simpl.

pose proof (finite_intersection_is_finite_indexed_intersection
  _ _ H2).
destruct H5 as [A [? [W [? ?]]]].
exists A; split; trivial.
exists W; repeat split; trivial.

rewrite H7 in H4; destruct H4; apply H4.
rewrite H7 in H3; assumption.
Qed.

End build_from_subbasis.


Theorem app_nil_r : forall (X:Type), forall l:list X,
  l ++ [] = l.
Proof.
  intros.
  induction l as [| h t IH].
  - simpl. reflexivity.
  - simpl. rewrite IH. reflexivity.
Qed.

Theorem app_assoc : forall A (l m n:list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  intros.
  induction l as [| h t IH].
  - simpl. reflexivity.
  - simpl. rewrite IH. reflexivity.
Qed.

Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  intros.
  induction l1 as [| h t IH].
  - simpl. reflexivity.
  - simpl. rewrite IH. reflexivity.
Qed.


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

(* ** Two infinite sequences of primes *)

Require Import List Arith Lia Bool Permutation.

From Undecidability.Shared.Libs.DLW
  Require Import utils utils_tac utils_list utils_nat gcd rel_iter prime pos vec.

Set Implicit Arguments.

Local Notation "e #> x" := (vec_pos e x).
Local Notation "e [ v / x ]" := (vec_change e x v).

Set Implicit Arguments.

(* Unique decomposition with a prime *)

Lemma prime_neq_0 p : prime p -> p <> 0.
Proof.
  intros ? % prime_ge_2; lia.
Qed.

#[export] Hint Resolve prime_neq_0 : core.

Lemma power_factor_lt_neq p i j x y :
         p <> 0
      -> i < j
      -> ~ divides p x
      -> p^i * x <> p^j * y.
Proof.
  intros H1 H2 H3 H5.
  replace j with (i+S (j-i-1)) in H5 by lia.
  rewrite Nat.pow_add_r, <- mult_assoc in H5.
  rewrite Nat.mul_cancel_l in H5.
  2: apply Nat.pow_nonzero; auto.
  apply H3; subst x; simpl.
  do 2 apply divides_mult_r; apply divides_refl.
Qed.

Lemma power_factor_uniq p i j x y :
         p <> 0
      -> ~ divides p x
      -> ~ divides p y
      -> p^i * x = p^j * y
      -> i = j /\ x = y.
Proof.
  intros H1 H2 H3 H4.
  destruct (lt_eq_lt_dec i j) as [ [ H | H ] | H ].
  + exfalso; revert H4; apply power_factor_lt_neq; auto.
  + split; auto; subst j.
    rewrite Nat.mul_cancel_l in H4; auto.
    apply Nat.pow_nonzero; auto.
  + exfalso; symmetry in H4; revert H4; apply power_factor_lt_neq; auto.
Qed.

(* The unboundedness of primes *)

Lemma prime_above m : { p | m < p /\ prime p }.
Proof.
  destruct (prime_factor (n := fact m + 1)) as (p & ? & ?).
  - pose proof (lt_O_fact m); lia.
  - exists p; eauto. destruct (Nat.lt_ge_cases m p); eauto.
    eapply divides_plus_inv in H0.
    + eapply divides_1_inv in H0; subst. destruct H; lia.
    + eapply divides_fact. eapply prime_ge_2 in H; eauto.
Qed.

Lemma prime_dec p : { prime p } + { ~ prime p }.
Proof.
  destruct (le_lt_dec 2 p) as [ H | H ].
  + destruct (prime_or_div H) as [ (q & H1 & H2) | ? ]; auto.
    right; intros C; apply C in H2; lia.
  + right; intros (H1 & H2).
    destruct (H2 2); try lia.
    exists 0; simpl; lia.
Qed.

Lemma first_prime_above m : { p | m < p /\ prime p /\ forall q, m < q -> prime q -> p <= q }.
Proof.
  destruct min_dec with (P := fun p => m < p /\ prime p)
    as (p & H1 & H2).
  + intros n.
    destruct (lt_dec m n); destruct (prime_dec n); tauto.
  + destruct (prime_above m) as (p & ?); exists p; auto.
  + exists p; firstorder.
Qed.

Lemma prime_divides p q :
  prime p -> prime q -> divides p q -> p = q.
Proof.
  now intros Hp Hq [ [] % Hp | ] % Hq.
Qed.

Definition nxtprime n := proj1_sig (first_prime_above n).

Fact nxtprime_spec1 n : n < nxtprime n.
Proof. apply (proj2_sig (first_prime_above n)). Qed.

Fact nxtprime_spec2 n : prime (nxtprime n).
Proof. apply (proj2_sig (first_prime_above n)). Qed.

#[export] Hint Resolve nxtprime_spec1 nxtprime_spec2 prime_2 : core.

Fixpoint notprime_bool_rec n k :=
  match k with
    | 0   => true
    | S k' => negb (prime_bool n) && notprime_bool_rec (S n) k'
  end.

Theorem prime_bool_spec' p : prime_bool p = false <-> ~ prime p.
Proof.
  rewrite <- not_true_iff_false, prime_bool_spec; tauto.
Qed.

Fact notprime_bool_rec_spec n k : notprime_bool_rec n k = true <-> forall i, n <= i < k+n -> ~ prime i.
Proof.
  revert n; induction k as [ | k IHk ]; intros n; simpl.
  + split; auto; intros; lia.
  + rewrite andb_true_iff, negb_true_iff,
            <- not_true_iff_false, prime_bool_spec, IHk.
    split.
    * intros (H1 & H2) i Hi.
      destruct (eq_nat_dec n i); subst; auto.
      apply H2; lia.
    * intros H; split; intros; apply H; lia.
Qed.

Definition nxtprime_bool n p := Nat.leb (S n) p && notprime_bool_rec (S n) (p - S n) && prime_bool p.

Fact nxtprime_bool_spec n p : nxtprime_bool n p = true <-> nxtprime n = p.
Proof.
  unfold nxtprime_bool.
  rewrite !andb_true_iff, Nat.leb_le, notprime_bool_rec_spec, prime_bool_spec.
  unfold nxtprime.
  destruct (first_prime_above n) as (q & G1 & G2 & G3); simpl.
  split.
  + intros ((H1 & H2) & H3).
    apply le_antisym.
    * apply G3; auto.
    * apply Nat.nlt_ge.
      intro; apply (H2 q); auto; lia.
  + intros ->; lsplit 2; auto.
    intros q Hq C; apply G3 in C; lia.
Qed.

Definition nthprime (n : nat) := iter nxtprime 2 n.

Lemma nthprime_prime n : prime (nthprime n).
Proof. unfold nthprime; destruct n; simpl; auto; rewrite iter_swap; auto. Qed.

#[export] Hint Resolve nthprime_prime : core.

Lemma nthprime_ge n m : n < m -> nthprime n < nthprime m.
Proof.
  unfold nthprime.
  induction 1; simpl iter; rewrite iter_swap; auto.
  apply lt_trans with (2 := nxtprime_spec1 _); auto.
Qed.

Lemma nthprime_inj n m : nthprime n = nthprime m -> n = m.
Proof.
  destruct (lt_eq_lt_dec n m) as [ [ H | ] | H ]; auto;
    intros; eapply nthprime_ge in H; lia.
Qed.

Fact nthprime_nxt i p q : nthprime i = p -> nxtprime p = q -> nthprime (S i) = q.
Proof.
  replace (S i) with (i+1) by lia.
  unfold nthprime at 2.
  rewrite iter_plus; fold (nthprime i).
  intros -> ?; simpl; auto.
Qed.

(* Certified Erastosthene sieve would be helpfull here *)

Fact nthprime_0 : nthprime 0 = 2.
Proof. auto. Qed.

Local Ltac nth_prime_tac H :=
  apply nthprime_nxt with (1 := H);
  apply nxtprime_bool_spec; auto.

Fact nthprime_1 : nthprime 1 = 3.    Proof. nth_prime_tac nthprime_0. Qed.
Fact nthprime_2 : nthprime 2 = 5.    Proof. nth_prime_tac nthprime_1. Qed.
Fact nthprime_3 : nthprime 3 = 7.    Proof. nth_prime_tac nthprime_2. Qed.
Fact nthprime_4 : nthprime 4 = 11.   Proof. nth_prime_tac nthprime_3. Qed.
Fact nthprime_5 : nthprime 5 = 13.   Proof. nth_prime_tac nthprime_4. Qed.
Fact nthprime_6 : nthprime 6 = 17.   Proof. nth_prime_tac nthprime_5. Qed.

Record primestream :=
  {
    str :> nat -> nat;
    str_inj : forall n m, str n = str m -> n = m;
    str_prime : forall n, prime (str n);
  }.

#[export] Hint Immediate str_prime : core.
#[export] Hint Resolve str_inj : core.

Lemma primestream_divides (ps : primestream) n m :  divides (ps n) (ps m) -> n = m.
Proof.
  destruct ps as [ str H1 H2 ]; simpl.
  intros ? % prime_divides; eauto.
Qed.

Definition ps : primestream.
Proof.
  exists (fun n => nthprime (2 * n)); auto.
  intros; apply nthprime_inj in H; lia.
Defined.

Fact ps_1 : ps 1 = 5.
Proof. simpl; apply nthprime_2. Qed.

Definition qs : primestream.
Proof.
  exists (fun n => nthprime (1 + 2 * n)); auto.
  intros; apply nthprime_inj in H; lia.
Defined.

Fact qs_1 : qs 1 = 7.
Proof. simpl; apply nthprime_3. Qed.

Lemma ps_qs : forall n m, ps n = qs m -> False.
Proof. intros ? ? ? % nthprime_inj; lia. Qed.

#[export] Hint Resolve ps_qs : core.

Lemma ps_qs_div n m : ~ divides (ps n) (qs m).
Proof. intros ? % prime_divides; eauto. Qed.

Lemma qs_ps_div n m : ~ divides (qs n) (ps m).
Proof. intros ? % prime_divides; eauto. Qed.

Fixpoint exp {n} (i : nat) (v : vec nat n) : nat :=
  match v with
    | vec_nil => 1
    | x##v    => qs i ^ x * exp (S i) v
  end.

Fact exp_nil i : exp i vec_nil = 1.
Proof. auto. Qed.

Fact exp_cons n i x v : @exp (S n) i (x##v) = qs i^x*exp (S i) v.
Proof. auto. Qed.

Fact exp_zero n i : @exp n i vec_zero = 1.
Proof.
  revert i; induction n as [ | n IHn ]; intros i; simpl; auto.
  rewrite IHn; ring.
Qed.

Fact exp_app n m i v w : @exp (n+m) i (vec_app v w) = exp i v * exp (n+i) w.
Proof.
  revert i; induction v as [ | x n v IHv ]; intros i.
  + rewrite vec_app_nil, exp_zero; simpl; ring.
  + rewrite vec_app_cons, exp_cons.
    simpl plus; rewrite exp_cons, IHv.
    replace (n+S i) with (S (n+i)) by lia; ring.
Qed.

Local Notation divides_mult_inv := prime_div_mult.

Lemma not_prime_1 : ~ prime 1.
Proof. intros [ [] ]; auto. Qed.

Lemma not_ps_1 n : ~ ps n = 1.
Proof.
  intros H; generalize (str_prime ps n).
  rewrite H; apply not_prime_1.
Qed.

Lemma not_qs_1 n : ~ qs n = 1.
Proof.
  intros H; generalize (str_prime qs n).
  rewrite H; apply not_prime_1.
Qed.

#[export] Hint Resolve not_prime_1 not_qs_1 : core.

Lemma divides_pow p n k : prime p -> divides p (n ^ k) -> divides p n.
Proof.
  induction k.
  - cbn; intros H H0 % divides_1_inv; subst; exfalso; revert H; apply not_prime_1.
  - cbn; intros ? [ | ] % divides_mult_inv; eauto.
Qed.

Opaque ps qs.

Lemma ps_exp n m (v : vec nat m) i : ~ divides (ps n) (exp i v).
Proof.
  revert i; induction v as [ | m x v IHv ]; intros i; simpl.
  - intros H % divides_1_inv; revert H; apply not_ps_1.
  - intros [H % divides_pow | ] % divides_mult_inv; eauto.
    + now eapply ps_qs_div in H.
    + eapply IHv; eauto.
Qed.

Coercion tonat {n} := @pos2nat n.

Lemma vec_prod_div m (v : vec nat m) (u0 : nat) (p : pos m) i :
    vec_pos v p = S u0 -> qs (p + i) * exp i (vec_change v p u0) = exp i v.
Proof.
  revert p i; induction v; intros p i; analyse pos p; simpl; intros H.
  - rewrite pos2nat_fst; subst; simpl; ring.
  - rewrite pos2nat_nxt; simpl.
    rewrite <- IHv with (1 := H).
    unfold tonat.
    replace (S (pos2nat p + i)) with (pos2nat p+S i); ring.
Qed.

Lemma qs_exp_div i j n v : i < j -> ~ divides (qs i) (@exp n j v).
Proof with eauto.
  revert i j; induction v; intros i j Hi.
  + cbn; intros ? % divides_1_inv % not_qs_1; auto.
  + cbn; intros [ H % divides_pow | H  ] % divides_mult_inv; eauto.
    * eapply primestream_divides in H; lia.
    * eapply IHv in H; eauto.
Qed.

Lemma qs_shift n m j k (v : vec nat k) :
  divides (qs n) (exp j v) <-> divides (qs (m + n)) (exp (m + j) v).
Proof.
  revert m n j; induction v as [ | x k v IHv ]; intros m n j.
  - cbn; split; intros ? % divides_1_inv % not_qs_1; tauto.
  - cbn. split.
    + intros [ | ] % divides_mult_inv; auto.
      * destruct x.
        -- cbn in H; revert H.
           intros ? % divides_1_inv % not_qs_1; tauto.
        -- eapply divides_pow in H; auto.
           eapply primestream_divides in H as ->.
           cbn; do 2 apply divides_mult_r; apply divides_refl.
      * eapply divides_mult.
        rewrite IHv with (m := m) in H.
        rewrite <- plus_n_Sm in H; auto.
    + intros [ | ] % divides_mult_inv; auto.
      * destruct x.
        -- cbn in H; revert H.
           intros ? % divides_1_inv % not_qs_1; tauto.
        -- eapply divides_pow in H; auto.
           eapply primestream_divides in H.
           assert (n = j) by lia. subst.
           cbn; do 2 apply divides_mult_r; apply divides_refl.
      * eapply divides_mult. replace (S (m + j)) with (m + S j) in H by lia.
        rewrite <- IHv in H. eauto.
Qed.

Lemma vec_prod_mult m v (u : pos m) i : @exp m i (vec_change v u (1 + vec_pos v u)) = qs (u + i) * exp i v.
Proof.
  revert i; induction v; analyse pos u; intros.
  + rewrite pos2nat_fst; simpl; ring.
  + rewrite pos2nat_nxt; simpl; rewrite IHv.
    unfold tonat.
    replace (pos2nat u+S i) with (S (pos2nat u+i)) by lia; ring.
Qed.

Lemma inv_exp q p1 p2 x y :
         q <> 0
      -> ~ divides q p1
      -> ~ divides q p2
      -> q ^ x * p1 = q ^ y * p2
      -> x = y.
Proof.
  intros H1 H2 H3 H4.
  apply power_factor_uniq in H4; tauto.
Qed.

Lemma exp_inj n i v1 v2 :
  @exp n i v1 = exp i v2 -> v1 = v2.
Proof.
  revert i v2; induction v1 as [ | x n v1 IH ]; intros i v2.
  + vec nil v2; auto.
  + vec split v2 with y.
    simpl; intros H.
    assert (forall v, ~ divides (qs i) (@exp n (S i) v)) as G.
    { intros v; apply qs_exp_div; auto. }
    apply power_factor_uniq in H; auto.
    destruct H; f_equal; subst; eauto.
Qed.

Lemma exp_inv_inc n u v1 :
  @exp n 0 (vec_change v1 u (S (vec_pos v1 u))) = qs u * exp 0 v1.
Proof.
  enough (forall i, exp i (vec_change v1 u (S (vec_pos v1 u))) = qs (i + u) * exp i v1). eapply H.
  induction v1 as [ | n x v1 IHv1 ]; analyse pos u; intros.
  + rewrite pos2nat_fst, Nat.add_0_r; cbn; ring.
  + intros; rewrite pos2nat_nxt; simpl; rewrite IHv1; unfold tonat.
    replace (S i+pos2nat u) with (i+S (pos2nat u)) by lia; ring.
Qed.


Require Import nat.
Require Import syntax.

Inductive aevalR:aexp -> nat -> Prop :=
| E_ANum : forall (n:nat), aevalR (ANum n) n
| E_APlus: forall (n1 n2:nat) (a1 a2:aexp),
    aevalR a1 n1 -> aevalR a2 n2 -> aevalR (APlus a1 a2) (n1 + n2)
| E_AMinus: forall (n1 n2:nat) (a1 a2:aexp),
    aevalR a1 n1 -> aevalR a2 n2 -> aevalR (AMinus a1 a2) (n1 - n2)
| E_AMult: forall (n1 n2:nat) (a1 a2:aexp),
    aevalR a1 n1 -> aevalR a2 n2 -> aevalR (AMult a1 a2) (n1 * n2)
.

Notation "e \\ n" := (aevalR e n) (at level 50, no associativity) : type_scope.


Require Import Basic.
Require Import Full.
Require Import ZArith.
Require Import EqDec.

Export ZArith.

Open Scope Z.

Class Integer `{Basic} := {
  Int : Type;
  denotationInt :> Denotation Int Z;
  fullInt :> Full Int;

  fromZ : Z -> Int;
  plus : Int -> Int -> Int;
  minus : Int -> Int -> Int;
  equal : Int -> Int -> bool;
  le : Int -> Int -> bool;

  denoteFromZOk z : ⟦fromZ z⟧ = z;
  denotePlusOk n m : ⟦plus n m⟧ = ⟦n⟧ + ⟦m⟧;
  denoteMinusOk n m : ⟦minus n m⟧ = ⟦n⟧ - ⟦m⟧;
  denoteEqualOk n m : equal n m = (⟦ n ⟧ =? ⟦ m ⟧);
  denoteLeOk n m : le n m = (⟦ n ⟧ <=? ⟦ m ⟧);
  denoteInjective n m : ⟦n⟧ = ⟦m⟧ -> n = m
}.

Section Integer.
  Context `{Integer}.

  Definition mone : Int := fromZ (-1).
  Definition zero := fromZ 0.
  Definition one  := fromZ 1.

  Lemma denoteMoneOk : ⟦mone⟧ = -1.
    apply denoteFromZOk.
  Qed.

  Lemma denoteZeroOk : ⟦zero⟧ = 0.
    apply denoteFromZOk.
  Qed.

  Lemma denoteOneOk : ⟦one⟧ = 1.
    apply denoteFromZOk.
  Qed.
End Integer.

Section Definitions.
  Context `{Basic}.
  Context `{Integer}.

  Global Instance eqDecInteger : eqDec Int := {|
    eqDecide := _
  |}.
    intros n m.
    destruct (equal n m) eqn:eq.
    - left.
      rewrite denoteEqualOk in eq.
      rewrite Z.eqb_eq in eq.
      apply denoteInjective.
      assumption.
    - right.
      rewrite denoteEqualOk in eq.
      rewrite Z.eqb_neq in eq.
      congruence.
  Defined.

  Fixpoint natToInt (n:nat) : Int :=
    match n with
    | O => zero
    | S n => plus one (natToInt n)
    end.

  Definition lt (n m:Int) : bool :=
    andb (le n m) (negb (equal n m)).

  Lemma denoteLtOk n m : lt n m = (⟦ n ⟧ <? ⟦ m ⟧).
  Proof.
    unfold lt.
    rewrite denoteLeOk.
    apply Bool.eq_true_iff_eq.
    rewrite Bool.andb_true_iff, Bool.negb_true_iff.
    rewrite denoteEqualOk.
    rewrite Z.leb_le, Z.eqb_neq, Z.ltb_lt.
    omega.
  Qed.

  Lemma fromZInv : forall (i : Int), fromZ ⟦ i ⟧ = i.
    intros.
    apply denoteInjective.
    now rewrite denoteFromZOk.
  Qed.

  (* { v | n <= v < m } *)
  Definition range (n m:Int) : Space Int.
    refine (bind full (fun v : Int => _)).
    refine (if (andb (le n v) (lt v m))
            then single v else empty).
  Defined.
End Definitions.


From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat div.

(*****************************************************************************)
(*                                                                           *)
(*  This is the proof script associated with the tutorial                    *)
(*                                                                           *)
(*      An Ssreflect Tutorial                                                *)
(*      Georges Gonthier Stéphane Le Roux                                    *)
(*                                                                           *)
(*      https://hal.inria.fr/inria-00407778                                  *)
(*                                                                           *)
(*****************************************************************************)

(*****************************************************************************)
(*                                                                           *)
(*      Hilbert's axiom S                                                    *)
(*                                                                           *)
(*****************************************************************************)

Section HilbertSaxiom.

Variables A B C : Prop.

Lemma HilbertS : (A -> B -> C) -> (A -> B) -> A -> C.
Proof.
move=> hAiBiC hAiB hA.
move: hAiBiC.
apply.
  by [].
by apply: hAiB.
Qed.

Hypotheses (hAiBiC : A -> B -> C) (hAiB : A -> B) (hA : A).

Lemma HilbertS2 : C.
Proof.
apply: hAiBiC; first by apply: hA.
exact: hAiB.
Qed.

Lemma HilbertS3 : C.
Proof. by apply: hAiBiC; last exact: hAiB. Qed.

Check (hAiB hA).

Lemma HilbertS4 : C.
Proof. exact:  (hAiBiC _ (hAiB _)). Qed.

Lemma HilbertS5 : C.
Proof. exact: hAiBiC (hAiB _). Qed.

Lemma HilbertS6 : C.
Proof. exact: HilbertS5. Qed.

Print HilbertS5.

Print HilbertS2.

Print HilbertS.

Check HilbertS.

End HilbertSaxiom.

Print HilbertS5.

(*****************************************************************************)
(*                                                                           *)
(*      Logical connectives                                                  *)
(*                                                                           *)
(*****************************************************************************)

Print bool.

Section Symmetric_Conjunction_Disjunction.

Lemma andb_sym : forall A B : bool, A && B -> B && A.
Proof.
case.
  by case.
by [].
Qed.

Lemma andb_sym2 : forall A B : bool, A && B -> B && A.
Proof. by case; case. Qed.

Lemma andb_sym3 : forall A B : bool, A && B -> B && A.
Proof. by do 2! case. Qed.

Variables (C D : Prop) (hC : C) (hD : D).

Check (and C D).

Print and.

Check conj.

Check (conj hC hD).

Lemma and_sym : forall A B : Prop, A /\ B -> B /\ A.
Proof. by move=> A1 B []. Qed.

Check or.

Check or_introl.

Lemma or_sym : forall A B : Prop, A \/ B -> B \/ A.
Proof. by move=> A B [hA | hB]; [apply: or_intror | apply: or_introl]. Qed.

Lemma or_sym2 : forall A B : bool, A \/ B -> B \/ A.
Proof. by move=> [] [] AorB; apply/orP; move/orP : AorB. Qed.

End Symmetric_Conjunction_Disjunction.

Section R_sym_trans.

Variables (D : Type) (R : D -> D -> Prop).

Hypothesis R_sym : forall x y, R x y -> R y x.

Hypothesis R_trans : forall x y z, R x y -> R y z -> R x z.

Lemma refl_if : forall x : D, (exists y, R x y) -> R x x.
Proof.
move=> x [y Rxy].
by apply: R_trans _ (R_sym _ y _).
Qed.

End R_sym_trans.

Section Smullyan_drinker.

Variables (D : Type)(P : D -> Prop).

Hypothesis (d : D) (EM : forall A, A \/ ~A).

Lemma drinker : exists x, P x -> forall y, P y.
Proof.
case: (EM (exists y, ~P y)) => [[y notPy]| nonotPy]; first by exists y.
exists d => _ y; case: (EM (P y)) => // notPy.
by case: nonotPy; exists y.
Qed.

End Smullyan_drinker.

Section Equality.

Variable f : nat -> nat.
Hypothesis f00 : f 0 = 0.

Lemma fkk : forall k, k = 0 -> f k = k.
Proof.
move=> k k0.
by rewrite k0.
Qed.

Lemma fkk2 : forall k, k = 0 -> f k = k.
Proof. by move=> k ->. Qed.

Variable f10 : f 1 = f 0.

Lemma ff10 : f (f 1) = 0.
Proof. by rewrite f10 f00. Qed.

Variables (D : eqType) (x y : D).

Lemma eq_prop_bool : x = y -> x == y.
Proof. by move/eqP. Qed.

Lemma eq_bool_prop : x == y -> x = y.
Proof. by move/eqP. Qed.

End Equality.

Section Using_Definition.

Variable U : Type.

Definition set := U -> Prop.

Definition subset (A B : set) := forall x, A x -> B x.

Definition transitive (T : Type) (R : T -> T -> Prop) :=
 forall x y z, R x y -> R y z -> R x z.

Lemma subset_trans : transitive set subset.
Proof.
rewrite /transitive /subset => x y z subxy subyz t xt.
by apply: subyz; apply: subxy.
Qed.

Lemma subset_trans2 : transitive set subset.
Proof.
move=> x y z subxy subyz t.
by move/subxy; move/subyz.
Qed.

End Using_Definition.

(*****************************************************************************)
(*                                                                           *)
(*     Arithmetic for Euclidean division                                     *)
(*                                                                           *)
(*****************************************************************************)

Section Arithmetic.

Check nat.

Print nat.

Lemma three : S (S (S O)) = 3 /\ 2 = 0.+1.+1.
Proof. by []. Qed.

Print plus.

Lemma concrete_plus : plus 16 64 = 80.
Proof. (* simpl. *) by []. Qed.

Lemma concrete_plus_bis : 16 + 64 = 80.
Proof. (* simpl. *)  by []. Qed.

Print mult.

Print le.

Lemma concrete_le : le 1 3.
Proof.
by apply: (PeanoNat.Nat.le_trans _ 2); apply: PeanoNat.Nat.le_succ_diag_r.
Qed.

Lemma concrete_big_le : le 16 64.
Proof. by auto 50. Qed.

Print leq.

Print subn.

Print subn_rec.

Lemma concrete_big_leq : 0 <= 51.
Proof. by []. Qed.

Lemma semi_concrete_leq : forall n m, n <= m -> 51 + n <= 51 + m.
Proof. by []. Qed.

Lemma concrete_arith : (50 < 100) && (3 + 4 < 3 * 4 <= 17 - 2).
Proof. by []. Qed.

Print nat_ind.

Lemma plus_commute : forall n1 m1, n1 + m1 = m1 + n1.
Proof.
elim=> [m1 | n1 IHn1 m1].
  by elim: m1 => // m1 IHm1; rewrite -[0 + m1.+1]/(0 + m1).+1 IHm1.
rewrite -[n1.+1 + m1]/(n1 + m1).+1 IHn1.
by elim: m1 => // m1 IHm1; rewrite -[m1.+1 + n1]/(m1 + n1).+1 IHm1.
Qed.

Check edivn_rec.

Print edivn_rec.

Print edivn.

Print edivn_spec.

Lemma edivnP : forall m d, edivn_spec m d (edivn m d).
Proof.
rewrite /edivn => m [|d] //=; rewrite -{1}[m]/(0 * d.+1 + m).
elim: m {-2}m 0 (leqnn m) => [|n IHn] [|m] q //=; rewrite ltnS => le_mn.
rewrite subn_if_gt; case: ltnP => [// | le_dm].
rewrite -{1}(subnK le_dm) [_ + d]addnC -addSn addnA -mulSnr; apply: IHn.
apply: leq_trans le_mn; exact: leq_subr.
Qed.

Check nat_ind.

Check ltnP.

Print ltn_xor_geq.

Lemma edivn_eq : forall d q r, r < d -> edivn (q * d + r) d = (q, r).
Proof.
move=> d q r lt_rd; have d_pos: 0 < d by exact: leq_trans lt_rd.
case: edivnP lt_rd => q' r'; rewrite d_pos /=.
wlog: q q' r r' / q <= q' by case (ltnP q q'); last symmetry; eauto.
rewrite leq_eqVlt; case: eqP => [-> _|_] /=; first by move/addnI->.
rewrite -(leq_pmul2r d_pos); move/leq_add=> Hqr Eqr _; move/Hqr {Hqr}.
by rewrite addnS ltnNge mulSn -addnA Eqr addnCA addnA leq_addr.
Qed.

(*****************************************************************************)
(*                                                                           *)
(*      Parametric type families and alternative specifications              *)
(*                                                                           *)
(*****************************************************************************)

Check edivn_spec.

Print edivn_spec.

CoInductive edivn_spec_right : nat -> nat -> nat * nat -> Type :=
  EdivnSpec_right m d q r of m = q * d + r & (d > 0) ==> (r < d) :
  edivn_spec_right m d (q, r).

CoInductive edivn_spec_left (m d : nat)(qr : nat * nat) : Type :=
EdivnSpec_left of m = (fst qr) * d + (snd qr) & (d > 0) ==> (snd qr < d) :
   edivn_spec_left m d qr.

Lemma edivnP_right : forall m d, edivn_spec_right m d (edivn m d).
Admitted.

Lemma edivnP_left : forall m d, edivn_spec_left m d (edivn m d).
Admitted.

Lemma edivn_eq_right : forall d q r, r < d -> edivn (q * d + r) d = (q, r).
Proof.
move=> d q r lt_rd; have d_pos: 0 < d by exact: leq_trans lt_rd.
set m := q * d + r; have: m = q * d + r by [].
set d' := d; have: d' = d by [].
case: (edivnP_right m d') => {d'}m d' q' r' -> lt_r'd' d'd q'd'r'.
move: q'd'r' lt_r'd' lt_rd; rewrite d'd d_pos {d'd m} /=.
wlog: q q' r r' / q <= q' by case (ltnP q q'); last symmetry; eauto.
rewrite leq_eqVlt; case: eqP => [-> _|_] /=; first by move/addnI->.
rewrite -(leq_pmul2r d_pos); move/leq_add=> Hqr Eqr _; move/Hqr {Hqr}.
by rewrite addnS ltnNge mulSn -addnA -Eqr addnCA addnA leq_addr.
Qed.

Lemma edivn_eq_left : forall d q r, r < d -> edivn (q * d + r) d = (q, r).
Proof.
move=> d q r lt_rd; have d_pos: 0 < d by exact: leq_trans lt_rd.
case: (edivnP_left (q * d + r) d) lt_rd; rewrite d_pos /=.
set q':= (edivn (q * d + r) d).1; set r':= (edivn (q * d + r) d).2.
rewrite (surjective_pairing (edivn (q * d + r) d)) -/q' -/r'.
wlog: q r q' r' / q <= q' by case (ltnP q q'); last symmetry; eauto.
rewrite leq_eqVlt; case: eqP => [-> _|_] /=; first by move/addnI->.
rewrite -(leq_pmul2r d_pos); move/leq_add=> Hqr Eqr _; move/Hqr {Hqr}.
by rewrite addnS ltnNge mulSn -addnA Eqr addnCA addnA leq_addr.
Qed.

End Arithmetic.


Goal forall x : nat, 1 * x = x.
intros.
simpl.
elim x.
reflexivity.
intros.
simpl.
rewrite H.
reflexivity.

Fixpoint f (n : nat) {struct n} : nat :=
match n with
0 => 1
| S(n) =>2 * f(n)
end.

Lemma fdix :
(f 10)=1024.
simpl.
reflexivity.

Print list.
Open Scope list.
Check (0 :: 1 :: nil).

Require Export List.

Lemma rev_proof:
forall E : Type, forall l : (list E), forall a : E, rev (l ++ a::nil)=a ::rev l.
intros.
elim l.
simpl.
reflexivity.
intros.
simpl.
rewrite H.
simpl.
reflexivity.
Qed.

(*Lemma list_identity :
Goal forall (E : Type) (l : list E), l ++ nil = l.
intros.
elim l.
reflexivity.
intros.
simpl.
rewrite H.
reflexivity.
Qed.
*)

Lemma rev_consistence :
forall E : Type, forall l : (list E), rev(rev l) = l.
intros.
elim l.
reflexivity.
intros.
simpl.
rewrite rev_proof.
rewrite H.
reflexivity.

Lemma my_eq_nat_dec :
forall n m : nat, {n = m} + {n <> m}.
decide equality.
(*No idea how to do that*)

Inductive binary_tree ( A : Type ) : Type


Variable a:Set.
Variable Q:Prop -> Prop.

Lemma L1 : (forall (x:a) (p:Prop), Q p) <-> forall (p:a -> Prop) (x:a), Q (p x).
Proof.
    split.
    - intros H p x. apply H. assumption.
    - intros H x p.  apply (H (fun x => p)). assumption.
Qed.

Lemma L2 : (forall (x y:a) (p:Prop), Q p) <-> forall (p:a -> a -> Prop) (x y:a), Q (p x y).
Proof.
    split.
    - intros H p x y. apply H; assumption.
    - intros H x y p. apply (H (fun x y => p)); assumption.
Qed.

Lemma L3 : (forall (x:a), False) -> False.
Proof.
    intros H.

Abort. (* Cannot be proven *)

(* However *)
Lemma L4 : forall (y:a), (forall (x:a), False) -> False.
Proof.
    intros y H. apply H. assumption.
Qed.


Require Export D.

(** 2 stars (gorgeous_sum)  *)

Lemma plus_assoc: forall a b c,
  (a + b) + c = a + (b + c).
Proof. intros. induction a.
  Case "a = 0". reflexivity.
  Case "a = S a". simpl. rewrite -> IHa. reflexivity. Qed.

Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
  intros n m Hn Hm. induction Hn.
  Case "n = 0". simpl. apply Hm.
  Case "n = 3 + n0". rewrite -> plus_assoc. apply g_plus3. apply IHHn.
  Case "n = 5 + n0". rewrite -> plus_assoc. apply g_plus5. apply IHHn.
  Qed.