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

(* ** Euclidian division and Bezout's identity *)

Require Import List Arith Lia Permutation Extraction.

From Undecidability.Shared.Libs.DLW.Utils
  Require Import utils_tac utils_list.

Set Implicit Arguments.

Section Euclid.

  (* Simultaneous comparison and difference *)

  Fixpoint cmp_sub x y : { z | z+y = x } + { x < y }.
  Proof.
    refine (match y as y' return { z | z+y' = x } + { x < y' } with
      | 0    => inleft (exist _ x _)
      | S y' => match x as x' return { z | z+_ = x' } + { x' < _ } with
        | 0    => inright _
        | S x' => match cmp_sub x' y' with
          | inleft (exist _ z Hz) => inleft (exist _ z _)
          | inright H => inright _
        end
      end
    end); abstract lia.
  Defined.

  Definition euclid n d : d <> 0 -> { q : nat & { r | n = q*d+r /\ r < d } }.
  Proof.
    intros Hd; induction on n as euclid with measure n.
    refine (match cmp_sub n d with
      | inleft (exist _ z Hz) =>
      match euclid z _ with
        | existT _ q (exist _ r Hr) => existT _ (S q) (exist _ r _)
      end
      | inright H      => existT _ 0 (exist _ n _)
    end); abstract (simpl; lia).
  Defined.

End Euclid.

Definition arem n d q j := j <= d /\ (n = 2*q*d+j \/ q <> 0 /\ n = 2*q*d-j).

Fact division_by_even n d : d <> 0 -> { q : nat & { j | arem n d q j } }.
Proof.
  intros Hd.
  destruct (@euclid n (2*d)) as (q & r & H1 & H2); try lia.
  destruct (le_lt_dec r d) as [ Hr | Hr ].
  + exists q, r; split; auto; left.
    rewrite H1; ring.
  + exists (S q), (2*d-r); split; lia.
Qed.

Fact own_multiple x p : x = p*x -> x = 0 \/ p = 1.
Proof.
  destruct x as [ | x ].
  + left; trivial.
  + right.
    destruct p as [ | [ | p ] ].
    - simpl in H; discriminate.
    - trivial.
    - exfalso; revert H.
      do 2 (rewrite Nat.mul_comm; simpl).
      generalize (p*x); intros; lia.
Qed.

Fact mult_is_one p q : p*q = 1 -> p = 1 /\ q = 1.
Proof.
  destruct p as [ | [ | p ] ].
  + simpl; discriminate.
  + simpl; lia.
  + rewrite Nat.mul_comm.
    destruct q as [ | [ | q ] ].
    - simpl; discriminate.
    - simpl; lia.
    - simpl; discriminate.
Qed.

Definition divides n k := exists p, k = p*n.

Section divides.

  Infix "div" := divides (at level 70, no associativity).

  Fact divides_refl x : x div x.
  Proof. exists 1; simpl; lia. Qed.

  Fact divides_anti x y : x div y -> y div x -> x = y.
  Proof.
    intros (p & H1) (q & H2).
    rewrite H1, Nat.mul_assoc in H2.
    apply own_multiple in H2.
    destruct H2 as [ H2 | H2 ].
    + subst; rewrite Nat.mul_comm; auto.
    + apply mult_is_one in H2; destruct H2; subst; lia.
  Qed.

  Fact divides_trans x y z : x div y -> y div z -> x div z.
  Proof.
    intros (p & H1) (q & H2).
    exists (q*p); rewrite <- Nat.mul_assoc, <- H1; auto.
  Qed.

  Fact divides_0 p : p div 0.
  Proof. exists 0; auto. Qed.

  Fact divides_0_inv p : 0 div p -> p = 0.
  Proof. intros (?&?); subst; rewrite Nat.mul_0_r; auto. Qed.

  Fact divides_1 p : 1 div p.
  Proof. exists p; rewrite Nat.mul_comm; simpl; auto. Qed.

  Fact divides_1_inv p : p div 1 -> p = 1.
  Proof.
    intros (q & Hq).
    apply mult_is_one with q; auto.
  Qed.

  Fact divides_2_inv p : p div 2 -> p = 1 \/ p = 2.
  Proof.
    intros ([ | k ] & Hk); try discriminate.
    destruct p as [ | [ | [|] ] ]; lia.
  Qed.

  Fact divides_mult p q k : p div q -> p div k*q.
  Proof.
    intros (r & ?); subst.
    exists (k*r); rewrite Nat.mul_assoc; auto.
  Qed.

  Fact divides_mult_r p q k : p div q -> p div q*k.
  Proof.
    rewrite Nat.mul_comm; apply divides_mult; auto.
  Qed.

  Fact divides_left x k : divides x (x*k).
  Proof.
    apply divides_mult_r, divides_refl.
  Qed.

  Fact divides_mult_compat a b c d : a div b -> c div d -> a*c div b*d.
  Proof.
    intros (u & ?) (v & ?); exists (u*v); subst.
    repeat rewrite Nat.mul_assoc; f_equal.
    repeat rewrite <- Nat.mul_assoc; f_equal.
    apply Nat.mul_comm.
  Qed.

  Fact divides_minus p q1 q2 : p div q1 -> p div q2 -> p div q1 - q2.
  Proof.
    intros (s1 & H1) (s2 & H2).
    exists (s1 - s2).
    rewrite Nat.mul_sub_distr_r; lia.
  Qed.

  Fact divides_plus p q1 q2 : p div q1 -> p div q2 -> p div q1+q2.
  Proof.
    intros (s1 & H1) (s2 & H2).
    exists (s1 + s2).
    rewrite Nat.mul_add_distr_r; lia.
  Qed.

  Fact divides_plus_inv p q1 q2 : p div q1 -> p div q1+q2 -> p div q2.
  Proof.
     intros H1 H2.
     replace q2 with (q1+q2-q1) by lia.
     apply divides_minus; auto.
  Qed.

  Fact divides_le p q : q <> 0 -> p div q -> p <= q.
  Proof.
    intros ? ([] & ?); subst; lia.
  Qed.

  Fact divides_mult_inv k p q : k <> 0 -> k*p div k*q -> p div q.
  Proof.
    intros H (n & Hn); exists n.
    apply Nat.mul_cancel_r with (1 := H).
    rewrite Nat.mul_comm, Hn; ring.
  Qed.

  Lemma divides_fact m p : 1 < p <= m -> p div fact m.
  Proof.
    intros (H1 & H2); induction H2.
    + destruct p; cbn. lia. unfold divides. exists (fact p). ring.
    + cbn. eauto using divides_plus, divides_mult.
  Qed.

  Lemma divides_mult_inv_l p q r : p * q div r -> p div r /\ q div r.
  Proof.
    intros []; split; subst.
    - exists (x * q); ring.
    - exists (x * p); ring.
  Qed.

End divides.

Section gcd_lcm.

  Infix "div" := divides (at level 70, no associativity).

  Hint Resolve divides_0 divides_refl divides_mult divides_1 : core.

  Definition is_gcd p q r := r div p /\ r div q /\ forall k, k div p -> k div q -> k div r.
  Definition is_lcm p q r := p div r /\ q div r /\ forall k, p div k -> q div k -> r div k.

  Fact is_gcd_sym p q r : is_gcd p q r -> is_gcd q p r.
  Proof. intros (? & ? & ?); repeat split; auto. Qed.

  Fact is_gcd_0l p : is_gcd 0 p p.
  Proof. repeat split; auto. Qed.

  Fact is_gcd_0r p : is_gcd p 0 p.
  Proof. repeat split; auto. Qed.

  Fact is_gcd_1l p : is_gcd 1 p 1.
  Proof. repeat split; auto. Qed.

  Fact is_gcd_1r p : is_gcd p 1 1.
  Proof. repeat split; auto. Qed.

  Fact is_gcd_modulus p q k r : p div k -> k <= q -> is_gcd p q r -> is_gcd p (q-k) r.
  Proof.
    intros (n & Hn) Hq (H1 & H2 & H3); subst.
    split; auto.
    split.
    + apply divides_minus; auto.
    + intros k H4 H5.
      apply H3; auto.
      replace q with (q - n*p + n*p) by lia.
      apply divides_plus; auto.
  Qed.

  Fact is_gcd_minus p q r : p <= q -> is_gcd p q r -> is_gcd p (q-p) r.
  Proof. intros H1; apply is_gcd_modulus; auto. Qed.

  Hint Resolve divides_plus : core.

  Fact is_gcd_moduplus p q k r : p div k -> is_gcd p q r -> is_gcd p (q+k) r.
  Proof.
    intros (n & Hn) (H1 & H2 & H3); subst.
    repeat (split; auto).
    intros k H4 H5.
    apply H3; auto.
    rewrite Nat.add_comm in H5.
    apply divides_plus_inv with (2 := H5); auto.
  Qed.

  Fact is_gcd_plus p q r : is_gcd p q r -> is_gcd p (q+p) r.
  Proof. apply is_gcd_moduplus; auto. Qed.

  Fact is_gcd_mult p q r n : is_gcd p (n*p+q) r <-> is_gcd p q r.
  Proof.
    split.
    + replace q with ((n*p+q)-n*p) at 2 by lia.
      apply is_gcd_modulus; auto; lia.
    + rewrite Nat.add_comm; apply is_gcd_moduplus; auto.
  Qed.

  Fact is_gcd_div p q : p div q -> is_gcd p q p.
  Proof. intros (?&?); subst; split; auto. Qed.

  Fact is_gcd_refl p : is_gcd p p p.
  Proof. split; auto. Qed.

  Fact is_gcd_fun p q r1 r2 : is_gcd p q r1 -> is_gcd p q r2 -> r1 = r2.
  Proof. intros (?&?&?) (?&?&?); apply divides_anti; auto. Qed.

  Fact is_lcm_0l p : is_lcm 0 p 0.
  Proof. repeat split; auto. Qed.

  Fact is_lcm_0r p : is_lcm p 0 0.
  Proof. repeat split; auto. Qed.

  Fact is_lcm_sym p q r : is_lcm p q r -> is_lcm q p r.
  Proof. intros (?&?&?); repeat split; auto. Qed.

  Fact is_lcm_fun p q r1 r2 : is_lcm p q r1 -> is_lcm p q r2 -> r1 = r2.
  Proof. intros (?&?&?) (?&?&?); apply divides_anti; auto. Qed.

End gcd_lcm.

Section bezout.

  Infix "div" := divides (at level 70, no associativity).

  Hint Resolve is_gcd_0l is_gcd_0r is_lcm_0l is_lcm_0r divides_refl divides_mult divides_0 is_gcd_minus : core.

  Section bezout_rel_prime.

    (* A Bezout procedure with better extraction *)

    Definition bezout_rel_prime_lt p q :
            0 < p < q
         -> is_gcd p q 1
         -> { a : nat & { b | a*p+b*q = 1+p*q
                           /\ a <= q
                           /\ b <= p } }.
    Proof.
      induction on p q as bezout with measure q; intros (Hp & Hq) H.
      refine (match @euclid q p _ with
        | existT _ n (exist _ r H0) =>
        match eq_nat_dec r 0 with
          | left Hr => existT _ 1 (exist _ 1 _)
          | right Hr => match @bezout r p Hq _ _ with
            | existT _ a (exist _ b G0) =>
               existT _ (b+n*p-n*a) (exist _ a _)
          end
        end
      end); try lia.
      + destruct H0 as (H1 & H2).
        subst r; rewrite Nat.add_comm in H1; simpl in H1.
        assert (is_gcd p q p) as H3.
        { apply is_gcd_div; subst; auto. }
        rewrite (is_gcd_fun H3 H) in *.
        simpl; lia.
      + replace r with (q-n*p) by lia.
        apply is_gcd_sym, is_gcd_modulus; auto; lia.
      + destruct H0 as (H1 & H2).
        destruct G0 as (H3 & H4 & H5).
        split; [ | split ]; auto.
        * rewrite H1, Nat.mul_sub_distr_r, (Nat.mul_comm _ p).
          do 3 rewrite Nat.mul_add_distr_l.
          rewrite (Nat.add_comm _ (p*r)), (Nat.add_assoc 1), (Nat.mul_comm p r), <- H3.
          rewrite (Nat.mul_comm n a), (Nat.mul_comm p b), Nat.mul_assoc, Nat.mul_assoc.
          assert (a*n*p <= p*n*p) as H6.
          { repeat (apply Nat.mul_le_mono; auto). }
          revert H6; generalize (b*p) (a*r) (a*n*p) (p*n*p); intros; lia.
        * rewrite H1; generalize (n*p) (n*a); intros; lia.
    Defined.

    Definition bezout_rel_prime p q : is_gcd p q 1 -> { a : nat & { b | a*p+b*q = 1+p*q } }.
    Proof.
      intros H.
      destruct (eq_nat_dec p 0) as [ | Hp ].
      { subst; rewrite (is_gcd_fun (is_gcd_0l _) H); exists 0, 1; auto. }
      destruct (eq_nat_dec q 0) as [ | Hq ].
      { subst; rewrite (is_gcd_fun (is_gcd_0r _) H); exists 1, 0; auto. }
      destruct (lt_eq_lt_dec p q) as [ [ H1 | H1 ] | H1 ].
      + destruct bezout_rel_prime_lt with (2 := H)
          as (a & b & H2 & _); try lia.
        exists a, b; auto.
      + subst; rewrite (is_gcd_fun (is_gcd_refl _) H); exists 1, 1; auto.
      + destruct bezout_rel_prime_lt with (2 := is_gcd_sym H)
          as (a & b & H2 & _); try lia.
        exists b, a; rewrite (Nat.mul_comm p q); lia.
    Defined.

    Lemma bezout_nc p q : is_gcd p q 1 -> exists a b, a*p+b*q = 1+p*q.
    Proof.
      intros H.
      destruct bezout_rel_prime with (1 := H) as (a & b & ?).
      exists a, b; auto.
    Qed.

    Hint Resolve divides_1 : core.

    Lemma bezout_sc p q a b m : a*p+b*q = 1 + m -> p div m \/ q div m -> is_gcd p q 1.
    Proof.
      intros H1 H2; do 2 (split; auto).
      intros k H4 H5.
      apply divides_plus_inv with m.
      +  destruct H2 as [ H2 | H2 ];
         apply divides_trans with (2 := H2); auto.
      + rewrite Nat.add_comm, <- H1.
        apply divides_plus; auto.
    Qed.

  End bezout_rel_prime.

  (* We need the simple form of Bezout above to show this *)

  Fact is_rel_prime_div p q k : is_gcd p q 1 -> p div q*k -> p div k.
  Proof.
    intros H1 (u & H2); subst.
    destruct bezout_nc with (1 := H1) as (a & b & H3).
    replace k with (k*(1+p*q) - k*p*q).
    + apply divides_minus.
      - rewrite <- H3, Nat.mul_add_distr_l.
        apply divides_plus.
        * rewrite Nat.mul_assoc; auto.
        * rewrite (Nat.mul_comm b), Nat.mul_assoc, (Nat.mul_comm k), H2.
          rewrite Nat.mul_comm, Nat.mul_assoc; auto.
      - rewrite Nat.mul_comm, Nat.mul_assoc; auto.
    + rewrite Nat.mul_add_distr_l, Nat.mul_assoc.
      generalize (k*p*q); intros; lia.
  Qed.

  Fact is_rel_prime_div_r p q k : is_gcd p q 1 -> p div k*q -> p div k.
  Proof. rewrite Nat.mul_comm; apply is_rel_prime_div. Qed.

  Fact divides_is_gcd a b c : divides a b -> is_gcd b c 1 -> is_gcd a c 1.
  Proof.
    intros H1 H2; msplit 2; try apply divides_1.
    intros k H3 H4.
    apply H2; auto.
    apply divides_trans with a; auto.
  Qed.

  Fact is_rel_prime_lcm p q : is_gcd p q 1 -> is_lcm p q (p*q).
  Proof.
    intros H.
    repeat (split; auto).
    rewrite Nat.mul_comm; auto.
    intros k (u & ?) (v & ?); subst.
    rewrite (Nat.mul_comm u).
    apply divides_mult_compat; auto.
    apply is_gcd_sym in H.
    apply is_rel_prime_div with (1 := H) (k := u).
    rewrite Nat.mul_comm, H1; auto.
  Qed.

  Hint Resolve divides_1 divides_mult_compat is_gcd_refl : core.

  Fact is_gcd_0 p q : is_gcd p q 0 -> p = 0 /\ q = 0.
  Proof.
    intros ((a & Ha) & (b & Hb) & H).
    subst; do 2 rewrite Nat.mul_0_r; auto.
  Qed.

  Fact is_gcd_rel_prime p q g : is_gcd p q g -> exists a b, p = a*g /\ q = b*g /\ is_gcd a b 1.
  Proof.
    destruct (eq_nat_dec g 0) as [ H0 | H0 ].
    * intros H; subst.
      apply is_gcd_0 in H; destruct H; subst.
      exists 1, 1 ; simpl; auto.
    * intros ((a & Ha) & (b & Hb) & H).
      exists a, b; repeat (split; auto).
      intros k H1 H2.
      destruct (H (k*g)) as (d & Hd); subst.
      + do 2 rewrite (Nat.mul_comm _ g); auto.
      + do 2 rewrite (Nat.mul_comm _ g); auto.
      + rewrite Nat.mul_assoc in Hd.
        replace g with (1*g) in Hd at 1 by (simpl; lia).
        apply Nat.mul_cancel_r in Hd; auto.
        symmetry in Hd.
        apply mult_is_one in Hd.
        destruct Hd; subst; auto.
  Qed.

  Fact is_lcm_mult p q l k : is_lcm p q l -> is_lcm (k*p) (k*q) (k*l).
  Proof.
    intros (H1 & H2 & H3); repeat (split; auto).
    intros r (a & Ha) (b & Hb).
    destruct (eq_nat_dec k 0) as [ Hk | Hk ].
    + subst; simpl; auto.
    + assert (a*p = b*q) as H4.
      { rewrite <- Nat.mul_cancel_r with (1 := Hk).
        do 2 rewrite <- Nat.mul_assoc, (Nat.mul_comm _ k).
        rewrite <- Hb; auto. }
      rewrite Ha, Nat.mul_assoc, (Nat.mul_comm _ k), <- Nat.mul_assoc.
      apply divides_mult_compat; auto.
      apply H3; auto.
      rewrite H4; auto.
  Qed.

  Theorem is_gcd_lcm_mult p q g l : is_gcd p q g -> is_lcm p q l -> p*q = g*l.
  Proof.
    destruct (eq_nat_dec g 0) as [ H0 | H0 ]; intros H1.
    * subst; apply is_gcd_0 in H1.
      destruct H1; subst; simpl; auto.
    * destruct is_gcd_rel_prime with (1 := H1)
        as (u & v & Hu & Hv & H2).
      intros H3.
      rewrite Hu, Hv, (Nat.mul_comm u), <- Nat.mul_assoc; f_equal.
      rewrite (Nat.mul_comm u), (Nat.mul_comm v), <- Nat.mul_assoc, (Nat.mul_comm v).
      apply is_lcm_fun with (2 := H3).
      subst; rewrite (Nat.mul_comm u), (Nat.mul_comm v).
      apply is_lcm_mult, is_rel_prime_lcm; auto.
  Qed.

  Theorem is_gcd_mult_lcm p q g l : g <> 0 -> is_gcd p q g -> g*l = p*q -> is_lcm p q l.
  Proof.
    intros H0 H1 H2.
    destruct is_gcd_rel_prime with (1 := H1)
        as (u & v & Hu & Hv & H3).
    rewrite Hu, Hv, (Nat.mul_comm u), (Nat.mul_comm v).
    replace l with (g*(u*v)).
    + apply is_lcm_mult, is_rel_prime_lcm; auto.
    + rewrite <- Nat.mul_cancel_r with (1 := H0).
      rewrite (Nat.mul_comm l), H2, Hu, Hv,
              (Nat.mul_comm u g), Nat.mul_assoc, Nat.mul_assoc; auto.
  Qed.

  (*  if   1) p <= q
           2) p = u*g
           3) gcd p q = g
           4) lcm p q = l
      then A) gcd p (q-p) = g
           B) lcm p (q-p) = l-u*p *)

  Lemma is_lcm_minus p q g l u : p <= q -> p = u*g -> is_gcd p q g -> is_lcm p q l -> is_lcm p (q-p) (l-u*p).
  Proof.
    destruct (eq_nat_dec g 0) as [ H0 | H0 ].
    + intros _ _ H1 H2.
      subst; apply is_gcd_0 in H1.
      destruct H1; subst; simpl.
      rewrite Nat.mul_0_r, Nat.sub_0_r; auto.
    + intros H1 H2 H3 H4.
      apply is_gcd_mult_lcm with (1 := H0).
      * apply is_gcd_minus; auto.
      * do 2 rewrite Nat.mul_sub_distr_l.
        rewrite <- (is_gcd_lcm_mult H3 H4).
        f_equal.
        rewrite H2 at 2.
        rewrite Nat.mul_assoc, (Nat.mul_comm g); auto.
  Qed.

  (*  if   1) p <= q
           2) p = u*g
           3) gcd p q = g
           4) lcm p q = l
      then A) gcd p (q-k*p) = g
           B) lcm p (q-p) = l-k*u*p *)

  Lemma is_lcm_modulus k p q g l u : k*p <= q -> p = u*g -> is_gcd p q g -> is_lcm p q l -> is_lcm p (q-k*p) (l-k*u*p).
  Proof.
    rewrite <- Nat.mul_assoc.
    intros H1 H2 H3 H4. revert H1.
    induction k as [ | k IHk ]; intros H1.
    + simpl; do 2 rewrite Nat.sub_0_r; auto.
    + replace (q - S k*p) with (q -k*p -p) by (simpl; lia).
      replace (l - S k*(u*p)) with (l - k*(u*p) - u*p).
      - apply is_lcm_minus with (g := g); auto.
        * simpl in H1; lia.
        * apply is_gcd_modulus; auto.
          simpl in H1; lia.
        * apply IHk; simpl in H1; lia.
      - simpl; generalize (u*p) (k*(u*p)); intros; lia.
  Qed.

  (*  if   1) p <= q
           2) p = u*g
           3) gcd p q = g
           4) lcm p q = l
      then A) gcd p (q+p) = g
           B) lcm p (q+p) = l+u*p *)

  Lemma is_lcm_plus p q g l u : p = u*g -> is_gcd p q g -> is_lcm p q l -> is_lcm p (q+p) (l+u*p).
  Proof.
    destruct (eq_nat_dec g 0) as [ H0 | H0 ].
    + intros _ H1 H2.
      subst; apply is_gcd_0 in H1.
      destruct H1; subst; simpl.
      rewrite Nat.mul_0_r, Nat.add_0_r; auto.
    + intros H2 H3 H4.
      apply is_gcd_mult_lcm with (1 := H0).
      * apply is_gcd_plus; auto.
      * do 2 rewrite Nat.mul_add_distr_l.
        rewrite <- (is_gcd_lcm_mult H3 H4).
        f_equal.
        rewrite H2 at 2.
        rewrite Nat.mul_assoc, (Nat.mul_comm g); auto.
  Qed.

  Lemma is_lcm_moduplus k p q g l u : p = u*g -> is_gcd p q g -> is_lcm p q l -> is_lcm p (q+k*p) (l+k*u*p).
  Proof.
    rewrite <- Nat.mul_assoc.
    intros H2 H3 H4.
    induction k as [ | k IHk ].
    + simpl; do 2 rewrite Nat.add_0_r; auto.
    + replace (q + S k*p) with (q +k*p +p) by (simpl; lia).
      replace (l + S k*(u*p)) with (l + k*(u*p) + u*p) by (simpl; lia).
      apply is_lcm_plus with (g := g); auto.
      apply is_gcd_moduplus; auto.
  Qed.

  Section bezout_generalized.

    (* TODO, write this FULLY specified Bezout with a better extraction, following bezout_rel_prime above *)

    Definition bezout_generalized_lt p q :
                         0 < p < q
                      -> { a : nat
                       & { b : nat
                       & { g : nat
                       & { l : nat
                       & { u : nat
                       & { v : nat
                         | a*p+b*q = g + l
                        /\ is_gcd p q g
                        /\ is_lcm p q l
                        /\ p = u*g
                        /\ q = v*g
                        /\ a <= v
                        /\ b <= u } } } } } }.
    Proof.
      induction on p q as IH with measure q; intros (Hp & Hq).
      destruct (@euclid q p) as (k & r & H1 & H2); try lia.
      destruct (eq_nat_dec r 0) as [ Hr | Hr ].
      + exists 1, 1, p, (k*p), 1, k.
        rewrite Nat.add_comm in H1; simpl in H1.
        subst; repeat split; simpl; auto.
        destruct k; lia.
      + destruct (IH r _ Hq) as (a & b & g & l & u & v & H3 & H4 & H5 & H6 & H7 & H8 & H9); try lia.
        exists (b+k*v-k*a), a, g, (l+k*v*p), v, (k*v+u).
        apply is_gcd_sym in H4.
        apply is_lcm_sym in H5.
        rewrite Nat.add_comm in H1.
        assert (g <> 0) as Hg.
        { intro; subst g; apply is_gcd_0, proj1 in H4; lia. }
        split.
        { rewrite H1, Nat.add_assoc, Nat.mul_add_distr_l, <- H3.
          rewrite Nat.mul_sub_distr_r, Nat.mul_add_distr_r.
          rewrite Nat.mul_assoc, (Nat.mul_comm a k).
          assert (k*a*p <= k*v*p) as G.
          { repeat (apply Nat.mul_le_mono; auto). }
          revert G; generalize (b*p) (a*r) (k*a*p) (k*v*p); intros; lia. }
        split.
        { rewrite H1; apply is_gcd_moduplus; auto. }
        split.
        { rewrite H1; apply is_lcm_moduplus with g; auto. }
        split; auto.
        split.
        { rewrite H1, H6, H7, Nat.mul_add_distr_r, Nat.mul_assoc; lia. }
        split; auto.
        { rewrite (Nat.add_comm _ u), <- Nat.add_sub_assoc.
          +  apply Nat.add_le_mono; auto.
             generalize (k*v) (k*a); intros; lia.
          + apply Nat.mul_le_mono; auto. }
    Defined.

    Hint Resolve is_gcd_sym is_lcm_sym : core.

    Definition bezout_generalized p q : { a : nat
                                      & { b : nat
                                      & { g : nat
                                      & { l : nat
                                        | a*p+b*q = g + l
                                       /\ is_gcd p q g
                                       /\ is_lcm p q l } } } }.
    Proof.
      destruct (eq_nat_dec p 0) as [ | Hp ].
      { subst; exists 0, 1, q, 0; repeat (split; auto). }
      destruct (eq_nat_dec q 0) as [ | Hq ].
      { subst; exists 1, 0, p, 0; repeat (split; auto). }
      destruct (lt_eq_lt_dec p q) as [ [ H1 | H1 ] | H1 ].
      + destruct (@bezout_generalized_lt p q)
          as (a & b & g & l & _ & _ & ? & ? & ? & _); try lia.
        exists a, b, g, l; auto.
      + subst q; exists 1, 1, p, p.
        repeat split; auto; lia.
      + destruct (@bezout_generalized_lt q p)
          as (a & b & g & l & _ & _ & ? & ? & ? & _); try lia.
        exists b, a, g, l; repeat (split; auto); lia.
    Qed.

  End bezout_generalized.

  Section gcd_lcm.

    Let gcd_full p q : sig (is_gcd p q).
    Proof.
      destruct (bezout_generalized p q) as (_ & _ & g & _ & _ & ? & _).
      exists g; auto.
    Qed.

    Definition gcd p q := proj1_sig (gcd_full p q).
    Fact gcd_spec p q : is_gcd p q (gcd p q).
    Proof. apply (proj2_sig _). Qed.

    Let lcm_full p q : sig (is_lcm p q).
    Proof.
      destruct (bezout_generalized p q) as (_ & _ & _ & l & _ & _ & ?).
      exists l; auto.
    Qed.

    Definition lcm p q := proj1_sig (lcm_full p q).
    Fact lcm_spec p q : is_lcm p q (lcm p q).
    Proof. apply (proj2_sig _). Qed.

  End gcd_lcm.

End bezout.

Section division.

  Fact div_full q p : { n : nat & { r | q = n*p+r /\ (p <> 0 -> r < p) } }.
  Proof.
    case_eq p.
    + intro; exists 0, q; subst; split; auto; intros []; auto.
    + intros k H; destruct (@euclid q p) as (n & r & H1 & H2); try lia.
      exists n, r; rewrite <- H; split; auto.
  Qed.

  Definition div q p := projT1 (div_full q p).
  Definition rem q p := proj1_sig (projT2 (div_full q p)).

  Fact div_rem_spec1 q p : q = div q p * p + rem q p.
  Proof. apply (proj2_sig (projT2 (div_full q p))). Qed.

  Fact div_rem_spec2 q p : p <> 0 -> rem q p < p.
  Proof. apply (proj2_sig (projT2 (div_full q p))). Qed.

  Fact rem_0 q : rem q 0 = q.
  Proof.
    generalize (div_rem_spec1 q 0).
    rewrite Nat.mul_comm; auto.
  Qed.

  Fact div_rem_uniq p n1 r1 n2 r2 :
        p <> 0 -> n1*p + r1 = n2*p + r2 -> r1 < p -> r2 < p -> n1 = n2 /\ r1 = r2.
  Proof.
    intros H1 H2 H3 H4.
    assert (n1 = n2) as E.
    destruct (lt_eq_lt_dec n1 n2) as [ [ H | ] | H ]; auto.
    + replace n2 with (n2-n1 + n1) in H2 by lia.
      rewrite Nat.mul_add_distr_r in H2.
      assert (1*p <= (n2-n1)*p) as H5.
      { apply Nat.mul_le_mono; lia. }
      simpl in H5; lia.
    + replace n1 with (n1-n2 + n2) in H2 by lia.
      rewrite Nat.mul_add_distr_r in H2.
      assert (1*p <= (n1-n2)*p) as H5.
      { apply Nat.mul_le_mono; lia. }
      simpl in H5; lia.
    + subst; lia.
  Qed.

  Fact div_prop q p n r : q = n*p+r -> r < p -> div q p = n.
  Proof.
    intros H1 H2.
    apply (@div_rem_uniq p _ (rem q p) n r); auto.
    + lia.
    + rewrite <- H1; symmetry; apply div_rem_spec1.
    + apply div_rem_spec2; lia.
  Qed.

  Fact rem_prop q p n r : q = n*p+r -> r < p -> rem q p = r.
  Proof.
    intros H1 H2.
    apply (@div_rem_uniq p (div q p) _ n r); auto.
    + lia.
    + rewrite <- H1; symmetry; apply div_rem_spec1.
    + apply div_rem_spec2; lia.
  Qed.

  Fact rem_idem q p : q < p -> rem q p = q.
  Proof. apply rem_prop with 0; auto. Qed.

  Fact rem_rem x m : rem (rem x m) m = rem x m.
  Proof.
    destruct (eq_nat_dec m 0).
    + subst; rewrite !rem_0; auto.
    + apply rem_idem, div_rem_spec2; auto.
  Qed.

  Fact is_gcd_rem p n a : is_gcd p n a <-> is_gcd p (rem n p) a.
  Proof.
    rewrite (div_rem_spec1 n p) at 1; apply is_gcd_mult.
  Qed.

  Fact rem_erase q n p r : q = n*p+r -> rem q p = rem r p.
  Proof.
    destruct (eq_nat_dec p 0) as [ | Hp ]; subst.
    + rewrite Nat.mul_comm, rem_0, rem_0; auto.
    + destruct (div_full r p) as (m & r' & H1 & H2).
      specialize (H2 Hp).
      rewrite rem_prop with r p m r'; auto.
      intros; apply rem_prop with (n+m); auto.
      rewrite Nat.mul_add_distr_r; lia.
  Qed.

  Fact divides_div q p : divides p q -> q = div q p * p.
  Proof.
    intros (k & Hk).
    destruct (eq_nat_dec p 0) as [ Hp | Hp ].
    + subst; do 2 (rewrite Nat.mul_comm; simpl); auto.
    + rewrite (@div_prop q p k 0); lia.
  Qed.

  Fact divides_rem_eq q p : divides p q <-> rem q p = 0.
  Proof.
    destruct (eq_nat_dec p 0) as [ Hp | Hp ].
    * subst; rewrite rem_0; split.
      + apply divides_0_inv.
      + intros; subst; apply divides_0.
    * split.
      + intros (n & Hn).
        apply rem_prop with n; lia.
      + intros H.
        generalize (div_rem_spec1 q p).
        exists (div q p); lia.
  Qed.

  Fact rem_of_0 p : rem 0 p = 0.
  Proof.
    destruct p.
    + apply rem_0.
    + apply rem_prop with 0; lia.
  Qed.

  Hint Resolve divides_0_inv : core.

  Fact divides_dec q p : { k | q = k*p } + { ~ divides p q }.
  Proof.
    destruct (eq_nat_dec p 0) as [ Hp | Hp ].
    + destruct (eq_nat_dec q 0) as [ Hq | Hq ].
      * left; subst; exists 1; auto.
      * right; contradict Hq; subst; auto.
    + destruct (@euclid q p Hp) as (n & [ | r ] & H1 & H2).
      * left; exists n; subst; rewrite Nat.add_comm; auto.
      * right; intros (m & Hm).
        rewrite <- Nat.add_0_r in Hm.
        rewrite Hm in H1.
        destruct (div_rem_uniq _ _ Hp H1); lia.
  Qed.

End division.

Section rem.

  Variable (p : nat) (Hp : p <> 0).

  Fact rem_plus_rem a b : rem (a+rem b p) p = rem (a+b) p.
  Proof.
    rewrite (div_rem_spec1 b p) at 2.
    rewrite Nat.add_assoc.
    symmetry; apply rem_erase with (div (b) p); ring.
  Qed.

  Fact rem_mult_rem a b : rem (a*rem b p) p = rem (a*b) p.
  Proof.
    rewrite (div_rem_spec1 b p) at 2.
    rewrite Nat.mul_add_distr_l, Nat.mul_assoc.
    symmetry; apply rem_erase with (a*div b p); auto.
  Qed.

  Fact rem_diag : rem p p = 0.
  Proof using Hp. apply rem_prop with 1; lia. Qed.

  Fact rem_lt a : a < p -> rem a p = a.
  Proof using Hp. apply rem_prop with 0; lia. Qed.

  Fact rem_plus a b : rem (a+b) p = rem (rem a p + rem b p) p.
  Proof.
    rewrite (div_rem_spec1 a p) at 1.
    rewrite (div_rem_spec1 b p) at 1.
    apply rem_erase with (div a p + div b p).
    ring.
  Qed.

  Fact rem_scal k a : rem (k*a) p = rem (k*rem a p) p.
  Proof.
    rewrite (div_rem_spec1 a p) at 1.
    rewrite Nat.mul_add_distr_l.
    apply rem_erase with (k*div a p).
    ring.
  Qed.

  Fact rem_plus_div a b : divides p b -> rem a p = rem (a+b) p.
  Proof using Hp.
    intros (n & Hn); subst.
    rewrite <- rem_plus_rem.
    f_equal.
    rewrite <- rem_mult_rem, rem_diag, Nat.mul_0_r, rem_of_0; lia.
  Qed.

  Fact div_eq_0 n : n < p -> div n p = 0.
  Proof using Hp. intros; apply div_prop with n; lia. Qed.

  Fact div_of_0 : div 0 p = 0.
  Proof using Hp. apply div_eq_0; lia. Qed.

  Fact div_ge_1 n : p <= n -> 1 <= div n p.
  Proof using Hp.
    intros H2.
    rewrite (div_rem_spec1 n p) in H2.
    generalize (div_rem_spec2 n Hp); intros H3.
    destruct (div n p); lia.
  Qed.

End rem.

Fact divides_rem_rem p q a : divides p q -> rem (rem a q) p = rem a p.
Proof.
  destruct (eq_nat_dec p 0) as [ Hp | Hp ].
  { intros (k & ->); subst; rewrite Nat.mul_0_r.
    repeat rewrite rem_0; auto. }
  intros H.
  generalize (div_rem_spec1 a q); intros H1.
  destruct H as (k & ->).
  rewrite H1 at 2.
  rewrite Nat.add_comm.
  apply rem_plus_div; auto.
  do 2 apply divides_mult.
  apply divides_refl.
Qed.

Fact divides_rem_congr p q a b : divides p q -> rem a q = rem b q -> rem a p = rem b p.
Proof.
  intros H1 H2.
  rewrite <- (divides_rem_rem a H1),
          <- (divides_rem_rem b H1).
  f_equal; auto.
Qed.

Fact div_by_p_lt p n : 2 <= p -> n <> 0 -> div n p < n.
Proof.
  intros H1 H2.
  rewrite (div_rem_spec1 n p) at 2.
  replace p with (2+(p-2)) at 3 by lia.
  rewrite Nat.mul_add_distr_l.
  generalize (div n p*(p-2)); intros x.
  destruct (le_lt_dec p n) as [ Hp | Hp ].
  + apply div_ge_1 in Hp; lia.
  + rewrite rem_lt; lia.
Qed.

Section rem_2.

  Fact rem_2_is_0_or_1 x : rem x 2 = 0 \/ rem x 2 = 1.
  Proof. generalize (rem x 2) (@div_rem_spec2 x 2); intros; lia. Qed.

  Fact rem_2_mult x y : rem (x*y) 2 = 1 <-> rem x 2 = 1 /\ rem y 2 = 1.
  Proof.
    generalize (rem_2_is_0_or_1 x) (rem_2_is_0_or_1 y).
    do 2 rewrite <- rem_mult_rem, Nat.mul_comm.
    intros [ H1 | H1 ] [ H2 | H2 ]; rewrite H1, H2; simpl; rewrite rem_lt; lia.
  Qed.

  Fact rem_2_fix_0 : rem 0 2 = 0.
  Proof. apply rem_lt; lia. Qed.

  Fact rem_2_fix_1 n : rem (2*n) 2 = 0.
  Proof. apply divides_rem_eq; exists n; ring. Qed.

  Fact rem_2_fix_2 n : rem (1+2*n) 2 = 1.
  Proof.
    rewrite <- rem_plus_rem,rem_2_fix_1, rem_lt; lia.
  Qed.

  Fact rem_2_lt n : rem n 2 < 2.
  Proof. apply div_rem_spec2; lia. Qed.

  Fact div_2_fix_0 : div 0 2 = 0.
  Proof. apply div_of_0; lia. Qed.

  Fact div_2_fix_1 n : div (2*n) 2 = n.
  Proof. apply div_prop with 0; lia. Qed.

  Fact div_2_fix_2 n : div (1+2*n) 2 = n.
  Proof. apply div_prop with 1; lia. Qed.

  Fact euclid_2_div n : n = rem n 2 + 2*div n 2 /\ (rem n 2 = 0 \/ rem n 2 = 1).
  Proof.
    generalize (div_rem_spec1 n 2) (@div_rem_spec2 n 2); intros; lia.
  Qed.

  Fact euclid_2 n : exists q, n = 2*q \/ n = 1+2*q.
  Proof.
    exists (div n 2).
    generalize (div_rem_spec1 n 2) (@div_rem_spec2 n 2); intros; lia.
  Qed.

End rem_2.

Local Hint Resolve divides_mult divides_mult_r divides_refl : core.


Require Import Nat PeanoNat.

Definition PredTh := forall n m, n <= m -> pred n <= pred m.

Theorem predTh : PredTh.
Proof.
  unfold PredTh.
  induction n.
  - intros m H.
    exact (le_0_n _).
  - intros [] H; simpl.
    + exfalso.
      exact (Nat.nle_succ_0 _ H).
    + apply le_S_n.
      exact H.
Qed.

Require Import ssreflect.

Theorem predTh2 : PredTh.
Proof.
  elim=> [ |n IHn] m H /=.
  - by apply: le_0_n.
  - case: m H => [| m] H /=.
    + by case: (Nat.nle_succ_0 _ H).
    + exact (le_S_n _ _ H).
Qed.


Require Export NArith.
Require Export base.
Require Import Sets SetInterface SetProperties Relations.
Require Import Vectors.Vector.

(** Boolean strict less-than order on values of type [nat]. *)

Fixpoint ltb (n m:nat) : bool :=
  match n,m with
    | O , S _ => true
    | S k, S l => ltb k l
    | _,_ => false
  end.

(** Some basic properties of [ltb] *)

Proposition ltb0 : forall n, ltb n 0 = false.
Proof.
  induction n;simpl;intros;auto.
Qed.

Proposition ltb_S : forall n, ltb n (S n) = true.
Proof.
  induction n;simpl;eauto.
Qed.

Lemma ltb_correct : forall n m, ltb n m = true -> n < m.
Proof.
  induction n.
  - intros. destruct m. discriminate. omega.
  - simpl. intros. destruct m.
    + discriminate.
    + apply IHn in H. omega.
Defined.

Lemma ltb_complete : forall n m, n < m -> ltb n m = true.
Proof.
  induction n.
  - intros. destruct m.
    + omega.
    + auto.
  - intros. inv H.
    + simpl. apply ltb_S.
    + simpl. apply IHn. omega.
Defined.

Lemma ord_lt_correct :
  forall m n, ltb m n = true -> ltb (S m) (S n) = true.
Proof.
  intros.
  apply ltb_correct in H.
  apply ltb_complete.
  abstract(omega).
Qed.

(** * Definition of finite ordinal *)
(** The structure [ord] contains a number a number [m] and a proof involving [ltb] *)

Record ord (n:N) := Ord {nat_of_ord:> N; ord_lt: ltb nat_of_ord n = true }.

(** [O] and [S _] smart constructors for [ord] *)

Definition ord0 n : ord (S n) := @Ord  (S n) 0 eq_refl.
Definition ordS n (m:ord n) := @Ord (S n) (S m) ((ord_lt n m)).

(** * Equality and strict orderings over [ord] *)
(** We consider only the underlying natural number, and ignore the proofs. *)

Definition ord_Eq n :=
  fun x y:ord n => @eq nat x y.

Definition ord_Lt n :=
  fun (x y:ord n) => (nat_of_ord n x) <<< (nat_of_ord n y).

Definition ord_Cmp n :=
  fun (x y:ord n) => _cmp (nat_of_ord n x) (nat_of_ord n y).

(** Bureaucratic instances to register [ord] as an ordered typ *)

Instance ord_Eq_equiv : forall n, Equivalence (ord_Eq n).
Proof.
  intros;constructor;repeat red;auto.
  intros;inversion H;inversion H0;auto.
Qed.

Instance ord_Lt_trans : forall n, Transitive (ord_Lt n).
Proof.
  intro;repeat red;intros.
  inversion H;inversion H0;subst;now(omega).
Qed.

Proposition ord_Lt_irrefl n :
  forall  x y,
    ord_Lt n x y -> ~ord_Eq n x y.
Proof.
  intros.
  intro.
  inversion H.
  - inversion H0;omega.
  - inversion H0;omega.
Qed.

Instance ord_StrictOrder : forall n, StrictOrder (ord_Lt n) (ord_Eq n).
Proof.
  intro;constructor;autotc.
  intros;apply ord_Lt_irrefl;auto.
Qed.

Lemma ord_Eq_unique :
  forall n (x y:ord n), ord_Eq n x y -> x = y.
Proof.
  unfold ord_Eq.
  destruct x. destruct y.
  simpl.
  intros.
  subst.
  f_equal.
  eapply Eqdep_dec.UIP_dec.
  decide equality.
Qed.

Ltac ord_eq_un H := apply ord_Eq_unique in H;subst.

Instance ord_UStrict : forall n : nat, StrictOrder (ord_Lt n) eq.
Proof.
  intro.
  constructor;autotc.
  intros.
  unfold ord_Lt in H.
  intro.
  rewrite H0 in H.
  order.
Qed.

Instance ord_UOrderedType : forall n, UsualOrderedType (ord n) :=
  { SOT_lt  := ord_Lt n ;
    SOT_cmp := ord_Cmp n }.
Proof.
  intros.
  case_eq(ord_Cmp n x y);intros;constructor.
  - apply compare_2,ord_Eq_unique in H;auto.
  - apply compare_1 in H;unfold ord_Lt;auto.
  - apply compare_3 in H;unfold ord_Lt;auto.
Defined.

(*Definition ordS_map n (l:list (ord n)) : list (ord (S n)) := List.map (@ordS n) l.*)
(** Mapping adition to a list of ordinals *)

Definition ordS_mapS n (s:set (ord n)) : set (ord (S n)) := map (@ordS n) s.

(* Fixpoint smaller_ords n  {struct n} : list (ord n) := *)
(*   match n with *)
(*     | 0 => nil *)
(*     | S m => cons (ord0 m) (@ordS_map m (smaller_ords m)) *)
(*   end. *)

(** * Function to generate the set of all ordinals under a natural [n] *)

Fixpoint smaller_ordsS n  {struct n} : set (ord n) :=
  match n with
    | 0 => {}
    | S m => add (ord0 m) (@ordS_mapS m (smaller_ordsS m))
  end.

(* Lemma all_in_smaller_ord :  *)
(*   forall n (x:ord n),  List.In x (smaller_ords n). *)
(* Proof. *)
(*   induction n. *)
(*   - simpl;intros;inv x;pose proof ltb0 nat_of_ord0;congruence. *)
(*   - intros;simpl. right.  unfold ordS_map. *)
(*     destruct x. *)
(*     assert(ltb nat_of_ord0 n = true). *)
(*     simpl in ord_lt0. *)
(*     apply ltb_correct in ord_lt0. *)
(*     apply ltb_complete. *)
(*     omega. *)
(*     Check @Ord . *)

Lemma ord_ind' (P: forall n, ord n -> Prop)
  (H0: forall n, P (S n) (ord0 n))
  (HS: forall n i, P n i -> P (S n) (ordS n i)):
  forall n i, P n i.
Proof.
  induction n.
  - intro i. inv i. pose proof ltb0 nat_of_ord0. congruence.
  - destruct i as [[|i] Hi].
    replace ({| nat_of_ord := 0; ord_lt := Hi |}) with
      ((ord0 n)). apply H0.
    apply ord_Eq_unique.
    unfold ord0.
    unfold ord_Eq. simpl.
    reflexivity.
    change ({| nat_of_ord := S i; ord_lt := Hi |}) with (@ordS n (@Ord n i Hi)).
    apply HS.
    apply IHn.
Qed.

(* Lemma all_in_smaller_ords :  *)
(*   forall n i,  List.In i (smaller_ords n). *)
(* Proof. *)
(*   induction i using ord_ind'. *)
(*   - simpl. left;auto. *)
(*   - simpl. right. apply List.in_map_iff. exists i. auto. *)
(* Qed. *)

Global Instance ord_S_m : forall n,  Proper (_eq ==> _eq) (ordS n).
Proof.
  repeat red;intros.
  f_equal.
  repeat red in H.
  assumption.
Qed.

Lemma all_in_smaller_ordsS :
  forall n i,  i \In (smaller_ordsS n).
Proof.
  induction i using ord_ind'.
  - simpl. apply add_1. reflexivity.
  - simpl. apply add_2. apply map_iff.
    + autotc.
    + exists i. auto.
Qed.

Fixpoint pow2(n:nat):nat :=
  match n with
    | O   => 1
    | S m => 2*pow2 m
  end.

Proposition pow2_geq_1 :
  forall n, 1 <= pow2 n .
Proof.
  induction n;simpl;auto with arith.
Qed.

(** Evaluate the nth-bit of the natural number wrapped in the ordinal *)

Definition nth_bit(m:nat)(k:ord m)(n:nat):bool := N.testbit_nat (N.of_nat k) n.


Require Import nat.
Require Import bool.
Require Import syntax.
Require Import eval.
Require Import state.

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

Inductive bevalR:State-> bexp -> bool -> Prop :=
| E_BTrue : forall e, bevalR e BTrue true
| E_BFalse: forall e, bevalR e BFalse false
| E_BEq   : forall e n1 n2 a1 a2,
    aevalR e a1 n1 -> aevalR e a2 n2 -> bevalR e (BEq a1 a2) (eqb n1 n2)
| E_BLe   : forall e n1 n2 a1 a2,
    aevalR e a1 n1 -> aevalR e a2 n2 -> bevalR e (BLe a1 a2) (leb n1 n2)
| E_BNot  : forall e b1 e1,
    bevalR e e1 b1 -> bevalR e (BNot e1) (negb b1)
| E_BAnd  : forall e b1 b2 e1 e2,
    bevalR e e1 b1 -> bevalR e e2 b2 -> bevalR e (BAnd e1 e2) (andb b1 b2)
.

Theorem aeval_iff_aevalR : forall (env:State) (a:aexp) (n:nat),
    aevalR env a n <-> aeval env a = n.
Proof.
    intros env a n. split.
    - intro H. induction H as   [ n
                                | k
                                | e n1 n2 a1 a2 H1 IH1 H2 IH2
                                | e n1 n2 a1 a2 H1 IH1 H2 IH2
                                | e n1 n2 a1 a2 H1 IH1 H2 IH2
                                ].
        + reflexivity.
        + reflexivity.
        + simpl. rewrite IH1, IH2. reflexivity.
        + simpl. rewrite IH1, IH2. reflexivity.
        + simpl. rewrite IH1, IH2. reflexivity.

    - revert n env. induction a as [n|k|a1 H1 a2 H2| a1 H1 a2 H2| a1 H1 a2 H2].
        + simpl. intros p e H. subst. apply E_ANum.
        + simpl. intros p e H. subst. apply E_AKey.
        + simpl. intros p e H. subst. apply E_APlus.
            { apply H1. reflexivity. }
            { apply H2. reflexivity. }
        + simpl. intros p e H. subst. apply E_AMinus.
            { apply H1. reflexivity. }
            { apply H2. reflexivity. }
        + simpl. intros p e H. subst. apply E_AMult.
            { apply H1. reflexivity. }
            { apply H2. reflexivity. }
Qed.

Theorem aeval_iff_aevalR' : forall (env:State) (a:aexp) (n:nat),
    aevalR env a n <-> aeval env a = n.
Proof.
    split.
    - intros H. induction H; subst; reflexivity.
    - revert n env. induction a as [n|k|a1 H1 a2 H2| a1 H1 a2 H2| a1 H1 a2 H2];
        simpl; intros; subst; constructor;
        try apply H1; try apply H2; reflexivity.
Qed.

Theorem beval_iff_bevalR : forall (env:State) (e:bexp) (b:bool),
    bevalR env e b <-> beval env e = b.
Proof.
    split.
    - intros H. induction H; subst; try reflexivity; simpl.
        + assert (aeval e a1 = n1) as H1.
            { apply aeval_iff_aevalR. assumption. }
          assert (aeval e a2 = n2) as H2.
            { apply aeval_iff_aevalR. assumption. }
           rewrite H1, H2. reflexivity.
        +  assert (aeval e a1 = n1) as H1.
            { apply aeval_iff_aevalR. assumption. }
           assert (aeval e a2 = n2) as H2.
               { apply aeval_iff_aevalR. assumption. }
           rewrite H1, H2. reflexivity.
    - revert b. induction e as [ | |a1 a2|a1 a2|e1 H1|e1 H1 e2 H2];
        intros; subst; simpl; constructor; try apply aeval_iff_aevalR;
        try reflexivity; try apply H1; try apply H2; reflexivity.
Qed.


(** * Basic programming in Coq *)

(** First, a few keywords about Coq as a programming language:
    - Purely functional (cf. Haskell or a subset of OCaml)
    - Closed world (no I/O, no random, ...)
    - Typed (includes ML-like types, and a lot more)
    - Terminating (hence not Turing-complete)
    - In fact, strongly normalizing (pick your favorite
      reduction strategy !)
    - Total: no exception or abnormal outputs.

    These design choices allow an easy reasoning about "(f x)".
*)

(** I) A quick tour of predefined datatypes and functions. *)

Require Import Bool Arith ZArith List.

(** bool *)
Check true.
Check false.
Check true && false.
Compute true && false.
Print "&&".
Print "||".
Print negb.
Print xorb.
Compute if true && false then false else true.

(** nat : natural numbers via unary encoding *)
Check 0.
Check 10000.
Print Nat.pred. (** or simply pred *)
Compute pred 2.
Compute pred 0. (** Rounded to 0 *)
Check 1+1.
Compute 1+1.
Print "+". (* Nat.add or plus *)
Print "-".
Compute 1-2. (* Rounded to 0 *)
Compute Nat.log2 ((2^10)/3).

(** N : natural numbers via binary encoding *)
Check 10.
Open Scope N.
Check 10.
Check 10%nat.
Compute N.pred 2.
Compute N.pred 0.
Compute (2^(2^8)).
Compute (3^(3^8)).
Compute N.log2 (3^(3^8)).
Check 1+1.
Print "+".
Compute 1-2.
Close Scope N.

(** Z : integers via binary encoding *)
Open Scope Z.
Check 10.
Check -1.
Check 1+1.
Print "+".
Compute 1-2.
Compute 1/0.
Close Scope Z.

(** Pairs *)
Check (1,true).
Check fun (p:nat*bool) => let (a,b) := p in (b,a).

(** Lists *)
Check 1::2::3::nil.
Compute (1::2::3::nil)++(4::5::6::nil).
Locate "::".
Print "++".

(** II) Inductive types *)

(** How are defined these usual types ? *)
(** How do we define new ones ? *)

Print bool.
(* Inductive bool : Set :=
     | true : bool
     | false : bool.  *)

Print nat.
(* Inductive nat : Set :=
     | O : nat
     | S : nat -> nat.  *)

Print N.
(* Inductive N : Set :=
     | N0 : N
     | Npos : positive -> N. *)

Print Z.
(* Inductive Z : Set :=
      | Z0 : Z
      | Zpos : positive -> Z
      | Zneg : positive -> Z. *)

Print positive.
(* Inductive positive : Set :=
     | xI : positive -> positive
     | xO : positive -> positive
     | xH : positive. *)
(* xH is 1, xI adds a lower 1 digit, xO adds a lower 0 digit:
   Hence 6 = 110 = (xO (xI xH)). *)

Print list.
(* Inductive list (A:Type) : Type :=
     | nil : list A
     | cons : A -> list A -> list A. *)
(* This is a first "parameterized" type (by another type A). *)
Check list.
Check list nat.
Check cons 1 nil.
Check nil.
Check nil (A:=bool).

(** Another parameterized type : *)
Print option.
(* Inductive option (A:Type) : Type :=
      | Some : A -> option A
      | None : option A.
*)

(** Nota : some inductive definitions are refused by Coq, since
    they would endanger the coherence of the system.
    Cf. the "positivity condition" in the documentation. *)

(** III) Function abstraction *)

Definition id_nat (n:nat) := n.
Definition id_nat2 (n:nat) : nat := n.
Definition id_nat3 : nat -> nat := fun n => n.
Definition id_nat4 := fun (n:nat) => n.

(** Polymorphism *)

Definition id (A:Type) : A -> A := fun x => x.
Check id.
Definition id2 : forall A, A->A := fun _ x => x.
Check id2.
Definition id3 := fun (A:Type)(x:A) => x.
Check id3.

Compute id _ 0.  (* Coq infers the type argument *)
Compute id nat.  (* Partial application, we're back to id_nat *)

(* Via "implicit arguments", we can hide the types. *)

Definition id4 := fun {A:Type}(x:A) => x.
Check id4 0.
Check id4 (A:=nat).
Check @id4.

(* See also "Set Implicit Arguments". *)

(** IV) Pattern matching *)

Definition negb (b:bool) :=
  match b with
  | true => false
  | false => true
  end.

Print negb. (* we end back with an "if ... then ... else" *)

Definition iszero (n:nat) :=
 match n with
 | O => true
 | S _ => false
 end.

Compute iszero 55.
Print iszero.

Definition pred n := match n with
 | O => O
 | S p => p
 end.

Check pred.
Compute pred 10000.

Definition succ n := S n.
Definition succ' := fun n => S n.
Definition succ'' := S.

(** Complex pattern matching : bi-predecessor *)

Definition predpred n :=
  match n with
   | S (S m) => m
   | _ => O
  end.

Print predpred.

(** V) Recursion *)

Fixpoint double n :=
  match n with
  | O => O
  | S n => S (S (double n))
  end.

Compute double 6.

Fixpoint plus n m :=
 match n with
  | O => m
  | S n' => S (plus n' m)
 end.

Fixpoint div2 n :=
  match n with
   | S (S m) => S (div2 m)
   | _ => O
  end.

Compute div2 22.

(** Fixpoint is no more than a Definition followed by an inner
    recursion operator "fix". *)

Definition plus' :=
  fix plusrec n m :=
    match n with
    | O => m
    | S n' => S (plusrec n' m)
    end.

(** This "fix" construct may help for some tricky recursive
    definitions (ackermann, list merge, ...). *)

(** Fixpoint and polymorphism *)

Fixpoint length {A:Type} (l:list A) :=
  match l with
  | nil => 0
  | x::l' => S (length l')
  end.

(** Restrictions on recursion : the termination checker.
    Coq avoids infinite computations by checking that one
    specific argument gets "structurally smaller" at each
    recursive call.
    Otherwise:
     - undefined objects (e.g. a boolean value not true nor false)
     - contradictory objects (e.g. implying true=false)
     - direct inhabitant of False (you can program your proofs).
*)

(* Fixpoint alien (b:bool) : bool := alien b. *)

(* Fixpoint bogus (b:bool) : bool := negb (bogus b). *)

(* Fixpoint loop (n:nat) : False := loop n.
   Definition impossible : False := loop 0. *)

(** This decreasing constraint might get into the way: *)

Compute 3 <=? 5.
Print "<=?".

Fail Fixpoint div (a b:nat) : nat :=
  if b <=? a
  then S (div (a-b) b)
  else 0.

(** Possible workarounds:
    1) an extra argument used as counter, or "fuel"
    2) old-style approach: use of accessibility relation "acc"
    3) use of modern extensions of Coq: "Function" or "Program"
       (see later). *)

(** The previous "div", with a counter *)

Fixpoint div_count (n:nat)(a b:nat) : nat :=
  match n with
    | 0 => 0
    | S n' =>
        if b <=? a
        then S (div_count n' (a-b) b)
        else 0
  end.

(** Here starting with n=a is always enough. *)

Definition div (a b:nat) : nat := div_count a a b.

Compute (div 100 3).
Compute (div 100 0).

(** Btw, another (awkward) definition of div is directly accepted *)

Fixpoint div_direct a b :=
  match a with
    | O => O
    | S a' =>
      let c := div_direct a' b in
      if ((S c)*b) <=? a then S c else c
  end.

Compute div_direct 100 3.

(** VI) Totality *)

(** By design, all Coq functions are total :
    - when f:A->B and x:A, then (f x) is always meaningful
      (and has type B).
    - no exceptions, failure, non-exhaustive patterns, ...

    Three ways to handle partial functions :
    1) answer an arbitrary value for problematic inputs
      (for instance 2-3=0, or 3/0 = 0)
    2) use the "option" type to mark the lack of output
      (for instance 2-3 = None, 3-2 = Some 1)
    3) use "dependent types" and restrict the input via a
      logical precondition.
       minus : forall a b, b<=a -> nat. *)

Definition pred_option (n:nat) : option nat :=
  match n with
    | O => None
    | S n' => Some n'
  end.

Fixpoint minus_option (a b:nat) : option nat :=
  match a, b with
    | _, 0 => Some a
    | 0, S _ => None
    | S a', S b' => minus_option a' b'
  end.

Compute (minus_option 2 3).
Compute (minus_option 2 2).

(* So far so good, but a real use would be quite painful.
   Think of 3+(5-(4-2)): *)

Definition smallcomputation :=
 match minus_option 4 2 with
 | Some r =>
   match minus_option 5 r with
   | Some r' => Some (3+r')
   | None => None
   end
 | None => None
 end.

Compute smallcomputation.

(** Monads might help in this situation, but that's another story. *)


Set Warnings "-notation-overridden,-parsing".
From LF Require Export logic.
Require Coq.omega.Omega.

Inductive even : nat -> Prop :=
  | ev_0 : even 0
  | ev_SS (n : nat) (H : even n) : even (S (S n)).

Fail Inductive wrong_ev (n : nat) : Prop :=
  | wrong_ev_0 : wrong_ev 0
  | wrong_ev_SS : wrong_ev n -> wrong_ev (S (S n)).

Inductive even' : nat -> Prop :=
  | ev_0' : even' 0
  | ev_SS' : forall n, even' n -> even' (S (S n)).

Theorem ev_4 : even 4.
Proof.
  apply ev_SS.
  apply ev_SS.
  apply ev_0.
Qed.

Theorem ev_4' : even 4.
Proof.
  apply (ev_SS 2 (ev_SS 0 ev_0)).
Qed.

Theorem ev_plus4 :
  forall n, even n -> even (4 + n).
Proof.
  intros n.
  simpl.
  intros Hn.
  apply ev_SS.
  apply ev_SS.
  apply Hn.
Qed.

Theorem ev_double :
  forall n,
  even (double n).
Proof.
  induction n.
  - simpl.
    apply  ev_0.
  - simpl.
    apply ev_SS.
    apply IHn.
Qed.

Theorem ev_inversion :
  forall(n : nat), even n ->
  (n = 0) \/ (exists n', n = S (S n') /\ even n').
Proof.
  intros n E.
  destruct E as [ | n' E'].
  - left.
    reflexivity.
  - right.
    exists n'.
    split.
    reflexivity.
    apply E'.
Qed.

Theorem ev_minus2 :
  forall n,
  even n -> even (pred (pred n)).
Proof.
  intros n E.
  destruct E as [| n' E'].
  - simpl.
    apply ev_0.
  - simpl.
    apply E'.
Qed.

Theorem evSS_ev :
  forall n,
  even (S (S n)) -> even n.
Proof.
  intros n E.
  destruct E as [| n' E'].
Abort.

Theorem evSS_ev :
  forall n,
  even (S (S n)) -> even n.
Proof.
  intros n H.
  apply ev_inversion in H.
  destruct H.
 - discriminate H.
 - destruct H as [n' [Hnm Hev]].
   injection Hnm.
   intro Heq.
   rewrite Heq.
   apply Hev.
Qed.

Theorem evSS_ev' :
  forall n,
  even (S (S n)) -> even n.
Proof.
  intros n E.
  inversion E as [| n' E'].
  apply E'.
Qed.

Theorem one_not_even : ~ even 1.
Proof.
  intros H.
  apply ev_inversion in H.
  destruct H as [ | [m [Hm _]]].
  - discriminate H.
  - discriminate Hm.
Qed.

Theorem one_not_even' : ~ even 1.
Proof.
  intros H.
  inversion H.
Qed.

Theorem SSSSev__even :
  forall n,
  even (S (S (S (S n)))) -> even n.
Proof.
  intros n H.
  inversion H.
  inversion H1.
  apply H3.
Qed.

Theorem SSSSev__even' :
  forall n,
  even (S (S (S (S n)))) -> even n.
Proof.
  intros n H.
  apply ev_inversion in H.
  destruct H.
  + discriminate.
  + destruct H.
    destruct H.
    injection H.
    intros.
    apply ev_inversion in H0.
    destruct H0.
    - rewrite H0 in H1.
      discriminate.
    - destruct H0.
      destruct H0.
      rewrite H0 in H1.
      injection H1.
      intros.
      rewrite <- H3 in H2.
      apply H2.
Qed.

Theorem even5_nonsense :
  even 5 -> 2 + 2 = 9.
Proof.
  intros.
  inversion H.
  inversion H1.
  inversion H3.
Qed.

Theorem inversion_ex1 :
  forall(n m o : nat),
  [n; m] = [o; o] ->
  [n] = [m].
Proof.
  intros n m o H.
  inversion H.
  reflexivity.
Qed.

Theorem inversion_ex2 :
  forall(n : nat),
  S n = O ->
  2 + 2 = 5.
Proof.
  intros n contra.
  inversion contra.
Qed.

Lemma ev_even_firsttry :
  forall n,
  even n -> exists k, n = double k.
Proof.
  intros n E.
  inversion E as [| n' E'].
  - exists 0.
    reflexivity.
  - simpl.
    assert (I : (exists k', n' = double k') ->
           (exists k, S (S n') = double k)).
   { intros [k' Hk'].
     rewrite Hk'. exists(S k').
     reflexivity. }
   apply I.
Abort.

Lemma ev_even :
  forall n,
  even n -> exists k, n = double k.
Proof.
  intros n E.
  induction E as [|n' E' IH].
  - exists 0.
    reflexivity.
  - destruct IH as [k' Hk'].
    rewrite Hk'.
    exists(S k').
    reflexivity.
Qed.

Theorem ev_even_iff :
  forall n,
  even n <-> exists k, n = double k.
Proof.
  intros n.
  split.
  - apply ev_even.
  - intros [k Hk].
    rewrite Hk.
    apply ev_double.
Qed.

Theorem ev_sum :
  forall n m,
  even n -> even m -> even (n + m).
Proof.
  intros n m Hn Hm.
  induction Hn.
  - simpl.
    apply Hm.
  - inversion Hm.
    + simpl.
      rewrite <- plus_n_O.
      apply ev_SS.
      apply Hn.
    + simpl.
      apply ev_SS.
      rewrite H0.
      apply IHHn.
Qed.

Inductive even'' : nat -> Prop :=
  | even'_0 : even'' 0
  | even'_2 : even'' 2
  | even'_sum n m (Hn : even'' n) (Hm : even'' m) : even'' (n + m).

Theorem even'_ev :
  forall n,
  even'' n <-> even n.
Proof.
  intros n.
  split.
  + intros.
    induction H.
    - apply ev_0.
    - apply ev_SS.
      apply ev_0.
    - apply ev_sum.
      apply IHeven''1.
      apply IHeven''2.
  + intros.
    induction H.
    - apply even'_0.
    - assert (H1: (S (S n)) = 2 + n).
      * reflexivity.
      * rewrite H1.
        apply (even'_sum 2 n).
        apply even'_2.
        apply IHeven.
Qed.

Theorem ev_ev__ev :
  forall n m,
  even (n + m) -> even n -> even m.
Proof.
  intros.
  induction H0.
  - apply H.
  - inversion H.
    apply IHeven.
    apply H2.
Qed.

Theorem ev_plus_plus :
  forall n m p,
  even (n + m) -> even (n + p) -> even (m + p).
Proof.
  intros n m p H.
  apply ev_ev__ev.
  rewrite plus_comm.
  Search plus.
  rewrite PeanoNat.Nat.add_shuffle3.
  rewrite <- plus_assoc.
  rewrite plus_assoc.
  apply ev_sum.
  apply H.
  rewrite <- double_plus.
  apply ev_double.
Qed.

Module Playground.

Inductive le : nat -> nat -> Prop :=
  | le_n n : le n n
  | le_S n m (H : le n m) : le n (S m).

Notation "m ≤ n" := (le m n)
(at level 50).

Theorem test_le1 :
  3 ≤ 3.
Proof.
  apply le_n.
Qed.

Theorem test_le2 :
  3 ≤ 6.
Proof.
  apply le_S.
  apply le_S.
  apply le_S.
  apply le_n.
Qed.

Theorem test_le3 :
  (2 ≤ 1) -> 2 + 2 = 5.
Proof.
  intros H.
  inversion H.
  inversion H2.
Qed.

End Playground.

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

Inductive square_of : nat -> nat -> Prop :=
  | sq n : square_of n (n * n).

Inductive next_nat : nat -> nat -> Prop :=
  | nn n : next_nat n (S n).

Inductive next_even : nat -> nat -> Prop :=
  | ne_1 n : even (S n) -> next_even n (S n)
  | ne_2 n (H : even (S (S n))) : next_even n (S (S n)).

Inductive total_relation : nat -> nat -> Prop :=
  | tr : forall n m, total_relation n m.

Inductive empty_relation : nat -> nat -> Prop :=.

Lemma le_trans :
  forall m n o,
  m <= n -> n <= o -> m <= o.
Proof.
  intros.
  rewrite H.
  apply H0.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  induction n.
  apply le_n.
  apply le_S.
  apply IHn.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros.
  induction H.
  - reflexivity.
  - apply le_S.
    apply IHle.
Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros.
  inversion H.
  - reflexivity.
  - rewrite <- H1.
    apply le_S.
    reflexivity.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  induction a.
  - apply O_le_n.
  - intros b.
    simpl.
    apply n_le_m__Sn_le_Sm.
    apply IHa.
Qed.

Theorem plus_le : forall n1 n2 m,
  n1 + n2 <= m ->
  n1 <= m /\ n2 <= m.
Proof.
  intros.
  split.
  - rewrite <- H.
    apply le_plus_l.
  - rewrite <- H.
    rewrite plus_comm.
    apply le_plus_l.
Qed.

Theorem lt_succ_r p q : p < S q <-> p <= q.
Proof.
  split.
  - induction p.
    + intros.
      apply O_le_n.
    + intros.
      apply Sn_le_Sm__n_le_m in H.
      apply H.
  - induction p.
    + intros.
      unfold lt.
      apply n_le_m__Sn_le_Sm.
      apply H.
    + intros.
      unfold lt.
      apply n_le_m__Sn_le_Sm.
      apply H.
Qed.

 Theorem lt_S :
   forall n m,
   n < m ->
   n < S m.
Proof.
  intros.
  unfold lt in H.
  unfold lt.
  apply le_S in H.
  apply H.
Qed.

Theorem plus_lt :
  forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
  intros.
  unfold "<" in H.
  unfold "<".
  induction H.
  - split.
    * apply n_le_m__Sn_le_Sm.
      apply le_plus_l.
    * apply n_le_m__Sn_le_Sm.
      rewrite plus_comm.
      apply le_plus_l.
  - split.
    * apply le_S.
      apply IHle.
    * apply le_S.
      apply IHle.
Qed.

Theorem leb_complete :
  forall n m,
  n <=? m = true -> n <= m.
Proof.
  induction n.
  - induction m.
    + simpl.
      intros.
      reflexivity.
    + intros.
      apply le_S.
      apply IHm.
      unfold "<=?".
      reflexivity.
  - induction m.
    + unfold "<=?".
      intros.
      inversion H.
    + intros.
      apply n_le_m__Sn_le_Sm.
      apply IHn.
      inversion H.
      reflexivity.
Qed.

Theorem leb_correct : forall n m,
  n <= m ->
  n <=? m = true.
Proof.
  intros n m.
  generalize n as n'.
  induction m.
  - intros.
    destruct n'.
    + reflexivity.
    + inversion H.
  - intros.
    induction n'.
    + reflexivity.
    + apply Sn_le_Sm__n_le_m in H.
      apply IHm in H.
      apply H.
Qed.

Theorem leb_true_trans : forall n m o,
  n <=? m = true -> m <=? o = true -> n <=? o = true.
Proof.
  intros.
  apply leb_correct.
  apply leb_complete in H.
  apply leb_complete in H0.
  rewrite H.
  apply H0.
Qed.

Theorem leb_iff : forall n m,
  n <=? m = true <-> n <= m.
Proof.
  intros.
  split.
  - intros.
    apply leb_complete.
    apply H.
  - intros.
    apply leb_correct.
    apply H.
Qed.

Module R.


Section Group.
  Variable G : Type.
  Variable e : G.
  Variable f : G -> G -> G.
  Variable i : G -> G.

  Infix "*" := f.

  Hypothesis Assoc : forall a b c, a * b * c = a * (b * c).
  Hypothesis RightIdent : forall a, a * e = a.
  Hypothesis RightInv : forall a, a * i a = e.

  Lemma assoc_rewrite : forall a b,
      a * b * i b = a * (b * i b).
  Proof.
    auto.
  Qed.

  Hint Rewrite RightInv RightIdent assoc_rewrite.

  Hint Rewrite RightIdent : aux. (* Just a declaration, CreateDb didn't work for rewrite dbs *)

  Hint Extern 50 => repeat rewrite <- Assoc in *; autorewrite with core aux in *.

  Lemma mult_both_right : forall x a b,
      a = b -> a * x = b * x.
  Proof.
    intros. rewrite H. reflexivity.
  Qed.

  Lemma mult_both_left: forall x a b,
      a = b -> x * a = x * b.
  Proof.
    intros. rewrite H. reflexivity.
  Qed.

  Hint Extern 200 => match goal with
                     | [H : _ * ?a = _ |- _] => apply (mult_both_right (i a)) in H
                     end.

  Hint Extern 250 => match goal with
                     | [H : ?a * _ = _ |- _] => apply (mult_both_left (i a)) in H
                     end.

  Theorem RightCancellation : forall x a b, a * x = b * x -> a = b.
  Proof.
    auto.
  Qed.

  Hint Extern 150 (_ * ?a = _) => apply (RightCancellation (i a)).

  Theorem LeftIdentity : forall a,
      e * a = a.
  Proof.
    auto.
  Qed.

  Hint Rewrite LeftIdentity : aux.

  Theorem LeftInverse : forall a,
      i a * a = e.
  Proof.
    auto.
  Qed.

  Hint Rewrite LeftInverse.

  Theorem LeftCancellation : forall x a b, x * a = x * b -> a = b.
  Proof.
    auto.
  Qed.

  Hint Extern 100 ( _ = i ?a ) => apply (LeftCancellation a).
  Hint Extern 100 ( i ?a = _ ) => apply (LeftCancellation a).

  Theorem LeftIdentityUnique : forall a p,
      p * a = a -> p = e.
  Proof.
    auto.
  Qed.

  Theorem CharacterizingIdentity : forall a,
      a * a = a -> a = e.
  Proof.
    auto.
  Qed.

  Theorem RightInverseUnique : forall a b,
      a * b = e -> b = i a.
  Proof.
    auto.
  Qed.

  Theorem LeftInverseUnique : forall a b,
      a * b = e -> a = i b.
  Proof.
    auto.
  Qed.

  Theorem InverseDistributivity : forall a b,
      i (a * b) = i b * i a.
  Proof.
    auto.
  Qed.

  Theorem DoubleInverse : forall a,
      i (i a) = a.
  Proof.
    auto.
  Qed.

  Theorem IdentityInverse :
    i e = e.
  Proof.
    auto.
  Qed.
End Group.


(* sort.v *)

(**** Sorting algorithm ****)

Require Import Arith.
Require Omega.
Open Scope list_scope.

(* Specification *)

Inductive is_perm : list nat -> list nat -> Prop :=
| is_perm_cons : forall (a : nat) (l0 l1 : list nat),
    is_perm l0 l1 -> is_perm (a :: l0) (a :: l1)
| is_perm_append : forall (a : nat) (l : list nat),
    is_perm (a :: l) (l ++ a :: nil)
| is_perm_refl : forall l : list nat, is_perm l l
| is_perm_trans : forall l0 l1 l2 : list nat,
    is_perm l0 l1 -> is_perm l1 l2 -> is_perm l0 l2
| is_perm_sym : forall l1 l2 : list nat, is_perm l1 l2 -> is_perm l2 l1.

Lemma is_perm_ex1 : is_perm (1::2::3::nil) (3::2::1::nil).
Proof.
  apply (is_perm_trans (1::2::3::nil) ((2::3::nil) ++ 1::nil) (3::2::1::nil));
    [ apply is_perm_append | simpl ].
  apply (is_perm_trans (2::3::1::nil) ((3::1::nil) ++ 2::nil) (3::2::1::nil));
    [ apply is_perm_append | simpl ].
  apply is_perm_cons.
  apply (is_perm_trans (1::2::nil) ((2::nil) ++ 1::nil) (2::1::nil));
    [ apply is_perm_append | simpl ].
  apply is_perm_refl.
Qed.

Ltac is_perm_tac :=
  repeat
    (apply is_perm_refl || apply is_perm_cons ||
     (match goal with
      | |- is_perm (?a1::?tl1) ?l =>
        apply (is_perm_trans (a1::tl1) (tl1 ++ a1::nil) l);
          [ apply is_perm_append | simpl ]
      end)).

Lemma is_perm_ex2 : is_perm (1::2::3::nil) (3::2::1::nil).
Proof.
  is_perm_tac.
Qed.

Inductive is_sorted : list nat -> Prop :=
| is_sorted_nil : is_sorted nil
| is_sorted_sing : forall n : nat, is_sorted (n::nil)
| is_sorted_cons : forall (n m : nat) (l : list nat),
    n <= m -> is_sorted (m::l) -> is_sorted (n::m::l).

Lemma is_sorted_ex1 : is_sorted (1::2::3::4::5::nil).
Proof.
  apply is_sorted_cons; auto.
  apply is_sorted_cons; auto.
  apply is_sorted_cons; auto.
  apply is_sorted_cons; auto.
  apply is_sorted_sing.
Qed.

(* Automation *)

Ltac is_sorted_tac :=
  repeat (apply is_sorted_cons; auto);
  apply is_sorted_sing || apply is_sorted_nil.

Lemma is_sorted_ex2 : is_sorted (1::2::3::4::5::nil).
Proof.
  is_sorted_tac.
Qed.

Lemma is_sorted_ex3 : is_sorted (1::nil).
Proof.
  is_sorted_tac.
Qed.

Lemma is_sorted_ex4 : is_sorted nil.
Proof.
  is_sorted_tac.
Qed.

(* Sorting function: insertion sort *)

Fixpoint insert (x : nat) (l : list nat) {struct l} : list nat :=
  match l with
  | nil => x::nil
  | h::t =>
        match le_dec x h with
        | left _ => x::h::t
        | right _ => h::(insert x t)
        end
  end.

Fixpoint isort (l : list nat) : list nat :=
  match l with
  | nil => nil
  | h::t => insert h (isort t)
  end.

Lemma isort_ex1 : isort (5::4::3::2::1::nil) = 1::2::3::4::5::nil.
Proof.
  simpl; reflexivity.
Qed.

(* Correctness proof *)

Lemma head_is_perm : forall (x1 x2 : nat) (l : list nat),
  is_perm (x1 :: x2 :: l) (x2 :: x1 :: l).
Proof.
  intros; apply is_perm_trans with (x2::l ++ x1::nil);
    [ apply is_perm_append | apply is_perm_cons;
      apply is_perm_sym; apply is_perm_append ].
Qed.

Lemma insert_is_perm : forall (x : nat) (l : list nat),
  is_perm (x::l) (insert x l).
Proof.
  induction l; intros; simpl.
  apply is_perm_refl.
  elim (le_dec x a); intros.
  apply is_perm_refl.
  apply is_perm_trans with (a::x::l);
    [ apply head_is_perm | apply is_perm_cons; auto ].
Qed.

Require Export Omega.
Lemma insert_is_sorted : forall (x : nat) (l : list nat),
  is_sorted l -> is_sorted (insert x l).
Proof.
  intros; elim H; simpl; auto.
  apply is_sorted_sing.
  intros; elim (le_dec x n); simpl; intros; auto.
  apply is_sorted_cons; [ auto | apply is_sorted_sing ].
  apply is_sorted_cons; [ omega | apply is_sorted_sing ].

  intros n m; elim (le_dec x m); intros; elim (le_dec x n); intros.
    repeat (apply is_sorted_cons; auto); omega.
    repeat (apply is_sorted_cons; auto); omega.
    repeat (apply is_sorted_cons; auto); omega.
    apply is_sorted_cons.
    auto.

    auto.

 (apply is_sorted_cons; auto).
omega.
apply is_sorted_cons.
Qed.
intros n m.
elim (le_dec x m).
intros.
elim (le_dec x n).
intros.
Lemma isort_correct : forall (l l' : list nat),
  l' = isort l -> is_perm l l' /\ is_sorted l'.
Proof.
  induction l; intros.
  rewrite H; simpl; split; [ is_perm_tac | is_sorted_tac ].
  rewrite H; simpl; elim (IHl (isort l)); intros; auto; split.
  apply is_perm_trans with (a::(isort l));
    [ apply is_perm_cons; auto | apply insert_is_perm ].
  apply insert_is_sorted; auto.
Qed.


Require Import Nat.

Inductive lst : Type :=
  | Nil : lst
  | Cons : nat -> lst -> lst.

Inductive queue : Type :=
  | Queue : lst -> lst -> queue.

Fixpoint len (l : lst) : nat :=
match l with
  | Nil => 0
  | Cons a l1 => 1 + (len l1)
end.

Lemma len_pos: forall l, (len l) >= 0.
Proof.
  induction l.
  - simpl. apply le_0_n.
  - simpl. apply le_0_n.
Qed.

Definition qlen (q : queue) : nat :=
match q with
  | Queue l1 l2 => (len l1) + (len l2)
end.

Fixpoint app (l : lst) (m: lst): lst :=
match l with
  | Nil => m
  | Cons a l1 => Cons a (app l1 m)
end.

Fixpoint rev (l: lst): lst :=
match l with
  | Nil => Nil
  | Cons a l1 => app (rev l1) (Cons a Nil)
end.

Fixpoint leb (n m : nat) : bool :=
match (n, m) with
  | (0, _) => true
  | (S n', S m') => leb n' m'
  | _ => false
end.

Definition amortizeQueue (l1 l2 : lst) : queue :=
  if leb (len l2)  (len l1) then Queue l1 l2
  else Queue (app l1 (rev l2)) Nil.

Lemma len_app : forall l1 l2, len (app l1 l2) = (len l1) + (len l2).
Proof.
  intros. induction l1.
  - reflexivity.
  - simpl. rewrite IHl1. reflexivity.
Qed.

Lemma plus_comm: forall m n, m + n = n + m.
Proof.
induction m.
- intros. simpl. rewrite <- plus_n_O. reflexivity.
- intros. simpl. rewrite IHm. rewrite plus_n_Sm. reflexivity.
Qed.

Lemma len_rev : forall l, len (rev l) = len l.
Proof.
induction l.
- reflexivity.
- simpl. rewrite len_app. simpl. rewrite plus_comm. simpl. rewrite IHl. reflexivity.
Qed.

Theorem queue_len : forall l1 l2, qlen (amortizeQueue l1 l2) = (len l1) + (len l2).
Proof.
  intros. unfold amortizeQueue. destruct (leb (len l2) (len l1)).
  - simpl. reflexivity.
  - simpl. rewrite <- plus_n_O.
    rewrite len_app.
    apply f_equal2_plus.
    * reflexivity.
    * rewrite len_rev. reflexivity.
Qed.


Require Import Coq.ZArith.ZArith.
Require Import Crypto.Util.Bool.
Local Open Scope Z_scope.

Module Z.
  Lemma eqb_cases x y : if x =? y then x = y else x <> y.
  Proof.
    pose proof (Z.eqb_spec x y) as H.
    inversion H; trivial.
  Qed.

  Lemma geb_spec0 : forall x y : Z, Bool.reflect (x >= y) (x >=? y).
  Proof.
    intros x y; pose proof (Zge_cases x y) as H; destruct (Z.geb x y); constructor; omega.
  Qed.
  Lemma gtb_spec0 : forall x y : Z, Bool.reflect (x > y) (x >? y).
  Proof.
    intros x y; pose proof (Zgt_cases x y) as H; destruct (Z.gtb x y); constructor; omega.
  Qed.

  Ltac ltb_to_lt_with_hyp H lem :=
    let H' := fresh in
    rename H into H';
    pose proof lem as H;
    rewrite H' in H;
    clear H'.

  Ltac ltb_to_lt_in_goal b' lem :=
    refine (proj1 (@reflect_iff_gen _ _ lem b') _);
    cbv beta iota.

  Ltac ltb_to_lt_hyps_step :=
    match goal with
    | [ H : (?x <? ?y) = ?b |- _ ]
      => ltb_to_lt_with_hyp H (Zlt_cases x y)
    | [ H : (?x <=? ?y) = ?b |- _ ]
      => ltb_to_lt_with_hyp H (Zle_cases x y)
    | [ H : (?x >? ?y) = ?b |- _ ]
      => ltb_to_lt_with_hyp H (Zgt_cases x y)
    | [ H : (?x >=? ?y) = ?b |- _ ]
      => ltb_to_lt_with_hyp H (Zge_cases x y)
    | [ H : (?x =? ?y) = ?b |- _ ]
      => ltb_to_lt_with_hyp H (eqb_cases x y)
    end.
  Ltac ltb_to_lt_goal_step :=
    match goal with
    | [ |- (?x <? ?y) = ?b ]
      => ltb_to_lt_in_goal b (Z.ltb_spec0 x y)
    | [ |- (?x <=? ?y) = ?b ]
      => ltb_to_lt_in_goal b (Z.leb_spec0 x y)
    | [ |- (?x >? ?y) = ?b ]
      => ltb_to_lt_in_goal b (Z.gtb_spec0 x y)
    | [ |- (?x >=? ?y) = ?b ]
      => ltb_to_lt_in_goal b (Z.geb_spec0 x y)
    | [ |- (?x =? ?y) = ?b ]
      => ltb_to_lt_in_goal b (Z.eqb_spec x y)
    end.
  Ltac ltb_to_lt_step :=
    first [ ltb_to_lt_hyps_step
          | ltb_to_lt_goal_step ].
  Ltac ltb_to_lt := repeat ltb_to_lt_step.

  Section R_Rb.
    Local Ltac t := intros ? ? []; split; intro; ltb_to_lt; omega.
    Local Notation R_Rb Rb R nR := (forall x y b, Rb x y = b <-> if b then R x y else nR x y).
    Lemma ltb_lt_iff : R_Rb Z.ltb Z.lt Z.ge. Proof. t. Qed.
    Lemma leb_le_iff : R_Rb Z.leb Z.le Z.gt. Proof. t. Qed.
    Lemma gtb_gt_iff : R_Rb Z.gtb Z.gt Z.le. Proof. t. Qed.
    Lemma geb_ge_iff : R_Rb Z.geb Z.ge Z.lt. Proof. t. Qed.
    Lemma eqb_eq_iff : R_Rb Z.eqb (@Logic.eq Z) (fun x y => x <> y). Proof. t. Qed.
  End R_Rb.
  Hint Rewrite ltb_lt_iff leb_le_iff gtb_gt_iff geb_ge_iff eqb_eq_iff : ltb_to_lt.
  Ltac ltb_to_lt_in_context :=
    repeat autorewrite with ltb_to_lt in *;
    cbv beta iota in *.
End Z.


Require Export D.

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


Require Import Arith.
Require Import List.
Require Import Relations.
Require Import Wellfounded.
Require Import list_util.
Require Import ModEq.

Set Implicit Arguments.

Fixpoint combi (n k:nat) :=
  match k with |O => 1
               |S k'=> match n with |O => 0 |S n'=> combi n' k + combi n' k' end end.

Theorem Combi_0: forall n, combi n 0 = 1. Proof. intros. destruct n; simpl; auto. Qed.
Theorem Combi_1: forall n, combi n 1 = n. Proof. induction n; simpl; auto. rewrite IHn. rewrite Combi_0. rewrite plus_comm; auto. Qed.
Theorem Combi_lt: forall n k, n<k -> combi n k = 0. Proof. induction n; intros; auto. destruct k; auto. inversion H. destruct k. inversion H. simpl. rewrite IHn; auto. rewrite IHn; auto. Qed.
Theorem Combi_S: forall n k, combi (S n) (S k) = combi n (S k) + combi n k. Proof. intros. auto. Qed.
Theorem Combi_n_n: forall n, combi n n = 1. Proof. induction n; auto. rewrite Combi_S; auto. rewrite IHn. rewrite Combi_lt; auto. Qed.
Theorem Combi_fact: forall n k, k<=n -> combi n k * fact k * fact (n-k) = fact n. Proof. induction n; intros. inversion H; auto. destruct k. simpl. rewrite plus_n_O; auto. rewrite Combi_S. apply le_S_n in H. apply le_lt_or_eq in H. destruct H as [H|H]. replace (S n-S k) with (n-k); auto. rewrite <- mult_assoc. rewrite mult_plus_distr_r. replace (fact (n-k)) with (fact (n-S k)*(n-k)) at 1. repeat rewrite mult_assoc. rewrite IHn; auto.
  replace (fact (S k)) with (S k*fact k); auto. replace (combi n k*(S k*fact k)*fact (n-k)) with (combi n k*fact k*fact (n-k)*S k); auto. rewrite IHn; auto. rewrite <- mult_plus_distr_l. rewrite <- plus_n_Sm. rewrite plus_comm. rewrite <- le_plus_minus; auto. rewrite mult_comm; auto. repeat rewrite <- mult_assoc. f_equal. symmetry. rewrite mult_comm. rewrite mult_assoc; auto. replace (n-k) with (S(n-S k)). rewrite mult_comm; auto. rewrite minus_Sn_m; auto. subst k. rewrite Combi_lt; auto. rewrite Combi_n_n. rewrite <- minus_n_n. rewrite mult_1_r. auto. Qed.
Theorem Combi_nz: forall n k, k<=n -> combi n k<>0. Proof. induction n; intros. inversion H. simpl; auto. destruct k. simpl; auto. rewrite Combi_S. intros C. apply plus_is_O in C. destruct C. contradict H1. apply IHn; auto. Qed.
Lemma fact_Prime: forall p n, Prime p -> n<p -> ~Divide p (fact n). Proof. induction n; intros. intros C. apply Divide_le in C; auto. contradict C; auto. rewrite fact_S. intros C. apply Euclid_Prime in C; auto. destruct C. apply Divide_le in H1; auto. contradict H1; auto. contradict H1; auto. Qed.
Theorem Combi_Prime: forall p k, Prime p -> 0<k<p -> Divide p (combi p k). Proof. intros. destruct H0. assert (combi p k*fact k*fact (p-k)=fact p). apply Combi_fact; auto. assert (Divide p (combi p k*fact k*fact (p-k))). rewrite H2; auto. apply Euclid_Prime in H3; auto. destruct H3. apply Euclid_Prime in H3; auto. destruct H3; auto. contradict H3. apply fact_Prime; auto. contradict H3. apply fact_Prime; auto. destruct k. contradict H0; auto. destruct p; auto. simpl. apply le_lt_trans with p; auto. apply le_minus. Qed.

Theorem poly_combi: forall x y n, pow (x+y) n = fold_right plus 0 (map (fun k=>combi n k*pow x (n - k)*pow y k) (seq 0 (S n))). Proof. induction n. simpl; auto. rewrite powS. rewrite seqS. rewrite map_app. replace (map (fun k=>combi (S n) k*pow x (S n-k)*pow y k) (0+S n::nil)) with (pow y (S n)::nil). rewrite fold_plus_app. rewrite IHn. rewrite mult_plus_distr_r. rewrite seqS at 2. rewrite map_app. rewrite fold_plus_app. rewrite mult_plus_distr_l. rewrite plus_assoc. f_equal. replace (seq 0 (S n)) with (0::seq 1 n). simpl. rewrite mult_plus_distr_l. rewrite <- plus_assoc. f_equal. rewrite Combi_0. repeat rewrite mult_1_r. rewrite <- plus_n_O. f_equal. rewrite <- minus_n_O; auto. rewrite mult_fold_plus. rewrite mult_fold_plus. repeat rewrite mult_0_r. rewrite map_map. rewrite map_map. replace (seq 0 n) with (map (fun x=>x-1) (seq 1 n)). rewrite map_map. rewrite fold_plus_map.
  f_equal. apply map_ext_in. clear IHn. intros a Ha. apply in_seq in Ha. destruct Ha. simpl in H0. apply le_S_n in H0. destruct a. inversion H. replace (S a -1) with a. repeat rewrite mult_plus_distr_r. f_equal. rewrite mult_assoc. f_equal. rewrite mult_comm. rewrite <- mult_assoc. f_equal. rewrite mult_comm. rewrite <- powS. f_equal. rewrite minus_Sn_m; auto. rewrite mult_comm. repeat rewrite <- mult_assoc. f_equal. f_equal. rewrite powS; auto. simpl; rewrite <- minus_n_O; auto. clear -n. induction n. simpl; auto. repeat rewrite seqS. rewrite map_app. f_equal; auto. simpl. rewrite <- minus_n_O; auto. simpl; auto.
  simpl. repeat rewrite <- plus_n_O. f_equal. rewrite Combi_n_n. rewrite <- minus_n_n. rewrite mult_1_l; auto. simpl. f_equal. rewrite Combi_n_n. rewrite Combi_lt; auto. rewrite <- minus_n_n. rewrite mult_1_l; auto. Qed.

Theorem poly2: forall x y, pow (x+y) 2 = x*x + 2*x*y + y*y. Proof. intros. rewrite poly_combi. simpl. repeat rewrite <- plus_n_O. repeat rewrite mult_1_r. rewrite <- plus_assoc; auto. Qed.

Hint Resolve Combi_0 Combi_1 Combi_lt Combi_S Combi_n_n Combi_fact Combi_nz fact_Prime Combi_Prime poly_combi poly2.


(* ***** examples: intuitionistic logic ***** *)

(* The logical connectives for true, false, conjunction,
disjunction are defined by means of inductive predicates.
Roughly the constructors correspond to the introduction
rules, and the induction principle corresponds to the
elimination rules. *)

Print True.
(* True_ind states that P holds if we can prove True from it *)
Check True_ind.

Print False.
(* False_ind gives the elimination rule for False:
any P follows from False *)
Check False_ind.

Parameters A B C : Prop.
Lemma about_false: False -> A.

Proof.
intro x.
elim x.
(* alternative:
elimtype False.
assumption.      *)
(* alternative:
apply False_ind.
assumption.      *)
Qed.

Print and.
Check and_ind.

Lemma about_intro_and : A -> B -> A /\ B.

Proof.
intro x.
intro y.
split.
assumption.
assumption.
(* alternative:
apply conj.
assumption.
assumption.      *)
Qed.

Lemma about_elim_and : A /\ B -> C -> A.
(* elim or apply and_ind *)

Proof.
intros x y.
apply and_ind with A B.
intros.
assumption.
assumption.
Qed.

(* ***** examples: even ***** *)

(* an inductive definition of even *)
Inductive even : nat -> Prop :=
| evenO : even O
| evenSS : forall n:nat , even n -> even (S (S n)).

Check evenO.
Check (even O).
Check (even 1).
Check (evenSS O evenO).
Check (even 2).
Check (evenSS 2 (evenSS O evenO)).
Check (even 4).

(* example *)
Theorem evenzero : (even O).

Proof.
apply evenO.
Qed.

(* example *)
Theorem evenss : forall n:nat , (even n) -> (even (S (S n))).

Proof.
intro n.
intro H.
apply evenSS.
exact H.
Qed.

(*
alternative proof:
intro n.
intro H.
apply evenSS.
exact H.
Qed.
*)

(* ***** examples: le ***** *)

Inductive le (n:nat) : nat -> Prop :=
| le_n : le n n
| le_S : forall m:nat , le n m -> le n (S m).

Check (le 0).
Check (le 0 0). (* a type, which can be regarded as a
  proposition. We don't know whether the proposition
  is true or false yet. *)
Check (le_n 0). (* a value of the above type, which can
  be regarded as a proof that the above proposition
  is true. *)
Check (le 5 10).
Check (le_n 100).
Check (le_S 0 0 (le_n 0)).
Definition zero_smaller_than_one := (le_S 0 0 (le_n 0)).
Check zero_smaller_than_one.
Check (le_n 7).

(* We claim that zero is smaller than two.
  This is equivalent to giving a declaration of an
  identifier with the appropriate type.

  The proof of the claim is to give a value that has
  exactly this type.
*)
Lemma zero_smaller_than_two : le 0 (S (S 0)).
Proof.
apply le_S.
apply le_S.
apply le_n.
Qed.

(* what did we just do?
to prove: the type le 0 (S (S 0)) is inhabited

  last step in the proof: this is an axiom
le_n 0 : le 0 0
  because we know now that le_n is of type le 0 0, we can give this value as
  the second argument of the constructor of le_S.
le_S 0 (le_n 0) : le 0 (S 0)
  We have just proved that the *value* le_S 0 (le_n 0) is of *type* le 0 (S 0).
  As the last step, we apply the constructor le_S again.
le_S (S 0) (le_S 0 (le_n 0) : le 0 (S (S 0))
*)

(* Question: can we give a data-type "ancestor"? *)
Inductive ancestor (n:nat) : nat -> Prop :=
    (* the successor of a number is an ancestor of that number *)
  | anc_S : ancestor n (S n)
    (* the ancestor of the sucessor of n is also an ancestor of n*)
  | anc_anc : forall m:nat , ancestor n m -> ancestor n (S m)
  .

Check ancestor 100 0.
Check anc_S 0.

Check ancestor 1 0.
Check anc_anc 0 0.

(*
Lemma no_number_is_its_own_ancestor : forall m:nat , not (ancestor m m).
Proof.
unfold not.
intro m.
elim m.
intro.

Qed.
*)

(* examples: sorted *)

(* an inductive type for finite lists of natural numbers *)
Inductive natlist : Set :=
| nil : natlist
| cons : nat -> natlist -> natlist.

(* an inductive predicate sorted *)
Inductive sorted : natlist -> Prop :=
| sorted0 : sorted nil (* the empty list is sorted *)
| sorted1 : forall n:nat , sorted (cons n nil) (* the singleton list is sorted *)
(* if n < h
  and cons h t is sorted
 then cons n (cons h t) is sorted. *)
| sorted2 : forall n h:nat , forall t:natlist ,
            le n h -> sorted (cons h t) -> sorted (cons n (cons h t)).

Check (sorted1 1).
Definition list_one_sorted := (sorted1 1).
Check list_one_sorted.
Check (sorted2 O 1 nil zero_smaller_than_one list_one_sorted).
Definition list_zero_one_sorted := (sorted2 O 1 nil zero_smaller_than_one list_one_sorted).
Check list_zero_one_sorted.

(* ***** examples: inversion ***** *)
Parameter P : nat -> Prop.
Parameter Q : nat -> nat -> Prop.
Parameter R : natlist -> Prop.

Lemma one : forall n : nat, even n -> P n.

Proof.
intros n H.
apply even_ind.
inversion H.
Abort.

Lemma two : forall n m : nat, le n m -> Q n m.

intros n m H.
inversion H.
Abort.

Lemma three : forall l : natlist, sorted l -> R l.

Proof.
intros l H.
inversion H.
Abort.

(* *************** now the exercises start ********** *)
(* *************** we use definition given above **** *)

(* exercise 1 *)
Theorem even2 : (even 2 ).
Proof.
apply evenSS.
apply evenO.
Qed.

(* a few checks *)
Check evenO.
Check evenzero.
Print evenzero.
Check evenSS.
Check even2.
Print even2.

(* exercise 2
   use inversion *)
Theorem noteven1 : ~(even 1).
Proof.
intro.
inversion H.
Qed.

(* exercise 3
   you may want to use an earlier proved result *)
Theorem even4 : even 4.
Proof.
apply evenSS.
apply even2.
Qed.

(* exercise 4 *)
Theorem noteven3 : ~(even 3).
Proof.
intro.
inversion H.
apply noteven1.
assumption.
Qed.

(* an inductive definition of even and odd *)
Inductive ev : nat -> Prop :=
| evO : ev O
| evS : forall n:nat , odd n -> ev (S n)
with odd : nat -> Prop :=
| oddS : forall n:nat , ev n -> odd (S n).

(* example *)
Theorem evzero : ev O.
Proof.
exact evO.
Qed.

(* example *)
Theorem odd1 : odd 1.
Proof.
exact (oddS O evzero).
Qed.

(* exercise 5 *)
Theorem ev2 : ev 2.
Proof.
apply evS.
apply odd1.
Qed.

(* exercise 6 *)
Theorem notodd2 : ~ odd 2.
Proof.
intro.
inversion H.
inversion H1.
inversion H3.
Qed.

(* exercise 7
   use induction *)
Theorem evorodd : forall n:nat, ev n \/ odd n.
Proof.
intro.
induction n.
left.
exact evO.
inversion IHn.
right.
apply oddS.
assumption.
left.
apply evS.
assumption.
Qed.

(* exercise 8 *)
Theorem zero_and_zero : le O O.
Proof.
exact (le_n 0).
Qed.

(* exercise 9 *)
Theorem zero_and_one  : le 0 1.
Proof.
exact (le_S 0 0 zero_and_zero).
Qed.

(* some checks *)
Print zero_and_one.
Check zero_and_one.

(* exercise 10 *)
Theorem one_and_zero : ~ (le 1 0).
Proof.
intro.
inversion H.
Qed.

(* exercise 11 *)
Theorem sortednil : sorted nil.
Proof.
exact sorted0.
Qed.

(* exercise 12 *)
Theorem sortedone : sorted (cons 0 nil).
Proof.
Print sorted.
exact (sorted1 0).
Qed.

(* exercise 13 *)
Theorem sorted_one_two_three :
  sorted (cons 1 (cons 2 (cons 3 nil))).
Proof.
Print sorted.
apply sorted2.
Lemma le_succ : forall n , le n (S n).
Proof.
intro.
apply le_S.
apply le_n.
Qed.
apply le_succ.
apply sorted2.
apply le_succ.
apply sorted1.
Qed.

(* exercise 14 *)
Theorem sorted_tail :
  forall (n : nat) (l : natlist),
  sorted (cons n l) ->
  sorted l.
Proof.
intros.
inversion H.
exact sorted0.
assumption.
Qed.

(* given for exercise 15
   without_last n k l holds if
   n is the last element of k
   and
   l is k without the last element *)
Inductive without_last (n:nat) : natlist -> natlist -> Prop :=
| without_last_one :
  without_last n (cons n nil) nil
| without_last_more :
    forall m:nat, forall l k : natlist,
    without_last n k l -> without_last n (cons m k) (cons m l).

(* exercise 15 *)
(* define a predicate palindrome : natlist -> Prop
   that holds exactly if the input list is equal to its reverse.
   use three clauses: for the empty list, for a list of one
   element, for a list of two or more elements *)

Inductive palindrome : natlist -> Prop :=
  | pali_nil : palindrome nil
  | pali_one : forall n:nat, palindrome (cons n nil)
  | pali_more : forall n:nat, forall l k:natlist,
        without_last n k l -> palindrome l -> palindrome (cons n k)
  .

  (* l ++  [n]   and  l is a palindrome, then    n : k      is a palindrome
     |-- k --|                                n : l ++ [n]*)

(*
vim: filetype=coq
*)