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

(*i $Id: Zdiv.v 14641 2011-11-06 11:59:10Z herbelin $ i*)

(* Contribution by Claude Marché and Xavier Urbain *)

(** Euclidean Division

    Defines first of function that allows Coq to normalize.
    Then only after proves the main required property.
*)

Require Export ZArith_base.
Require Import Zbool.
Require Import Omega.
Require Import ZArithRing.
Require Import Zcomplements.
Require Export Setoid.
Open Local Scope Z_scope.

(** * Definitions of Euclidian operations *)

(** Euclidean division of a positive by a integer
    (that is supposed to be positive).

    Total function than returns an arbitrary value when
    divisor is not positive

*)

Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) : Z * Z :=
  match a with
    | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
    | xO a' =>
      let (q, r) := Zdiv_eucl_POS a' b in
	let r' := 2 * r in
	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
    | xI a' =>
      let (q, r) := Zdiv_eucl_POS a' b in
	let r' := 2 * r + 1 in
	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
  end.

(** Euclidean division of integers.

    Total function than returns (0,0) when dividing by 0.
*)

(**

  The pseudo-code is:

  if b = 0 : (0,0)

  if b <> 0 and a = 0 : (0,0)

  if b > 0 and a < 0 : let (q,r) = div_eucl_pos (-a) b in
                       if r = 0 then (-q,0) else (-(q+1),b-r)

  if b < 0 and a < 0 : let (q,r) = div_eucl (-a) (-b) in (q,-r)

  if b < 0 and a > 0 : let (q,r) = div_eucl a (-b) in
                       if r = 0 then (-q,0) else (-(q+1),b+r)

  In other word, when b is non-zero, q is chosen to be the greatest integer
  smaller or equal to a/b. And sgn(r)=sgn(b) and |r| < |b| (at least when
  r is not null).
*)

(* Nota: At least two others conventions also exist for euclidean division.
   They all satify the equation a=b*q+r, but differ on the choice of (q,r)
   on negative numbers.

   * Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b).
     Hence (-a) mod b = - (a mod b)
           a mod (-b) = a mod b
     And: |r| < |b| and sgn(r) = sgn(a)  (notice the a here instead of b).

   * Another solution is to always pick a non-negative remainder:
     a=b*q+r with 0 <= r < |b|
*)

Definition Zdiv_eucl (a b:Z) : Z * Z :=
  match a, b with
    | Z0, _ => (0, 0)
    | _, Z0 => (0, 0)
    | Zpos a', Zpos _ => Zdiv_eucl_POS a' b
    | Zneg a', Zpos _ =>
      let (q, r) := Zdiv_eucl_POS a' b in
	match r with
	  | Z0 => (- q, 0)
	  | _ => (- (q + 1), b - r)
	end
    | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r)
    | Zpos a', Zneg b' =>
      let (q, r) := Zdiv_eucl_POS a' (Zpos b') in
	match r with
	  | Z0 => (- q, 0)
	  | _ => (- (q + 1), b + r)
	end
  end.

(** Division and modulo are projections of [Zdiv_eucl] *)

Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q.

Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r.

(** Syntax *)

Infix "/" := Zdiv : Z_scope.
Infix "mod" := Zmod (at level 40, no associativity) : Z_scope.

(* Tests:

Eval compute in (Zdiv_eucl 7 3).

Eval compute in (Zdiv_eucl (-7) 3).

Eval compute in (Zdiv_eucl 7 (-3)).

Eval compute in (Zdiv_eucl (-7) (-3)).

*)

(** * Main division theorem *)

(** First a lemma for two positive arguments *)

Lemma Z_div_mod_POS :
  forall b:Z,
    b > 0 ->
    forall a:positive,
      let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b.
Proof.
simple induction a; cbv beta iota delta [Zdiv_eucl_POS] in |- *;
  fold Zdiv_eucl_POS in |- *; cbv zeta.

intro p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
generalize (Zgt_cases b (2 * r + 1)).
case (Zgt_bool b (2 * r + 1));
 (rewrite BinInt.Zpos_xI; rewrite H0; split; [ ring | omega ]).

intros p; case (Zdiv_eucl_POS p b); intros q r [H0 H1].
generalize (Zgt_cases b (2 * r)).
case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO;
 change (Zpos (xO p)) with (2 * Zpos p) in |- *; rewrite H0;
 (split; [ ring | omega ]).

generalize (Zge_cases b 2).
case (Zge_bool b 2); (intros; split; [ try ring | omega ]).
omega.
Qed.

(** Then the usual situation of a positive [b] and no restriction on [a] *)

Theorem Z_div_mod :
  forall a b:Z,
    b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b.
Proof.
  intros a b; case a; case b; try (simpl in |- *; intros; omega).
  unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial.

  intros; discriminate.

  intros.
  generalize (Z_div_mod_POS (Zpos p) H p0).
  unfold Zdiv_eucl in |- *.
  case (Zdiv_eucl_POS p0 (Zpos p)).
  intros z z0.
  case z0.

  intros [H1 H2].
  split; trivial.
  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.

  intros p1 [H1 H2].
  split; trivial.
  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.
  generalize (Zorder.Zgt_pos_0 p1); omega.

  intros p1 [H1 H2].
  split; trivial.
  change (Zneg p0) with (- Zpos p0); rewrite H1; ring.
  generalize (Zorder.Zlt_neg_0 p1); omega.

  intros; discriminate.
Qed.

(** For stating the fully general result, let's give a short name
    to the condition on the remainder. *)

Definition Remainder r b :=  0 <= r < b \/ b < r <= 0.

(** Another equivalent formulation: *)

Definition Remainder_alt r b :=  Zabs r < Zabs b /\ Zsgn r <> - Zsgn b.

(* In the last formulation, [ Zsgn r <> - Zsgn b ] is less nice than saying
    [ Zsgn r = Zsgn b ], but at least it works even when [r] is null. *)

Lemma Remainder_equiv : forall r b, Remainder r b <-> Remainder_alt r b.
Proof.
 intros; unfold Remainder, Remainder_alt; omega with *.
Qed.

Hint Unfold Remainder.

(** Now comes the fully general result about Euclidean division. *)

Theorem Z_div_mod_full :
  forall a b:Z,
    b <> 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ Remainder r b.
Proof.
  destruct b as [|b|b].
  (* b = 0 *)
  intro H; elim H; auto.
  (* b > 0 *)
  intros _.
  assert (Zpos b > 0) by auto with zarith.
  generalize (Z_div_mod a (Zpos b) H).
  destruct Zdiv_eucl as (q,r); intuition; simpl; auto.
  (* b < 0 *)
  intros _.
  assert (Zpos b > 0) by auto with zarith.
  generalize (Z_div_mod a (Zpos b) H).
  unfold Remainder.
  destruct a as [|a|a].
  (* a = 0 *)
  simpl; intuition.
  (* a > 0 *)
  unfold Zdiv_eucl; destruct Zdiv_eucl_POS as (q,r).
  destruct r as [|r|r]; [ | | omega with *].
  rewrite <- Zmult_opp_comm; simpl Zopp; intuition.
  rewrite <- Zmult_opp_comm; simpl Zopp.
  rewrite Zmult_plus_distr_r; omega with *.
  (* a < 0 *)
  unfold Zdiv_eucl.
  generalize (Z_div_mod_POS (Zpos b) H a).
  destruct Zdiv_eucl_POS as (q,r).
  destruct r as [|r|r]; change (Zneg b) with (-Zpos b).
  rewrite Zmult_opp_comm; omega with *.
  rewrite <- Zmult_opp_comm, Zmult_plus_distr_r;
   repeat rewrite Zmult_opp_comm; omega.
  rewrite Zmult_opp_comm; omega with *.
Qed.

(** The same results as before, stated separately in terms of Zdiv and Zmod *)

Lemma Z_mod_remainder : forall a b:Z, b<>0 -> Remainder (a mod b) b.
Proof.
  unfold Zmod; intros a b Hb; generalize (Z_div_mod_full a b Hb); auto.
  destruct Zdiv_eucl; tauto.
Qed.

Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= a mod b < b.
Proof.
  unfold Zmod; intros a b Hb; generalize (Z_div_mod a b Hb).
  destruct Zdiv_eucl; tauto.
Qed.

Lemma Z_mod_neg : forall a b:Z, b < 0 -> b < a mod b <= 0.
Proof.
  unfold Zmod; intros a b Hb.
  assert (Hb' : b<>0) by (auto with zarith).
  generalize (Z_div_mod_full a b Hb').
  destruct Zdiv_eucl.
  unfold Remainder; intuition.
Qed.

Lemma Z_div_mod_eq_full : forall a b:Z, b <> 0 -> a = b*(a/b) + (a mod b).
Proof.
  unfold Zdiv, Zmod; intros a b Hb; generalize (Z_div_mod_full a b Hb).
  destruct Zdiv_eucl; tauto.
Qed.

Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b*(a/b) + (a mod b).
Proof.
  intros; apply Z_div_mod_eq_full; auto with zarith.
Qed.

Lemma Zmod_eq_full : forall a b:Z, b<>0 -> a mod b = a - (a/b)*b.
Proof.
  intros.
  rewrite <- Zeq_plus_swap, Zplus_comm, Zmult_comm; symmetry.
  apply Z_div_mod_eq_full; auto.
Qed.

Lemma Zmod_eq : forall a b:Z, b>0 -> a mod b = a - (a/b)*b.
Proof.
  intros.
  rewrite <- Zeq_plus_swap, Zplus_comm, Zmult_comm; symmetry.
  apply Z_div_mod_eq; auto.
Qed.

(** Existence theorem *)

Theorem Zdiv_eucl_exist : forall (b:Z)(Hb:b>0)(a:Z),
 {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}.
Proof.
  intros b Hb a.
  exists (Zdiv_eucl a b).
  exact (Z_div_mod a b Hb).
Qed.

Implicit Arguments Zdiv_eucl_exist.

(** Uniqueness theorems *)

Theorem Zdiv_mod_unique :
 forall b q1 q2 r1 r2:Z,
  0 <= r1 < Zabs b -> 0 <= r2 < Zabs b ->
  b*q1+r1 = b*q2+r2 -> q1=q2 /\ r1=r2.
Proof.
intros b q1 q2 r1 r2 Hr1 Hr2 H.
destruct (Z_eq_dec q1 q2) as [Hq|Hq].
split; trivial.
rewrite Hq in H; omega.
elim (Zlt_not_le (Zabs (r2 - r1)) (Zabs b)).
omega with *.
replace (r2-r1) with (b*(q1-q2)) by (rewrite Zmult_minus_distr_l; omega).
replace (Zabs b) with ((Zabs b)*1) by ring.
rewrite Zabs_Zmult.
apply Zmult_le_compat_l; auto with *.
omega with *.
Qed.

Theorem Zdiv_mod_unique_2 :
 forall b q1 q2 r1 r2:Z,
  Remainder r1 b -> Remainder r2 b ->
  b*q1+r1 = b*q2+r2 -> q1=q2 /\ r1=r2.
Proof.
unfold Remainder.
intros b q1 q2 r1 r2 Hr1 Hr2 H.
destruct (Z_eq_dec q1 q2) as [Hq|Hq].
split; trivial.
rewrite Hq in H; omega.
elim (Zlt_not_le (Zabs (r2 - r1)) (Zabs b)).
omega with *.
replace (r2-r1) with (b*(q1-q2)) by (rewrite Zmult_minus_distr_l; omega).
replace (Zabs b) with ((Zabs b)*1) by ring.
rewrite Zabs_Zmult.
apply Zmult_le_compat_l; auto with *.
omega with *.
Qed.

Theorem Zdiv_unique_full:
 forall a b q r, Remainder r b ->
   a = b*q + r -> q = a/b.
Proof.
  intros.
  assert (b <> 0) by (unfold Remainder in *; omega with *).
  generalize (Z_div_mod_full a b H1).
  unfold Zdiv; destruct Zdiv_eucl as (q',r').
  intros (H2,H3); rewrite H2 in H0.
  destruct (Zdiv_mod_unique_2 b q q' r r'); auto.
Qed.

Theorem Zdiv_unique:
 forall a b q r, 0 <= r < b ->
   a = b*q + r -> q = a/b.
Proof.
  intros; eapply Zdiv_unique_full; eauto.
Qed.

Theorem Zmod_unique_full:
 forall a b q r, Remainder r b ->
  a = b*q + r ->  r = a mod b.
Proof.
  intros.
  assert (b <> 0) by (unfold Remainder in *; omega with *).
  generalize (Z_div_mod_full a b H1).
  unfold Zmod; destruct Zdiv_eucl as (q',r').
  intros (H2,H3); rewrite H2 in H0.
  destruct (Zdiv_mod_unique_2 b q q' r r'); auto.
Qed.

Theorem Zmod_unique:
 forall a b q r, 0 <= r < b ->
  a = b*q + r -> r = a mod b.
Proof.
  intros; eapply Zmod_unique_full; eauto.
Qed.

(** * Basic values of divisions and modulo. *)

Lemma Zmod_0_l: forall a, 0 mod a = 0.
Proof.
  destruct a; simpl; auto.
Qed.

Lemma Zmod_0_r: forall a, a mod 0 = 0.
Proof.
  destruct a; simpl; auto.
Qed.

Lemma Zdiv_0_l: forall a, 0/a = 0.
Proof.
  destruct a; simpl; auto.
Qed.

Lemma Zdiv_0_r: forall a, a/0 = 0.
Proof.
  destruct a; simpl; auto.
Qed.

Lemma Zmod_1_r: forall a, a mod 1 = 0.
Proof.
  intros; symmetry; apply Zmod_unique with a; auto with zarith.
Qed.

Lemma Zdiv_1_r: forall a, a/1 = a.
Proof.
  intros; symmetry; apply Zdiv_unique with 0; auto with zarith.
Qed.

Hint Resolve Zmod_0_l Zmod_0_r Zdiv_0_l Zdiv_0_r Zdiv_1_r Zmod_1_r
 : zarith.

Lemma Zdiv_1_l: forall a, 1 < a -> 1/a = 0.
Proof.
  intros; symmetry; apply Zdiv_unique with 1; auto with zarith.
Qed.

Lemma Zmod_1_l: forall a, 1 < a ->  1 mod a = 1.
Proof.
  intros; symmetry; apply Zmod_unique with 0; auto with zarith.
Qed.

Lemma Z_div_same_full : forall a:Z, a<>0 -> a/a = 1.
Proof.
  intros; symmetry; apply Zdiv_unique_full with 0; auto with *; red; omega.
Qed.

Lemma Z_mod_same_full : forall a, a mod a = 0.
Proof.
  destruct a; intros; symmetry.
  compute; auto.
  apply Zmod_unique with 1; auto with *; omega with *.
  apply Zmod_unique_full with 1; auto with *; red; omega with *.
Qed.

Lemma Z_mod_mult : forall a b, (a*b) mod b = 0.
Proof.
  intros a b; destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst; simpl; rewrite Zmod_0_r; auto.
  symmetry; apply Zmod_unique_full with a; [ red; omega | ring ].
Qed.

Lemma Z_div_mult_full : forall a b:Z, b <> 0 -> (a*b)/b = a.
Proof.
  intros; symmetry; apply Zdiv_unique_full with 0; auto with zarith;
   [ red; omega | ring].
Qed.

(** * Order results about Zmod and Zdiv *)

(* Division of positive numbers is positive. *)

Lemma Z_div_pos: forall a b, b > 0 -> 0 <= a -> 0 <= a/b.
Proof.
  intros.
  rewrite (Z_div_mod_eq a b H) in H0.
  assert (H1:=Z_mod_lt a b H).
  destruct (Z_lt_le_dec (a/b) 0); auto.
  assert (b*(a/b) <= -b).
   replace (-b) with (b*-1); [ | ring].
   apply Zmult_le_compat_l; auto with zarith.
  omega.
Qed.

Lemma Z_div_ge0: forall a b, b > 0 -> a >= 0 -> a/b >=0.
Proof.
  intros; generalize (Z_div_pos a b H); auto with zarith.
Qed.

(** As soon as the divisor is greater or equal than 2,
    the division is strictly decreasing. *)

Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> a/b < a.
Proof.
  intros. cut (b > 0); [ intro Hb | omega ].
  generalize (Z_div_mod a b Hb).
  cut (a >= 0); [ intro Ha | omega ].
  generalize (Z_div_ge0 a b Hb Ha).
  unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3].
  cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ].
  apply Zge_trans with (b * q).
  omega.
  auto with zarith.
Qed.

(** A division of a small number by a bigger one yields zero. *)

Theorem Zdiv_small: forall a b, 0 <= a < b -> a/b = 0.
Proof.
  intros a b H; apply sym_equal; apply Zdiv_unique with a; auto with zarith.
Qed.

(** Same situation, in term of modulo: *)

Theorem Zmod_small: forall a n, 0 <= a < n -> a mod n = a.
Proof.
  intros a b H; apply sym_equal; apply Zmod_unique with 0; auto with zarith.
Qed.

(** [Zge] is compatible with a positive division. *)

Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a/c >= b/c.
Proof.
  intros a b c cPos aGeb.
  generalize (Z_div_mod_eq a c cPos).
  generalize (Z_mod_lt a c cPos).
  generalize (Z_div_mod_eq b c cPos).
  generalize (Z_mod_lt b c cPos).
  intros.
  elim (Z_ge_lt_dec (a / c) (b / c)); trivial.
  intro.
  absurd (b - a >= 1).
  omega.
  replace (b-a) with (c * (b/c-a/c) + b mod c - a mod c) by
    (symmetry; pattern a at 1; rewrite H2; pattern b at 1; rewrite H0; ring).
  assert (c * (b / c - a / c) >= c * 1).
  apply Zmult_ge_compat_l.
  omega.
  omega.
  assert (c * 1 = c).
  ring.
  omega.
Qed.

(** Same, with [Zle]. *)

Lemma Z_div_le : forall a b c:Z, c > 0 -> a <= b -> a/c <= b/c.
Proof.
  intros a b c H H0.
  apply Zge_le.
  apply Z_div_ge; auto with *.
Qed.

(** With our choice of division, rounding of (a/b) is always done toward bottom: *)

Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b*(a/b) <= a.
Proof.
  intros a b H; generalize (Z_div_mod_eq a b H) (Z_mod_lt a b H); omega.
Qed.

Lemma Z_mult_div_ge_neg : forall a b:Z, b < 0 -> b*(a/b) >= a.
Proof.
  intros a b H.
  generalize (Z_div_mod_eq_full a _ (Zlt_not_eq _ _ H)) (Z_mod_neg a _ H); omega.
Qed.

(** The previous inequalities are exact iff the modulo is zero. *)

Lemma Z_div_exact_full_1 : forall a b:Z, a = b*(a/b) -> a mod b = 0.
Proof.
  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst b; simpl in *; subst; auto.
  generalize (Z_div_mod_eq_full a b Hb); omega.
Qed.

Lemma Z_div_exact_full_2 : forall a b:Z, b <> 0 -> a mod b = 0 -> a = b*(a/b).
Proof.
  intros; generalize (Z_div_mod_eq_full a b H); omega.
Qed.

(** A modulo cannot grow beyond its starting point. *)

Theorem Zmod_le: forall a b, 0 < b -> 0 <= a -> a mod b <= a.
Proof.
  intros a b H1 H2; case (Zle_or_lt b a); intros H3.
  case (Z_mod_lt a b); auto with zarith.
  rewrite Zmod_small; auto with zarith.
Qed.

(** Some additionnal inequalities about Zdiv. *)

Theorem Zdiv_lt_upper_bound:
  forall a b q, 0 < b -> a < q*b -> a/b < q.
Proof.
  intros a b q H1 H2.
  apply Zmult_lt_reg_r with b; auto with zarith.
  apply Zle_lt_trans with (2 := H2).
  pattern a at 2; rewrite (Z_div_mod_eq a b); auto with zarith.
  rewrite (Zmult_comm b); case (Z_mod_lt a b); auto with zarith.
Qed.

Theorem Zdiv_le_upper_bound:
  forall a b q, 0 < b -> a <= q*b -> a/b <= q.
Proof.
  intros.
  rewrite <- (Z_div_mult_full q b); auto with zarith.
  apply Z_div_le; auto with zarith.
Qed.

Theorem Zdiv_le_lower_bound:
  forall a b q, 0 < b -> q*b <= a -> q <= a/b.
Proof.
  intros.
  rewrite <- (Z_div_mult_full q b); auto with zarith.
  apply Z_div_le; auto with zarith.
Qed.

(** A division of respect opposite monotonicity for the divisor *)

Lemma Zdiv_le_compat_l: forall p q r, 0 <= p -> 0 < q < r ->
    p / r <= p / q.
Proof.
  intros p q r H H1.
  apply Zdiv_le_lower_bound; auto with zarith.
  rewrite Zmult_comm.
  pattern p at 2; rewrite (Z_div_mod_eq p r); auto with zarith.
  apply Zle_trans with (r * (p / r)); auto with zarith.
  apply Zmult_le_compat_r; auto with zarith.
  apply Zdiv_le_lower_bound; auto with zarith.
  case (Z_mod_lt p r); auto with zarith.
Qed.

Theorem Zdiv_sgn: forall a b,
  0 <= Zsgn (a/b) * Zsgn a * Zsgn b.
Proof.
  destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith;
  generalize (Z_div_pos (Zpos a) (Zpos b)); unfold Zdiv, Zdiv_eucl;
  destruct Zdiv_eucl_POS as (q,r); destruct r; omega with *.
Qed.

(** * Relations between usual operations and Zmod and Zdiv *)

Lemma Z_mod_plus_full : forall a b c:Z, (a + b * c) mod c = a mod c.
Proof.
  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
  subst; do 2 rewrite Zmod_0_r; auto.
  symmetry; apply Zmod_unique_full with (a/c+b); auto with zarith.
  red; generalize (Z_mod_lt a c)(Z_mod_neg a c); omega.
  rewrite Zmult_plus_distr_r, Zmult_comm.
  generalize (Z_div_mod_eq_full a c Hc); omega.
Qed.

Lemma Z_div_plus_full : forall a b c:Z, c <> 0 -> (a + b * c) / c = a / c + b.
Proof.
  intro; symmetry.
  apply Zdiv_unique_full with (a mod c); auto with zarith.
  red; generalize (Z_mod_lt a c)(Z_mod_neg a c); omega.
  rewrite Zmult_plus_distr_r, Zmult_comm.
  generalize (Z_div_mod_eq_full a c H); omega.
Qed.

Theorem Z_div_plus_full_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b.
Proof.
  intros a b c H; rewrite Zplus_comm; rewrite Z_div_plus_full;
  try apply Zplus_comm; auto with zarith.
Qed.

(** [Zopp] and [Zdiv], [Zmod].
    Due to the choice of convention for our Euclidean division,
    some of the relations about [Zopp] and divisions are rather complex. *)

Lemma Zdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b.
Proof.
  intros [|a|a] [|b|b]; try reflexivity; unfold Zdiv; simpl;
  destruct (Zdiv_eucl_POS a (Zpos b)); destruct z0; try reflexivity.
Qed.

Lemma Zmod_opp_opp : forall a b:Z, (-a) mod (-b) = - (a mod b).
Proof.
  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst; do 2 rewrite Zmod_0_r; auto.
  intros; symmetry.
  apply Zmod_unique_full with ((-a)/(-b)); auto.
  generalize (Z_mod_remainder a b Hb); destruct 1; [right|left]; omega.
  rewrite Zdiv_opp_opp.
  pattern a at 1; rewrite (Z_div_mod_eq_full a b Hb); ring.
Qed.

Lemma Z_mod_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a) mod b = 0.
Proof.
  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst; rewrite Zmod_0_r; auto.
  rewrite Z_div_exact_full_2 with a b; auto.
  replace (- (b * (a / b))) with (0 + - (a / b) * b).
  rewrite Z_mod_plus_full; auto.
  ring.
Qed.

Lemma Z_mod_nz_opp_full : forall a b:Z, a mod b <> 0 ->
 (-a) mod b = b - (a mod b).
Proof.
  intros.
  assert (b<>0) by (contradict H; subst; rewrite Zmod_0_r; auto).
  symmetry; apply Zmod_unique_full with (-1-a/b); auto.
  generalize (Z_mod_remainder a b H0); destruct 1; [left|right]; omega.
  rewrite Zmult_minus_distr_l.
  pattern a at 1; rewrite (Z_div_mod_eq_full a b H0); ring.
Qed.

Lemma Z_mod_zero_opp_r : forall a b:Z, a mod b = 0 -> a mod (-b) = 0.
Proof.
  intros.
  rewrite <- (Zopp_involutive a).
  rewrite Zmod_opp_opp.
  rewrite Z_mod_zero_opp_full; auto.
Qed.

Lemma Z_mod_nz_opp_r : forall a b:Z, a mod b <> 0 ->
 a mod (-b) = (a mod b) - b.
Proof.
  intros.
  pattern a at 1; rewrite <- (Zopp_involutive a).
  rewrite Zmod_opp_opp.
  rewrite Z_mod_nz_opp_full; auto; omega.
Qed.

Lemma Z_div_zero_opp_full : forall a b:Z, a mod b = 0 -> (-a)/b = -(a/b).
Proof.
  intros; destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst; do 2 rewrite Zdiv_0_r; auto.
  symmetry; apply Zdiv_unique_full with 0; auto.
  red; omega.
  pattern a at 1; rewrite (Z_div_mod_eq_full a b Hb).
  rewrite H; ring.
Qed.

Lemma Z_div_nz_opp_full : forall a b:Z, a mod b <> 0 ->
 (-a)/b = -(a/b)-1.
Proof.
  intros.
  assert (b<>0) by (contradict H; subst; rewrite Zmod_0_r; auto).
  symmetry; apply Zdiv_unique_full with (b-a mod b); auto.
  generalize (Z_mod_remainder a b H0); destruct 1; [left|right]; omega.
  pattern a at 1; rewrite (Z_div_mod_eq_full a b H0); ring.
Qed.

Lemma Z_div_zero_opp_r : forall a b:Z, a mod b = 0 -> a/(-b) = -(a/b).
Proof.
  intros.
  pattern a at 1; rewrite <- (Zopp_involutive a).
  rewrite Zdiv_opp_opp.
  rewrite Z_div_zero_opp_full; auto.
Qed.

Lemma Z_div_nz_opp_r : forall a b:Z, a mod b <> 0 ->
 a/(-b) = -(a/b)-1.
Proof.
  intros.
  pattern a at 1; rewrite <- (Zopp_involutive a).
  rewrite Zdiv_opp_opp.
  rewrite Z_div_nz_opp_full; auto; omega.
Qed.

(** Cancellations. *)

Lemma Zdiv_mult_cancel_r : forall a b c:Z,
 c <> 0 -> (a*c)/(b*c) = a/b.
Proof.
assert (X: forall a b c, b > 0 -> c > 0 -> (a*c) / (b*c) = a / b).
 intros a b c Hb Hc.
 symmetry.
 apply Zdiv_unique with ((a mod b)*c); auto with zarith.
 destruct (Z_mod_lt a b Hb); split.
 apply Zmult_le_0_compat; auto with zarith.
 apply Zmult_lt_compat_r; auto with zarith.
 pattern a at 1; rewrite (Z_div_mod_eq a b Hb); ring.
intros a b c Hc.
destruct (Z_dec b 0) as [Hb|Hb].
destruct Hb as [Hb|Hb]; destruct (not_Zeq_inf _ _ Hc); auto with *.
rewrite <- (Zdiv_opp_opp a), <- (Zmult_opp_opp b), <-(Zmult_opp_opp a);
 auto with *.
rewrite <- (Zdiv_opp_opp a), <- Zdiv_opp_opp, Zopp_mult_distr_l,
 Zopp_mult_distr_l; auto with *.
rewrite <- Zdiv_opp_opp, Zopp_mult_distr_r, Zopp_mult_distr_r; auto with *.
rewrite Hb; simpl; do 2 rewrite Zdiv_0_r; auto.
Qed.

Lemma Zdiv_mult_cancel_l : forall a b c:Z,
 c<>0 -> (c*a)/(c*b) = a/b.
Proof.
  intros.
  rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
  apply Zdiv_mult_cancel_r; auto.
Qed.

Lemma Zmult_mod_distr_l: forall a b c,
  (c*a) mod (c*b) = c * (a mod b).
Proof.
  intros; destruct (Z_eq_dec c 0) as [Hc|Hc].
  subst; simpl; rewrite Zmod_0_r; auto.
  destruct (Z_eq_dec b 0) as [Hb|Hb].
  subst; repeat rewrite Zmult_0_r || rewrite Zmod_0_r; auto.
  assert (c*b <> 0).
   contradict Hc; eapply Zmult_integral_l; eauto.
  rewrite (Zplus_minus_eq _ _ _ (Z_div_mod_eq_full (c*a) (c*b) H)).
  rewrite (Zplus_minus_eq _ _ _ (Z_div_mod_eq_full a b Hb)).
  rewrite Zdiv_mult_cancel_l; auto with zarith.
  ring.
Qed.

Lemma Zmult_mod_distr_r: forall a b c,
  (a*c) mod (b*c) = (a mod b) * c.
Proof.
  intros; repeat rewrite (fun x => (Zmult_comm x c)).
  apply Zmult_mod_distr_l; auto.
Qed.

(** Operations modulo. *)

Theorem Zmod_mod: forall a n, (a mod n) mod n = a mod n.
Proof.
  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
  subst; do 2 rewrite Zmod_0_r; auto.
  pattern a at 2; rewrite (Z_div_mod_eq_full a n); auto with zarith.
  rewrite Zplus_comm; rewrite Zmult_comm.
  apply sym_equal; apply Z_mod_plus_full; auto with zarith.
Qed.

Theorem Zmult_mod: forall a b n,
 (a * b) mod n = ((a mod n) * (b mod n)) mod n.
Proof.
  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
  subst; do 2 rewrite Zmod_0_r; auto.
  pattern a at 1; rewrite (Z_div_mod_eq_full a n); auto with zarith.
  pattern b at 1; rewrite (Z_div_mod_eq_full b n); auto with zarith.
  set (A:=a mod n); set (B:=b mod n); set (A':=a/n); set (B':=b/n).
  replace ((n*A' + A) * (n*B' + B))
   with (A*B + (A'*B+B'*A+n*A'*B')*n) by ring.
  apply Z_mod_plus_full; auto with zarith.
Qed.

Theorem Zplus_mod: forall a b n,
 (a + b) mod n = (a mod n + b mod n) mod n.
Proof.
  intros; destruct (Z_eq_dec n 0) as [Hb|Hb].
  subst; do 2 rewrite Zmod_0_r; auto.
  pattern a at 1; rewrite (Z_div_mod_eq_full a n); auto with zarith.
  pattern b at 1; rewrite (Z_div_mod_eq_full b n); auto with zarith.
  replace ((n * (a / n) + a mod n) + (n * (b / n) + b mod n))
     with ((a mod n + b mod n) + (a / n + b / n) * n) by ring.
  apply Z_mod_plus_full; auto with zarith.
Qed.

Theorem Zminus_mod: forall a b n,
 (a - b) mod n = (a mod n - b mod n) mod n.
Proof.
  intros.
  replace (a - b) with (a + (-1) * b); auto with zarith.
  replace (a mod n - b mod n) with (a mod n + (-1) * (b mod n)); auto with zarith.
  rewrite Zplus_mod.
  rewrite Zmult_mod.
  rewrite Zplus_mod with (b:=(-1) * (b mod n)).
  rewrite Zmult_mod.
  rewrite Zmult_mod with (b:= b mod n).
  repeat rewrite Zmod_mod; auto.
Qed.

Lemma Zplus_mod_idemp_l: forall a b n, (a mod n + b) mod n = (a + b) mod n.
Proof.
  intros; rewrite Zplus_mod, Zmod_mod, <- Zplus_mod; auto.
Qed.

Lemma Zplus_mod_idemp_r: forall a b n, (b + a mod n) mod n = (b + a) mod n.
Proof.
  intros; rewrite Zplus_mod, Zmod_mod, <- Zplus_mod; auto.
Qed.

Lemma Zminus_mod_idemp_l: forall a b n, (a mod n - b) mod n = (a - b) mod n.
Proof.
  intros; rewrite Zminus_mod, Zmod_mod, <- Zminus_mod; auto.
Qed.

Lemma Zminus_mod_idemp_r: forall a b n, (a - b mod n) mod n = (a - b) mod n.
Proof.
  intros; rewrite Zminus_mod, Zmod_mod, <- Zminus_mod; auto.
Qed.

Lemma Zmult_mod_idemp_l: forall a b n, (a mod n * b) mod n = (a * b) mod n.
Proof.
  intros; rewrite Zmult_mod, Zmod_mod, <- Zmult_mod; auto.
Qed.

Lemma Zmult_mod_idemp_r: forall a b n, (b * (a mod n)) mod n = (b * a) mod n.
Proof.
  intros; rewrite Zmult_mod, Zmod_mod, <- Zmult_mod; auto.
Qed.

(** For a specific number N, equality modulo N is hence a nice setoid
   equivalence, compatible with [+], [-] and [*]. *)

Definition eqm N a b := (a mod N = b mod N).

Lemma eqm_refl N : forall a, (eqm N) a a.
Proof. unfold eqm; auto. Qed.

Lemma eqm_sym N : forall a b, (eqm N) a b -> (eqm N) b a.
Proof. unfold eqm; auto. Qed.

Lemma eqm_trans N : forall a b c,
  (eqm N) a b -> (eqm N) b c -> (eqm N) a c.
Proof. unfold eqm; eauto with *. Qed.

Add Parametric Relation N : Z (eqm N)
  reflexivity proved by (eqm_refl N)
  symmetry proved by (eqm_sym N)
  transitivity proved by (eqm_trans N) as eqm_setoid.

Add Parametric Morphism N : Zplus
  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zplus_eqm.
Proof.
  unfold eqm; intros; rewrite Zplus_mod, H, H0, <- Zplus_mod; auto.
Qed.

Add Parametric Morphism N : Zminus
  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zminus_eqm.
Proof.
  unfold eqm; intros; rewrite Zminus_mod, H, H0, <- Zminus_mod; auto.
Qed.

Add Parametric Morphism N : Zmult
  with signature (eqm N) ==> (eqm N) ==> (eqm N) as Zmult_eqm.
Proof.
  unfold eqm; intros; rewrite Zmult_mod, H, H0, <- Zmult_mod; auto.
Qed.

Add Parametric Morphism N : Zopp
  with signature (eqm N) ==> (eqm N) as Zopp_eqm.
Proof.
  intros; change ((eqm N) (-x) (-y)) with ((eqm N) (0-x) (0-y)).
  rewrite H; red; auto.
Qed.

Lemma Zmod_eqm N : forall a, (eqm N) (a mod N) a.
Proof.
  intros; exact (Zmod_mod a N).
Qed.

(* NB: Zmod and Zdiv are not morphisms with respect to eqm.
    For instance, let (==) be (eqm 2). Then we have (3 == 1) but:
    ~ (3 mod 3 == 1 mod 3)
    ~ (1 mod 3 == 1 mod 1)
    ~ (3/3 == 1/3)
    ~ (1/3 == 1/1)
*)

Lemma Zdiv_Zdiv : forall a b c, 0<=b -> 0<=c -> (a/b)/c = a/(b*c).
Proof.
  intros a b c Hb Hc.
  destruct (Zle_lt_or_eq _ _ Hb); [ | subst; rewrite Zdiv_0_r, Zdiv_0_r, Zdiv_0_l; auto].
  destruct (Zle_lt_or_eq _ _ Hc); [ | subst; rewrite Zmult_0_r, Zdiv_0_r, Zdiv_0_r; auto].
  pattern a at 2;rewrite (Z_div_mod_eq_full a b);auto with zarith.
  pattern (a/b) at 2;rewrite (Z_div_mod_eq_full (a/b) c);auto with zarith.
  replace (b * (c * (a / b / c) + (a / b) mod c) + a mod b) with
    ((a / b / c)*(b * c)  + (b * ((a / b) mod c) + a mod b)) by ring.
  rewrite Z_div_plus_full_l; auto with zarith.
  rewrite (Zdiv_small (b * ((a / b) mod c) + a mod b)).
  ring.
  split.
  apply Zplus_le_0_compat;auto with zarith.
  apply Zmult_le_0_compat;auto with zarith.
  destruct (Z_mod_lt (a/b) c);auto with zarith.
  destruct (Z_mod_lt a b);auto with zarith.
  apply Zle_lt_trans with (b * ((a / b) mod c) + (b-1)).
  destruct (Z_mod_lt a b);auto with zarith.
  apply Zle_lt_trans with (b * (c-1) + (b - 1)).
  apply Zplus_le_compat;auto with zarith.
  destruct (Z_mod_lt (a/b) c);auto with zarith.
  replace (b * (c - 1) + (b - 1)) with (b*c-1);try ring;auto with zarith.
  intro H1;
  assert (H2: c <> 0) by auto with zarith;
  rewrite (Zmult_integral_l _ _ H2 H1) in H; auto with zarith.
Qed.

(** Unfortunately, the previous result isn't always true on negative numbers.
    For instance: 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) *)

(** A last inequality: *)

Theorem Zdiv_mult_le:
 forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a/b) <= (c*a)/b.
Proof.
  intros a b c H1 H2 H3.
  destruct (Zle_lt_or_eq _ _ H2);
   [ | subst; rewrite Zdiv_0_r, Zdiv_0_r, Zmult_0_r; auto].
  case (Z_mod_lt a b); auto with zarith; intros Hu1 Hu2.
  case (Z_mod_lt c b); auto with zarith; intros Hv1 Hv2.
  apply Zmult_le_reg_r with b; auto with zarith.
  rewrite <- Zmult_assoc.
  replace (a / b * b) with (a - a mod b).
  replace (c * a / b * b) with (c * a - (c * a) mod b).
  rewrite Zmult_minus_distr_l.
  unfold Zminus; apply Zplus_le_compat_l.
  match goal with |- - ?X <= -?Y => assert (Y <= X); auto with zarith end.
  apply Zle_trans with ((c mod b) * (a mod b)); auto with zarith.
  rewrite Zmult_mod; auto with zarith.
  apply (Zmod_le ((c mod b) * (a mod b)) b); auto with zarith.
  apply Zmult_le_compat_r; auto with zarith.
  apply (Zmod_le c b); auto.
  pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) b); try ring;
    auto with zarith.
  pattern a at 1; rewrite (Z_div_mod_eq a b); try ring; auto with zarith.
Qed.

(** Zmod is related to divisibility (see more in Znumtheory) *)

Lemma Zmod_divides : forall a b, b<>0 ->
 (a mod b = 0 <-> exists c, a = b*c).
Proof.
 split; intros.
 exists (a/b).
 pattern a at 1; rewrite (Z_div_mod_eq_full a b); auto with zarith.
 destruct H0 as [c Hc].
 symmetry.
 apply Zmod_unique_full with c; auto with zarith.
 red; omega with *.
Qed.

(** * Compatibility *)

(** Weaker results kept only for compatibility *)

Lemma Z_mod_same : forall a, a > 0 -> a mod a = 0.
Proof.
  intros; apply Z_mod_same_full.
Qed.

Lemma Z_div_same : forall a, a > 0 -> a/a = 1.
Proof.
  intros; apply Z_div_same_full; auto with zarith.
Qed.

Lemma Z_div_plus : forall a b c:Z, c > 0 -> (a + b * c) / c = a / c + b.
Proof.
  intros; apply Z_div_plus_full; auto with zarith.
Qed.

Lemma Z_div_mult : forall a b:Z, b > 0 -> (a*b)/b = a.
Proof.
  intros; apply Z_div_mult_full; auto with zarith.
Qed.

Lemma Z_mod_plus : forall a b c:Z, c > 0 -> (a + b * c) mod c = a mod c.
Proof.
  intros; apply Z_mod_plus_full; auto with zarith.
Qed.

Lemma Z_div_exact_1 : forall a b:Z, b > 0 -> a = b*(a/b) -> a mod b = 0.
Proof.
  intros; apply Z_div_exact_full_1; auto with zarith.
Qed.

Lemma Z_div_exact_2 : forall a b:Z, b > 0 -> a mod b = 0 -> a = b*(a/b).
Proof.
  intros; apply Z_div_exact_full_2; auto with zarith.
Qed.

Lemma Z_mod_zero_opp : forall a b:Z, b > 0 -> a mod b = 0 -> (-a) mod b = 0.
Proof.
  intros; apply Z_mod_zero_opp_full; auto with zarith.
Qed.

(** * A direct way to compute Zmod *)

Fixpoint Zmod_POS (a : positive) (b : Z) : Z  :=
  match a with
   | xI a' =>
      let r := Zmod_POS a' b in
      let r' := (2 * r + 1) in
      if Zgt_bool b r' then r' else (r' - b)
   | xO a' =>
      let r := Zmod_POS a' b in
      let r' := (2 * r) in
      if Zgt_bool b r' then r' else (r' - b)
   | xH => if Zge_bool b 2 then 1 else 0
  end.

Definition Zmod' a b :=
  match a with
   | Z0 => 0
   | Zpos a' =>
      match b with
       | Z0 => 0
       | Zpos _ => Zmod_POS a' b
       | Zneg b' =>
          let r := Zmod_POS a' (Zpos b') in
          match r  with Z0 =>  0 |  _  =>   b + r end
      end
   | Zneg a' =>
      match b with
       | Z0 => 0
       | Zpos _ =>
          let r := Zmod_POS a' b in
          match r with Z0 =>  0 | _  =>  b - r end
       | Zneg b' => - (Zmod_POS a' (Zpos b'))
      end
  end.

Theorem Zmod_POS_correct: forall a b, Zmod_POS a b = (snd (Zdiv_eucl_POS a b)).
Proof.
  intros a b; elim a; simpl; auto.
  intros p Rec; rewrite  Rec.
  case (Zdiv_eucl_POS p b); intros z1 z2; simpl; auto.
  match goal with |- context [Zgt_bool _ ?X] => case (Zgt_bool b X) end; auto.
  intros p Rec; rewrite  Rec.
  case (Zdiv_eucl_POS p b); intros z1 z2; simpl; auto.
  match goal with |- context [Zgt_bool _ ?X] => case (Zgt_bool b X) end; auto.
  case (Zge_bool b 2); auto.
Qed.

Theorem Zmod'_correct: forall a b, Zmod' a b = Zmod a b.
Proof.
  intros a b; unfold Zmod; case a; simpl; auto.
  intros p; case b; simpl; auto.
  intros p1; refine (Zmod_POS_correct _ _); auto.
  intros p1; rewrite Zmod_POS_correct; auto.
  case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
  intros p; case b; simpl; auto.
  intros p1; rewrite Zmod_POS_correct; auto.
  case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto.
  intros p1; rewrite Zmod_POS_correct; simpl; auto.
  case (Zdiv_eucl_POS p (Zpos p1)); auto.
Qed.

(** Another convention is possible for division by negative numbers:
    * quotient is always the biggest integer smaller than or equal to a/b
    * remainder is hence always positive or null. *)

Theorem Zdiv_eucl_extended :
  forall b:Z,
    b <> 0 ->
    forall a:Z,
      {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}.
Proof.
  intros b Hb a.
  elim (Z_le_gt_dec 0 b); intro Hb'.
  cut (b > 0); [ intro Hb'' | omega ].
  rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ].
  cut (- b > 0); [ intro Hb'' | omega ].
  elim (Zdiv_eucl_exist Hb'' a); intros qr.
  elim qr; intros q r Hqr.
  exists (- q, r).
  elim Hqr; intros.
  split.
  rewrite <- Zmult_opp_comm; assumption.
  rewrite Zabs_non_eq; [ assumption | omega ].
Qed.

Implicit Arguments Zdiv_eucl_extended.

(** A third convention: Ocaml.

     See files ZOdiv_def.v and ZOdiv.v.

     Ocaml uses Round-Toward-Zero division: (-a)/b = a/(-b) = -(a/b).
     Hence (-a) mod b = - (a mod b)
           a mod (-b) = a mod b
     And: |r| < |b| and sgn(r) = sgn(a)  (notice the a here instead of b).
*)


(* -------------------------------------- Homework 2 --------------------------------------
 *
 * This homework has 3 fairly independent sections. Feel free to skip around.
 *   - Section 1 shows an alternate implementation of finite maps using assocation lists.
 *   - Section 2 represents infinite streams of data in Coq using step functions.
 *   - Section 3 gives more practice reasoning about programs via interpreters.
 *)

Require Import Frap.

(* --- Section 1: Finite maps via assocation lists --- *)

(*
 * Frap defines a finite map type `fmap`, which we used in lecture to define the
 * `valuation` type for our little programming languages.
 *
 * Because Frap's fmap type is designed to support easy proofs, it uses features
 * under the hood that make it impossible for Coq to actually *evaluate* expressions
 * containing fmaps.
 *
 * The first section of this homework asks you to implement another finite maps type
 * that does support evaluation.
 *)

(* A basic interface for finite maps. *)
Module Type MAP.
  Set Implicit Arguments.
  Parameter key : Type.
  Parameter t : Type -> Type.

  Parameter empty : forall V, t V.
  Arguments empty [V].
  Parameter lookup : forall V, t V -> key -> option V.
  Parameter add : forall V, t V -> key -> V -> t V.
  Parameter remove : forall V, t V -> key -> t V.

  Axiom lookup_empty : forall V k, lookup (V := V) empty k = None.
  Axiom lookup_add_eq : forall V k1 k2 v (m : t V), k1 = k2 -> lookup (add m k1 v) k2 = Some v.
  Axiom lookup_add_ne : forall V k1 k2 v (m : t V), k1 <> k2 -> lookup (add m k1 v) k2 = lookup m k2.
  Axiom lookup_remove_eq : forall V k1 k2 (m : t V), k1 = k2 -> lookup (remove m k1) k2 = None.
  Axiom lookup_remove_ne : forall V k1 k2 (m : t V), k1 <> k2 -> lookup (remove m k1) k2 = lookup m k2.
End MAP.

(* An interface for types that support boolean equality. (from Frap) *)
Module Type SET_WITH_EQUALITY.
  Parameter t : Type.
  Parameter equal : t -> t -> bool.

  Axiom equal_ok : forall a b, if equal a b then a = b else a <> b.
End SET_WITH_EQUALITY.

(* Now we'll give an implementation of MAP using "assocation lists" (lists of key-value pairs). *)
Module MapAssocList (K : SET_WITH_EQUALITY) <: MAP.
  Definition key := K.t.
  Definition t (V : Type) : Type := list (key * V).

  (* The empty map is represented by the empty association list. *)
  Definition empty {V} : t V := [].

  (* To lookup a key in our implementation, we walk the association list, looking
   * for a pair with a matching key, and returning its value. *)
  Fixpoint lookup {V} (m : t V) (k : key) : option V :=
    match m with
    | [] => None
    | (k2,v2) :: m' =>
      if K.equal k k2
      then Some v2
      else lookup m' k
    end.

  (* PROBLEM 0 [5 points, ~1 tactic]
   * Prove the following theorem about looking up keys in the empty map.
   *
   * Hint: Don't use induction unless you can convince yourself you need it.
   *
   * Hint: Don't use case analysis unless you can convince yourself you need it.
   *)
  Lemma lookup_empty : forall V k, lookup (V := V) empty k = None.
  Proof.
    auto.
  Qed.

  (* PROBLEM 1 [5 points, ~7 LOC]
   * Define the function `add` with the following type.
   *
   * Hint: There are two natural ways of defining add. One is recursive (using Fixpoint),
   * and one is not recursive (using Definition). Feel free to use either one, but be
   * aware that they may have consequences for your proofs!
   *)
  Definition add {V} (m : t V) (k : key) (v : V) : t V := (k,v) :: m.

  (* PROBLEM 2 [5 points, ~7 LOC]
   * Define the function `remove` with the following type.
   *
   * Hint: You'll need to change `Definition` to `Fixpoint`.
   *)
  Fixpoint remove {V} (m : t V) (k : key) : t V :=
    match m with
    | [] => []
    | (k2, v2) :: m' =>
      if K.equal k k2
      then remove m' k
      else (k2, v2) :: remove m' k
    end.

  (* PROBLEM 3 [5 points, ~20 tactics per proof]
   * Prove the following two facts about looking up keys in a map returned by `add`.
   *
   * Hint: It might help to look at the proof of `member_add_eq` in the module
   * `ListSet` in DataAbstraction.v from Frap. Pay special attention to how
   * SE.equal_ok is used in proofs. Something similar will be useful with K.equal_ok.
   *
   * Hint: You may find it useful to use the `cases` tactic to make progress
   * through expressions of the form "let (a, s) := ... in ..."
   *)
  Lemma lookup_add_eq : forall V k1 k2 v (m : t V), k1 = k2 -> lookup (add m k1 v) k2 = Some v.
  Proof.
    simplify.
    pose proof (K.equal_ok k2 k1).
    cases(K.equal k2 k1).
    - equality.
    - equality.
  Qed.

  Lemma lookup_add_ne : forall V k1 k2 v (m : t V), k1 <> k2 -> lookup (add m k1 v) k2 = lookup m k2.
  Proof.
    simplify.
    pose proof (K.equal_ok k2 k1).
    cases(K.equal k2 k1).
    - equality.
    - equality.
  Qed.

  (* PROBLEM 4 [5 points, ~20 tactics per proof]
   * Prove the following two facts about looking up keys in a map returned by `remove`.
   *
   * Hint: Think carefully about what `lookup_remove_eq` is saying. First, convince yourself
   * that your implementation of `remove` really has this property, and adjust your
   * implementation if you realize it does not.
   *)
  Lemma lookup_remove_eq : forall V k1 k2 (m : t V), k1 = k2 -> lookup (remove m k1) k2 = None.
  Proof.
    intros.
    induct m.
    - simplify. equality.
    - destruct a.
      simplify.
      cases (K.equal k1 k).
      + apply IHm. apply H.
      + simplify.
        cases (K.equal k2 k).
        * equality.
        * apply IHm. apply H.
  Qed.

  Lemma lookup_remove_ne : forall V k1 k2 (m : t V), k1 <> k2 -> lookup (remove m k1) k2 = lookup m k2.
  Proof.
    intros.
    induct m.
    - simplify. equality.
    - destruct a.
      simplify.
      cases (K.equal k1 k); cases (K.equal k2 k);
        pose proof (K.equal_ok k1 k); rewrite Heq in H0;
        pose proof (K.equal_ok k2 k); rewrite Heq0 in H1.
      + equality.
      + equality.
      + rewrite <- H1. simplify. cases (K.equal k2 k2).
        * equality.
        * equality.
      + simplify. cases (K.equal k2 k).
        * equality.
        * apply IHm. equality.
  Qed.
End MapAssocList.

(* Here's a little utility module from Frap to show nats have equality. *)
Module NatWithEquality <: SET_WITH_EQUALITY with Definition t := nat.
  Definition t := nat.

  Fixpoint equal (a b : nat) : bool :=
    match a, b with
    | 0, 0 => true
    | S a', S b' => equal a' b'
    | _, _ => false
    end.

  Theorem equal_ok : forall a b, if equal a b then a = b else a <> b.
  Proof.
    induct a; simplify; cases b; try equality.
    specialize (IHa b).
    cases (equal a b); equality.
  Qed.
End NatWithEquality.

Module NatMap := MapAssocList(NatWithEquality).

(* Here's the big win of our implementation: we can compute with these maps!
 *
 * Note: This line won't work correctly until you've implemented `add` above.
 *)

Compute NatMap.lookup (NatMap.add NatMap.empty 0 1) 0.  (* should evaluate to `Some 1` *)

(* --- Section 2: Infinite streams as step functions --- *)

(* All the data types we've looked at so far in Coq have been some kind of finite tree.
 * But it is often useful to represent and manipulate conceptually infinite collections
 * of data, as supported by generators, iterators, or streams in some languages.
 *
 * In Coq, one way to represent these collections is as a kind of stateful process,
 * described by a "step function".
 *)
Module StreamsAsSteppers.

  (* Here we define the type of step functions that manipulate internal state of
   * of type T and produce an infinite stream of elements of type A. These functions
   * take the current state (of type T), and return an element (of type A) and a
   * new state.
   *)
  Definition stepper (T : Type) (A : Type) :=
    T -> A * T.

  (* The idea is that, given some initial state t, we can apply the step function
   * to get the first element of the stream and a new state t'.  Calling the step
   * function again on t' produces the next element and another state, and so on.
   *)

  (* We can formalize this idea with the following function that collects the
   * first `n` elements of such a stream into a list.
   *)
  Fixpoint run_stepper {T A} (step : stepper T A) (n : nat) (s : T) : list A :=
    match n with
    | O => []
    | S n' =>
      let (a, s) := step s in
      a :: run_stepper step n' s
    end.

  (* PROBLEM 5 [5 points, ~7 tactics]
   * Prove the following theorem showing that `run_stepper` always returns
   * the right number of elements.
   *
   * Hint: You may find it useful to use the `cases` tactic to make progress
   * through expressions of the form "let (a, s) := ... in ..."
   *)
  Lemma run_stepper_length :
    forall T A (step : stepper T A) n s,
      length (run_stepper step n s) = n.
  Proof.
    intros.
    induct n.
    - equality.
    - simplify.
      cases (step s).
      simplify.
      rewrite IHn.
      equality.
  Qed.

  (* Now here's an example of a stream: the stream of all natural numbers.
   * Both its element type and internal state type are `nat`. At each step,
   * it produces the current state as the next element, and then increments
   * that number to get the new state.
   *)
  Example nats : stepper nat nat := fun n => (n, n + 1).

  (* Running `nats` for 10 steps starting from 0 produces the first 10
   * natural numbers, as expected.
   *)
  Compute run_stepper nats 10 0.

  (* PROBLEM 6 [10 points, ~4 tactics + 1 helper lemma needing ~7 tactics]
   * Prove the following theorem about `run_stepper` on `nats`, which says
   * that if we run from a non-zero state `s`, that's the same as adding
   * `s` to all the elements from running starting at 0.
   *
   * Hint: The first thing to try is to proceed by induction.
   *
   * Hint: You'll get stuck. There at least two ways to unstick yourself,
   * both involving an additional lemma. You can either generalize the
   * statement of run_stepper_nats to replace the 0 in the RHS with a variable,
   * or you can prove a lemma (or find one in stdlib) about mapping two
   * functions back to back.
   *)
  Lemma add_zero :
    forall n,
      n + 0 = n.
  Proof.
    auto.
  Qed.

  Lemma s_plus_a_plus_1_associativity :
    forall s a,
      s + a + 1 = s + (a + 1).
  Proof.
    intros.
    linear_arithmetic.
  Qed.

  Lemma run_stepper_nats_helper :
    forall n s a,
      run_stepper nats n (s + a) =
      List.map (fun x => s + x) (run_stepper nats n a).
  Proof.
    intro n.
    induct n.
    - simplify. equality.
    - simplify. rewrite <- IHn. rewrite s_plus_a_plus_1_associativity. equality.
  Qed.

  Lemma run_stepper_nats :
    forall s n,
      run_stepper nats n s =
      List.map (fun x => s + x) (run_stepper nats n 0).
  Proof.
    intros.
    pose proof run_stepper_nats_helper.
    rewrite <- (add_zero s) at 1.
    apply H with (a := 0).
  Qed.

  (* PROBLEM 7 [5 points, ~2 LOC]
   * Define another example stream of your choice.  For example, you could define
   * the constant stream of zeroes, or a stream of booleans that alternates between
   * true and false, or the stream of prime numbers.
   *
   * Brownie (i.e. not real) points for creativity!
   *
   * Also, use the `Compute` command to give at least one example of running your
   * stream for a few steps from its initial state.
   *)
  Example zeroes : stepper nat nat := fun n => (0, 10).

  Compute run_stepper zeroes 10 0.

  Example fibonacci : stepper (nat * nat) nat := fun state =>
    let (n1, n2) := state in (n1 + n2, (n2, n1 + n2)).

  Compute run_stepper fibonacci 10 (0, 1).

  (* In addition to specific examples, we can define stream transformers,
   * or in other words, functions that take and return streams. Here's a simple
   * transformer on nat streams that adds one to every element of the stream.
   *)
  Definition inc_stepper {T} (step : stepper T nat) : stepper T nat :=
    fun s =>
      let (n, s') := step s in
      (n + 1, s').

  Compute run_stepper (inc_stepper nats) 10 1.
  Compute run_stepper nats 10 2.

  (* PROBLEM 8 [5 points, 1 line of specification and ~7 tactics of proof]
   * Complete the statement of the following theorem that explains what
   * inc_stepper does to the `nats` stream. Then prove your resulting theorem.
   *)
  Lemma run_inc_stepper_nats :
    forall n s,
      run_stepper (inc_stepper nats) n s =
        run_stepper nats n (s + 1).
  Proof.
    intro n.
    induct n.
    - simplify. equality.
    - simplify. rewrite <- IHn. equality.
  Qed.

  (* Generalizing from inc_stepper, a common way to transform streams is
   * to apply some function to each element. We call this `map_stepper`
   * by analogy to the List.map function described in lecture.
   *
   * PROBLEM 9 [5 points, 1-2 LOC for defn, ~10 tactics for proof]
   * Complete the definition of map_stepper. Then prove the lemma below.
   *)
  (* insert `:=` on the next line before the '.', then add your solution. *)
  Definition map_stepper {T A B} (f : A -> B) (step : stepper T A) : stepper T B
    := fun s =>
      let (e, s') := step s in
      ((f e), s').

  Compute run_stepper (map_stepper (fun n => 7 * n + 3) nats) 10 0.
  (* should be: [3; 10; 17; 24; 31; 38; 45; 52; 59; 66] *)
  (* Note: This line won't work correctly until you've implemented `map_stepper` above. *)

  Lemma map_run_stepper :
    forall T A B (step : stepper T A) (f : A -> B) n s,
      run_stepper (map_stepper f step) n s = List.map f (run_stepper step n s).
  Proof.
    induct n.
    - simplify. equality.
    - simplify.
      cases (map_stepper f step s).
      cases (step s).
      simplify.
      rewrite IHn.
      unfold map_stepper in Heq.
      rewrite Heq0 in Heq.
      equality.
  Qed.

  (* Here's another stream transformer. *)
  Definition mystery_transformer {T A} (step: stepper T A) : stepper T A :=
    fun s =>
      let (a, s') := step s in
      let (_, s'') := step s' in
      (a, s'').
  (* PROBLEM 10 [5 points, 1 sentence of English]
   * Briefly describe what this transformer does.
   *)
  (* It emits an element for the current state, then advances the state *two*
     steps.  The element for the second step is skipped. *)

  Fixpoint list_skip A (l : list A) : list A :=
    match l with
    | [] => []
    | x' :: l' =>
      match l' with
      | [] => [x']
      | x'' :: l'' => x' :: list_skip A l''
      end
  end.

  Compute list_skip nat (1::2::3::4::5::6::[]).
  Compute run_stepper nats 6 1.
  Compute list_skip nat (run_stepper nats 6 1).
  Compute run_stepper (mystery_transformer nats) 3 1.

  (* PROBLEM 11 [10 points]
   * State and prove a lemma characterizing mystery_transformer in terms of
   * a list transformation.
   *
   * Hint: If the standard library does not contain a corresponding list
   * transfromation, you may need to define it yourself!
   *)
  Lemma run_stepper_mystery_transformer :
    forall T A (step : stepper T A) n s,
      run_stepper (mystery_transformer step) n s =
      list_skip A (run_stepper step (n + n) s).
  Proof.
    induct n.
    - simplify. equality.
    - simplify.
      cases(mystery_transformer step s). cases(step s). rewrite IHn.
      unfold mystery_transformer in Heq. rewrite Heq0 in Heq.
      cases(list_skip A).
      + simplify.
  Admitted.

  (* Above, we defined a function map_stepper by analogy to List.map.
   * What about an analogue to List.filter?
   *)

  (* PROBLEM 12 [5 points, ~1 LOC OR ~1 sentence]
   * Define filter_stepper or explain intuitively why it cannot be defined.
   *)
  Definition filter_stepper {T A} (f : A -> bool) (step : stepper T A) : stepper T A.
  (* filter_stepper is not guaranteed to ever halt (for example, if the predicate always
     returns False). *)
  Admitted.
End StreamsAsSteppers.

(* --- Section 3: Practice with interpreters --- *)

Module MoreInterpreters.

  (* Here are a bunch of copied definitions from Frap's Interpreters.v *)

  Inductive arith : Set :=
  | Const (n : nat)
  | Var (x : var)
  | Plus (e1 e2 : arith)
  | Minus (e1 e2 : arith)
  | Times (e1 e2 : arith).

  Definition valuation := fmap var nat.

  Fixpoint interp (e : arith) (v : valuation) : nat :=
    match e with
    | Const n => n
    | Var x =>
      match v $? x with
      | None => 0
      | Some n => n
      end
    | Plus e1 e2 => interp e1 v + interp e2 v
    | Minus e1 e2 => interp e1 v - interp e2 v
    | Times e1 e2 => interp e1 v * interp e2 v
    end.

  Inductive cmd :=
  | Skip
  | Assign (x : var) (e : arith)
  | Sequence (c1 c2 : cmd)
  | Repeat (e : arith) (body : cmd).

  Fixpoint selfCompose {A} (f : A -> A) (n : nat) : A -> A :=
    match n with
    | O => fun x => x
    | S n' => fun x => selfCompose f n' (f x)
    end.

  Fixpoint exec (c : cmd) (v : valuation) : valuation :=
    match c with
    | Skip => v
    | Assign x e => v $+ (x, interp e v)
    | Sequence c1 c2 => exec c2 (exec c1 v)
    | Repeat e body => selfCompose (exec body) (interp e v) v
    end.

  Coercion Const : nat >-> arith.
  Coercion Var : var >-> arith.
  Infix "+" := Plus : arith_scope.
  Infix "-" := Minus : arith_scope.
  Infix "*" := Times : arith_scope.
  Delimit Scope arith_scope with arith.
  Notation "x <- e" := (Assign x e%arith) (at level 75).
  Infix ";" := Sequence (at level 76).
  Notation "'repeat' e 'doing' body 'done'" := (Repeat e%arith body) (at level 75).

  (* End of copied stuff :) *)

  (* Here's a command to compute fibonacci numbers based on the value of "input". *)
  Definition fibonacci :=
    "current" <- 1;
    "next" <- 1;
    "tmp" <- 1;
    repeat "input" doing
      "tmp" <- "next" + "current";
      "current" <- "next";
      "next" <- "tmp"
    done;
    "output" <- "current".

  (* And here's a functional implementation in Coq that closely matches the
   * control flow of the above command's main loop. *)
  Fixpoint fib_tail (n a b : nat) : nat :=
    match n with
    | O => b
    | S n' => fib_tail n' (a + b) a
    end.

  (* PROBLEM 13 [25 points, ~5 tactics + 1 helper lemma requiring ~10 LOC to state and ~10 tactics to prove]
   * Prove that the `fibonacci` command agrees with the functional implementation fib_tail.
   *
   * Hint: Your final proof should not use induction. Instead, state and prove (by induction) a
   * lemma about the body of the command's main loop. The hard part of this problem is getting
   * the statement of your helper lemma correct. It needs to imply fibonacci_ok and be strong
   * enough to be proved by induction.
   *
   * Hint: It may help to review the proof of `factorial` in Interpreters.v, especially
   * the lemma about the body of its main loop.
   *)
  Definition fibonacci_body :=
    "tmp" <- "next" + "current";
    "current" <- "next";
    "next" <- "tmp".

  Lemma fibonacci_ok' : forall count current next v,
    v $? "current" = Some current
    -> v $? "next" = Some next
    -> v $? "tmp" = Some next
    -> selfCompose (exec fibonacci_body) count v
       = v $+ ("current", fib_tail count next current)
           $+ ("next", (fib_tail (count + 1) next current))
           $+ ("tmp", (fib_tail (count + 1) next current)).
  Proof.
    induct count; simplify.
    - maps_equal.
      + trivial.
      + rewrite H0. equality.
      + rewrite H. equality.
    - rewrite H0. rewrite H.
      rewrite (IHcount next (next + current)).
      maps_equal.
      + simplify. equality.
      + simplify. equality.
      + simplify. equality.
  Qed.

  Theorem fibonacci_ok :
    forall v input,
      v $? "input" = Some input ->
      exec fibonacci v $? "output" = Some (fib_tail input 1 1).
  Proof.
    simplify.
    rewrite H.
    rewrite (fibonacci_ok' input 1 1).
    + simplify. equality.
    + simplify. equality.
    + simplify. equality.
    + simplify. equality.
  Qed.

End MoreInterpreters.

(* --- The End --- *)

(*
 * This is the end of homework 2.
 *
 * To submit your homework, please follow the instructions at the end of the
 * README.md file in this directory.
 *
 * Please also see the README.md file to read about how we will grade this homework.
 *)

(* --- Challenge problem --- *)

(*
 * There's one more challenge problem below, which you can try if you like.
 * It will not be worth any points, now or ever.
 *
 * You already have all the techniques you need to solve it, but it does require
 * some thought.
 *)

(* Above, we defined `fib_tail` as a purely functional specification of the
 * command `fibonacci`.  But `fib_tail` is perhaps not the most natural way
 * of specifying the Fibonacci numbers.  Instead, we might expect the
 * following textbook definition.
 *)
Fixpoint fib (n : nat) :=
  match n with
  | O => 1
  | S n' =>
    match n' with
    | O => 1
    | S n'' => fib n' + fib n''
    end
  end.
Compute fib 4.

Fixpoint fib_tail (n a b : nat) : nat :=
  match n with
  | O => b
  | S n' => fib_tail n' (a + b) a
  end.
Compute fib_tail 4 1 1.

(* PROBLEM 14 [0 points, ~6 tactics + 1 helper lemma needing ~10 tactics]
 * Prove that fib and fib_tail agree, as follows.
 *
 * Hint: As you might expect by this point, it's not provable directly by induction,
 * so you'll need a helper lemma or two.  I have seen several totally different ways
 * to prove this fact, so be creative and try to find something that makes sense to you!
 *)
Theorem fib_tail_ok :
  forall n,
    fib_tail n 1 1 = fib n.
Proof.
  (* YOUR CODE HERE *)
Admitted.


Require Import Setoid.

Parameter P : nat -> Prop.
Parameter Q : nat -> Prop.
Parameter PQ : forall n, P n <-> Q n.

Lemma PQ2 : forall n, P n -> Q n.
  intros.
  rewrite PQ in H.
  trivial.
Qed.


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

Require Import List Extraction Lia.

Set Implicit Arguments.

Fixpoint iter X (f : X -> X) n x :=
  match n with 0 => x | S n => iter f n (f x) end.

Section iter0.

  Variable f : nat -> nat.

  Inductive g_iter0 : nat -> list nat -> Prop :=
   | in_git0_0 : g_iter0 0 nil
   | in_git0_1 : forall n l, n <> 0 -> g_iter0 (f n) l -> g_iter0 n (n::l).

  Fact g_iter0_fun n l m : g_iter0 n l -> g_iter0 n m -> l = m.
  Proof.
    intros H; revert H m.
    induction 1; inversion 1; subst; f_equal; auto; lia.
  Qed.

  Unset Elimination Schemes.

  Inductive bar : nat -> Prop :=
    | in_bar_0 : bar 0
    | in_bar_1 : forall n, bar (f n) -> bar n.

  Set Elimination Schemes.

  Let ex_bar n : (exists k, iter f k n = 0) -> bar n.
  Proof.
    intros (k & Hk); revert n Hk.
    induction k as [ | k IHk ]; simpl; intros n Hk.
    + subst; constructor 1.
    + constructor 2; apply IHk; trivial.
  Qed.

  Section iter0.

    Let Fixpoint loop n (H : bar n) : sig (g_iter0 n).
    Proof.
      refine(match n as n' return n = n' -> _ with
        | 0   => fun _ => exist _ nil _
        | S m => fun E => let (r,Hr) := loop (f n) _ in exist _ (n::r) _
      end eq_refl).
      1-2: cycle 1.
      + destruct H; trivial; discriminate.
      + subst; constructor 1.
      + subst; constructor 2; auto.
    Defined.

    Definition iter0 n Hn := proj1_sig (loop (@ex_bar n Hn)).

    Fact iter0_spec n Hn : g_iter0 n (iter0 n Hn).
    Proof. apply (proj2_sig _). Qed.

  End iter0.

  Fact iter0_fix_0 H : iter0 0 H = nil.
  Proof.
    apply g_iter0_fun with (1 := iter0_spec _ _).
    constructor.
  Qed.

  Fact iter0_S n : (exists k, iter f k n = 0)
                 -> n <> 0
                 -> exists k, iter f k (f n) = 0.
  Proof.
    intros ([|k] & Hk) H.
    + simpl in Hk; lia.
    + exists k; auto.
  Qed.

  Fact iter0_fix_1 n H H' : n <> 0 -> iter0 n H = n::iter0 (f n) H'.
  Proof.
    intros H1.
    apply g_iter0_fun with (1 := iter0_spec _ _).
    constructor 2; auto.
    apply iter0_spec.
  Qed.

End iter0.

Extract Inductive list => "list" [ "[]" "(::)" ].

Recursive Extraction iter0.


From mathcomp Require Import ssreflect ssrnat ssrbool ssrfun seq.
From mf Require Import all_mf.
Require Import baire cont count iseg.

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

Section sequential_continuity.
  Context (Q A Q' A' : Type).
  (* Q is for questions, A is for answers*)
  Notation B := (Q -> A).
  Notation B' := (Q' -> A').
  (* B is for Baire space. *)
  Local Open Scope baire_scope.
  Context (F: B ->> B').

  Definition sequential_continuity_point phi:=
    forall phin Fphin Fphi,
      phi \is_limit_of phin -> (forall n, F (phin n) (Fphin n)) -> F phi Fphi ->
      Fphi \is_limit_of Fphin.

  Definition sequential_continuity_points:=
    make_subset (fun phi => sequential_continuity_point phi).

  Definition sequentially_continuous:=
    forall phi, sequential_continuity_point phi.

  Lemma scnt_spec:
    sequentially_continuous <-> dom F \is_subset_of sequential_continuity_points.
  Proof.
    split => [scnt phi [Fphi val]| scnt phi phin Fphin Fphi lmt lmts val] ; first exact/scnt.
    by apply/scnt/val/lmts/lmt; exists Fphi.
  Qed.

  Lemma scnt_frcs phi: phi \from dom F -> sequential_continuity_point phi -> phi \from dom (forces F).
  Proof.
    move => [Fphi val] cont.
    exists Fphi => Fphi' val'.
    apply/lim_sing/lim_const/cont/val'.
    - exact/lim_const.
    by rewrite /cnst.
  Qed.

  Lemma scnt_sing: sequentially_continuous -> F \is_singlevalued.
  Proof.
    move => cont; apply/sing_spec => phi dm.
    exact/scnt_frcs.
  Qed.

  Lemma cont_scnt: F \is_continuous -> sequentially_continuous.
  Proof.
    move => cont phi phin Fphin Fphi lim vals val L.
    have [Lf mod]:= cont phi Fphi val.
    have [n prp]:= lim (gather Lf L).
    exists n => m ineq.
    elim: L prp => [ | q' L ih prp]//.
    split; last by apply/ih => m' ineq'; have /coin_cat []:= prp m' ineq'.
    symmetry; apply/mod/vals.
    by have /coin_cat []:= prp m ineq.
  Qed.
End sequential_continuity.
Notation "F \is_sequentially_continuous_in phi" := (sequential_continuity_point F phi) (at level 40): baire_scope.
Notation "F \is_sequentially_continuous" := (sequentially_continuous F) (at level 40): baire_scope.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal84.

Set Printing Depth 1000.
Definition lfind_eval  z x:=
plus (mult x z) z.

Compute lfind_eval  (Succ (Succ Zero)) (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ (Succ Zero))) (Succ Zero).

Compute lfind_eval  (Succ Zero) (Succ (Succ (Succ (Succ Zero)))).

Compute lfind_eval  (Zero) (Succ Zero).

Compute lfind_eval  (Zero) (Succ (Succ Zero)).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Succ Zero) (Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Zero).

Compute lfind_eval  (Zero) (Succ Zero).

Compute lfind_eval  (Succ Zero) (Zero).

Compute lfind_eval  (Succ (Succ (Succ (Succ Zero)))) (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ (Succ Zero))) (Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Succ Zero).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Zero) (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Zero) (Succ Zero).

Compute lfind_eval  (Zero) (Zero).


Require Export euclidean__axioms.
Require Export euclidean__defs.
Require Export euclidean__tactics.
Require Export lemma__ABCequalsCBA.
Require Export lemma__equalanglesNC.
Require Export lemma__equalanglestransitive.
Definition lemma__equalanglesreflexive : forall A B C, (euclidean__axioms.nCol A B C) -> (euclidean__defs.CongA A B C A B C).
Proof.
intro A.
intro B.
intro C.
intro H.
assert (* Cut *) (euclidean__defs.CongA A B C C B A) as H0.
- apply (@lemma__ABCequalsCBA.lemma__ABCequalsCBA A B C H).
- assert (* Cut *) (euclidean__axioms.nCol C B A) as H1.
-- apply (@euclidean__tactics.nCol__notCol C B A).
---apply (@euclidean__tactics.nCol__not__Col C B A).
----apply (@lemma__equalanglesNC.lemma__equalanglesNC A B C C B A H0).

-- assert (* Cut *) (euclidean__defs.CongA C B A A B C) as H2.
--- apply (@lemma__ABCequalsCBA.lemma__ABCequalsCBA C B A H1).
--- assert (* Cut *) (euclidean__defs.CongA A B C A B C) as H3.
---- apply (@lemma__equalanglestransitive.lemma__equalanglestransitive A B C C B A A B C H0 H2).
---- exact H3.
Qed.


Require Import ZArith Coq.Program.Wf Coq.Program.Utils.

Parameter data:Set.

Inductive t : Set :=
  | Leaf : t
  | Node : t -> data -> t -> Z -> t.

Parameter avl : t -> Prop.
Parameter bst : t -> Prop.
Parameter In : data -> t -> Prop.
Parameter cardinal : t -> nat.
Definition card2 (s:t*t) := let (s1,s2) := s in cardinal s1 + cardinal s2.

Parameter split : data -> t -> t*(bool*t).
Parameter join : t -> data -> t -> t.
Parameter add : data -> t -> t.

Program Fixpoint union
  (s u:t)
  (hb1: bst s)(ha1: avl s)(hb2: bst u)(hb2: avl u)
  { measure (cardinal s + cardinal u) } :
  {s' : t | bst s' /\ avl s' /\ forall x, In x s' <-> In x s \/ In x u} :=
  match s, u with
    | Leaf,t2 => t2
    | t1,Leaf => t1
    | Node l1 v1 r1 h1, Node l2 v2 r2 h2 =>
        if (Z_ge_lt_dec h1 h2) then
          if (Z_eq_dec h2 1)
          then add v2 s
          else
            let (l2', r2') := split v1 u in
            join (union l1 l2' _ _ _ _) v1 (union r1 (snd r2') _ _ _ _)
        else
          if (Z_eq_dec h1 1)
          then add v1 s
          else
            let (l1', r1') := split v2 u in
            join (union l1' l2 _ _ _ _) v2 (union (snd r1') r2 _ _ _ _)
  end.


Require Import List.
Require Import CpdtTactics.

(* In Coq, infinite loops are disastrous, since we could use the latter to
   prove any proposition vacuously. The following piece of code is not
   allowed in Coq:

     Fixpoint bad {P : Prop} (u : unit) : P := bad u

   But, if it were, then it would leave us with 'bad tt' as a proof of P,
   where P is any proposition.

  There are also algorithmic considerations that make universal termination
  very desirable. Tactics like reflexivity compare terms up to equivalence
  under computational rules. Calls to recursive, pattern-matching functions
  are simplified automatically with no need for explicit proof steps.

  Coq has special support for a class of lazy data structures that happens
  to contain most examples found in Haskell. That mechanism comprises the
  use of co-inductive types. *)

(* 5.1 - Computing with Infinite Data *)

(* Streams (lazy lists) - most basic type of infinite data *)
Section stream.
  Variable A : Type.

  CoInductive stream : Type :=
  | Cons : A -> stream -> stream.
End stream.

Arguments Cons {A} _ _.

(* Recursive definitions were necessary to 'use' values of recursive inductive
   types effectively. We need co-recursive definitions to 'build' values of
   co-inductive types effectively. *)
CoFixpoint zeroes : stream nat := Cons 0 zeroes.

(* Stream that alternates between true and false *)
CoFixpoint trues_falses : stream bool := Cons true falses_trues
with falses_trues : stream bool := Cons false trues_falses.

(* Co-inductive values as arguments to recursive functions *)
Fixpoint approx {A} (s : stream A) (n : nat) : list A :=
  match n with
  | O => nil
  | S n' =>
    match s with
    | Cons h t => h :: approx t n'
    end
  end.

Example approx_test1 :
  approx zeroes 5 = 0 :: 0 :: 0 :: 0 :: 0 :: nil.
Proof. reflexivity. Qed.

Example approx_test2 :
  approx trues_falses 3 = true :: false :: true :: nil.
Proof. reflexivity. Qed.

(* There are some very important restrictions on the use of co-inductive
   types that are dual to the restrictions on the use of inductive types.
   Fixpoints consume values of inductive types, with restrictions on which
   arguments may be passed in recursive calls. Dually, co-fixpoints produce
   values of co-inductive types, with restrictions on what may be done with
   the results of co-recursive calls.

   The restriction for co-inductive types shows up as the 'guardedness'
   condition. That is, every co-recursive call must be guarded by a
   constructor. In other words, every co-recursive call must be a direct
   argument to a constructor of the co-inductive type we are generating. *)

CoFixpoint map {A B} (f : A -> B) (s : stream A) : stream B :=
  match s with
  | Cons h t => Cons (f h) (map f t)
  end.

CoFixpoint interleave {A} (s1 s2 : stream A) : stream A :=
  match s1, s2 with
  | Cons h1 t1, Cons h2 t2 => Cons h1 (Cons h2 (interleave t1 t2))
  end.

(* In Coq, a co-recursive call must be a direct argument to a constructor,
   nested only inside of other constructor calls or fun or match
   expressions. *)


(**
Coq/SSReflect/MathComp による定理証明

第4章 MathComp ライブラリの基本ファイル

追加 4.A div.v --- 除算のライブラリ

======

2020_8_10 @suharahiromichi

2020_9_16 @suharahiromichi
 *)

From mathcomp Require Import all_ssreflect.

Require Import Recdef.
Require Import Wf_nat.
Require Import Program.Wf.

Require Import ssromega.
(**
https://github.com/suharahiromichi/coq/blob/master/common/ssromega.v
もダウンロードして同じディレクトリに置いて、coqc ssromega.v を実行し、
ssromega.vo ができていることを確認してください。
*)

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

(**
# はじめに

本節はテキストを参照しながら、MathComp のソースコードに沿って説明していきます。
ソースコードが手元にあるならば、それも参照してください。
opamでインストールしている場合は、ソースは、たとえば以下にあります。

~/.opam/4.07.1/lib/coq/user-contrib/mathcomp/ssreflect/div.v
*)

(**
# 除算
 *)
(**
## 除算の定義

ユーグリッド除法 edivn_rec (末尾再帰）で定義される。
*)
Locate "_ %/ _". (* := divn m d : nat_scope (default interpretation) *)
Print divn.
(*
fun m d : nat => (edivn m d).1
 *)
Print edivn.
(*
fun m d : nat => if 0 < d then edivn_rec d.-1 m 0 else (0, m)

最初に、除数から1を引いておいて、すなわち、``10÷3`` なら ``d = 2`` としておいて、
 *)
Print edivn_rec.
(*
fun d : nat =>
fix loop (m q : nat) {struct m} : nat * nat :=
  match m - d with
  | 0 => (q, m)
  | m'.+1 => loop m' q.+1
  end

``m - d = 10 - 2 = 7.+1`` と、非零のチェック（停止判定）を兼ねて、
除数から被除数を引いたものから、さらに1を引いて、7 を得ている。
だから、末尾再帰だけみると、本来の除数(3)を引くのと同じで、

```
(m, q) = (10, 0) = (7, 1) = (4, 2) = (1, 3) => (q, m) = (3, 1)
```

となる。
 *)
Compute edivn 10 3.                         (* (3, 1) *)

(**
補足説明：
整礎帰納法をつかって、もうすこし自然な定義で書くことができます。
*)
Section DIV'.
  Fail Fixpoint edivn' (m d q : nat) {struct m} : nat * nat :=
    if d is 0 then (0, m)                   (* 0で割ると0 *)
    else
      let: m' := m - d in
      if m' is 0 then (q, m) else edivn' m' d q.+1.

  Function edivn' (m d q : nat) {wf lt m} : nat * nat :=
    if d is 0 then (0, m)                   (* 0で割ると0 *)
    else
      let: m' := m - d in
      if m' is 0 then (q, m) else edivn' m' d q.+1.
  Proof.
    - move=> m d _ n Hd n' H.
      apply/ltP.
        by ssromega.
    - by apply: lt_wf.
  Qed.
(**
しかし、Compute では計算できません。
*)
  Compute edivn' 10 3 0.

(**
Program コマンドを使います。
*)
  Program Fixpoint edivn'' (m d q : nat) {wf lt m} : nat * nat :=
    if d is 0 then (0, m)
    else
      let: m' := m - d in
      if m' is 0 then (q, m) else edivn'' m' d q.+1.
  Obligation 1.
  Proof.
      by ssromega.
  Qed.
(**
こんどは、計算はできるようです。
*)
  Compute edivn'' 10 3 0.
End DIV'.

(**
## 除法の仕様
*)
Print edivn_spec.
(*
Variant edivn_spec (m d : nat) : nat * nat -> Set :=
    EdivnSpec : forall q r : nat,
                m = q * d + r -> (0 < d) ==> (r < d) -> edivn_spec m d (q, r)

除法の定義が、除法の仕様を満たすという補題：
*)
Check edivnP : forall m d : nat, edivn_spec m d (edivn m d).

(**
同様に除法の結果を等式で表した補題：
``q * d + r`` を d で割ると、q 余り r である。

unfoldするより、これを使ったほうが便利です。
*)
Check edivn_eq : forall d q r : nat, r < d -> edivn (q * d + r) d = (q, r).

(**
# 剰余計算

ユーグリッド除法とは別に定義する。
*)
Print modn.
(*
fun m d : nat => if 0 < d then modn_rec d.-1 m else m
*)
Print modn_rec.
(*
fun d : nat =>
fix loop (m : nat) : nat := match m - d with
                            | 0 => m
                            | m'.+1 => loop m'
                            end
*)
Locate "_ %% _". (* := modn m d : nat_scope (default interpretation) *)

(**
## 剰余計算の補題（0で割る場合）
*)
(**
### ``0 / 0 = 0``
*)
Check divn0 : forall m : nat, m %/ 0 = 0.

(**
### ``m % 0 = m``
 *)
Check modn0 : forall m : nat, m %% 0 = m.

(**
### ``0 %| 0`` および ``~~ (0 %| m)``

0は0で割りきれるが、0以外の数は割りきれない。
 *)
Lemma dvd00 : 0 %| 0.
Proof. done. Qed.

Lemma dvd0n' n : 0 < n -> ~~(0 %| n).
Proof. by rewrite dvd0n lt0n. Qed.

(**
### ``m = n %[mod 0]`` は ``m = n`` と同値である。
 *)
Lemma modn0' m n : m = n %[mod 0] <-> m = n.
Proof.
  split.
  - by rewrite 2!modn0.
  - done.
Qed.

(**
## 剰余計算の補題（``0 < d`` を条件にするもの。すなわち0割を避けるもの）
*)
(**
### ``0 < d -> d / d = 1``

``d = 0`` なら ``d / d = 0`` なので、その条件を除いている。
*)
Lemma divnn' d : 0 < d -> d %/ d = 1.
Proof. by rewrite divnn => ->. Qed.

(**
### ``0 < d -> m % d < d``

``d = 0`` なら ``m %% 0 = m`` なので、その条件を除いている。
 *)
Lemma ltn_mod' m d : 0 < d -> m %% d < d.
Proof. by rewrite ltn_mod. Qed.

(**
補足： ``0 < d`` ではなく ``0 != d`` を使いたいときは、次の補題で書き換えてください。
*)
Check lt0n : forall n : nat, (0 < n) = (n != 0).

(**
## 奇偶についての補題
*)
Print odd.

(**
### m %% 2 = 0 <-> ~~ odd m.

奇数かどうかは剰余と独立に定義されているので、同値であることを示す補題：
 *)
Lemma modn2' m : m %% 2 = 0 <-> ~~ odd m.
Proof.
  (* modn2 という補題は奇妙である。左辺がnat、右辺がboolである。 *)

  Check modn2 m : m %% 2 = odd m.
  (* 当然、右辺が bool -> nat のコアーションになっている。 *)
  Check modn2 m : m %% 2 = nat_of_bool (odd m).

  rewrite modn2.
  (* odd m = 0 <-> ~~ odd m *)
  split=> H.

  - (* -> *)
    Fail rewrite H.
(**
H : odd m = 0 は、 nat_of_bool のコアーションであるため、``~~ odd m`` を ~~ 0 にする
rewrite をすることはできない。
 *)
    Check H : nat_of_bool (odd m) = O.

    Check eqb0 : forall b : bool, (nat_of_bool b == 0) = ~~ b.
    Check eqb0 (odd m) : (nat_of_bool (odd m) == 0) = ~~ (odd m).
(**
        nat_of_bool (odd m) = O
を
        nat_of_bool (odd m) == 0

にリフレクションすれば、eqb0 を使って、

        ~~ odd m

に書き換えることができる。
 *)
    Check eqb0 : forall b : bool, (nat_of_bool b == 0) = ~~ b.
    move/eqP in H.
    rewrite eqb0 in H.
    done.

  - (* <- *)
(**
逆も同様に証明できる。
*)
    apply/eqP.
      by rewrite eqb0.
Qed.

(**
## 2で割る補題
 *)
Print half.                                 (* ./2 *)

(**
「2で割る」は、divn とは無関係に定義されている。
*)
Check divn2 : forall m : nat, m %/ 2 = m./2.

(**
# 整除可能
 *)
(**
## 整除可能の定義
 *)
Print dvdn.                         (* bool述語 *)
(* fun d m : nat => m %% d == 0 *)

(* 除数のほうが前になる。 ``d \ m`` と書く方が一般的かも。  *)
Locate "d %| m". (* := dvdn m d : nat_scope (default interpretation) *)

(**
%% と ``%|`` の間は、``eqP`` によるリフレクションで変換できる。

``d %| m`` の定義 ``m %% d == 0``  から明らかだが、案外気がつかないかも。
 *)
Goal forall m d, m %% d = 0 <-> d %| m.
Proof.
  move=> m d.
  split=> H.
  - apply/eqP.
    done.
  - apply/eqP.
    done.
Qed.

Goal forall m d, m %% d <> 0 <-> ~~(d %| m).
Proof.
  move=> m d.
  split=> H; by apply/eqP.
Qed.

(**
## 整除可能の補題

奇数（であることの判定）と、剰余とは、独立に定義されている。同値であることを証明する。
*)
Lemma dvdn2' n : 2 %| n <-> ~~ odd n.
Proof. by rewrite dvdn2. Qed.

(**
# GCD・LCM

GCDは、ユーグリッドの互除法で定義される。
*)
Print gcdn_rec.                             (* 略 *)
Print gcdn.

Section GCDLCM.
  Variables m n p : nat.

  Check gcdnn n : gcdn n n = n.
  Check gcdnC n m : gcdn n m = gcdn m n.
  Check gcdnA n m p : gcdn n (gcdn m p) = gcdn (gcdn n m) p.
  Check gcd0n n : gcdn 0 n = n.
  Check gcdn0 n : gcdn n 0 = n.
  Check gcd1n n : gcdn 1 n = 1.
  Check gcdn1 n : gcdn n 1 = 1.
  (* 分配則 *)
  Check muln_gcdr m n p : m * gcdn n p = gcdn (m * n) (m * p).
  Check muln_gcdl m n p : gcdn m n * p = gcdn (m * p) (n * p).

  Check lcmnC n m : lcmn n m = lcmn m n.
  Check lcmnA n m p : lcmn n (lcmn m p) = lcmn (lcmn n m) p.
  Check lcm0n n : lcmn 0 n = 0.
  Check lcmn0 n : lcmn n 0 = 0.
  Check lcm1n n : lcmn 1 n = n.
  Check lcmn1 n : lcmn n 1 = n.
  (* 分配則 *)
  Check muln_lcmr m n p : m * lcmn n p = lcmn (m * n) (m * p).
  Check muln_lcml m n p : lcmn m n * p = lcmn (m * p) (n * p).

(**
ユーグリッドの互除法の1回分の等式である。
後述のとおり gcdn の定義は ``Fixpoint ... {struct m}`` で定義するために
判りにくいものになっている。また、gcdnEの証明自体、とても複雑であることに注意。

いずれにせよ、gcdn を unfold せずに、この補題を使うこと。
*)
  Check gcdnE m n : gcdn m n = if m == 0 then n else gcdn (n %% m) m.

(**
有名な公式：
*)
  Check muln_lcm_gcd m n : lcmn m n * gcdn m n = m * n.
End GCDLCM.

(**
名古屋大学の講義で GCD の証明が取り上げられています。
ここで GCD は、MathCompとは別の定義の、清礎帰納法で定義しています。

この演習問題 gcd_divides は、MathCompの補題 dvdn_gcdl と dvdn_gcdr、
gcd_max は、dvdn_gcd に対応します。

[https://www.math.nagoya-u.ac.jp/~garrigue/lecture/2019_SS/ssrcoq5.pdf]

補足説明：この講義資料では、GCDを通常の ``Fixpoint ... {struct m}`` では定義できないとして、
清礎帰納法 ``Function ... {wf lt m}`` で定義しています。
*)
Section NU.
  Fail Fixpoint gcd (m n : nat) {struct m} : nat :=
    if m is 0 then n else gcd (n %% m) m.

  Function gcd (m n : nat) {wf lt m} : nat :=
    if m is 0 then n else gcd (n %% m) m.
  Proof.
    - move=> m n m0 _.
      (* 除数が0でないことは、Coqにも判っているので、 *)
      (* %% の除数が0でなければ、%% で値は減っていくことを証明する。 *)
      apply/ltP.
        (* Goal : n %% m0.+1 < m0.+1 *)
        by rewrite ltn_mod.
    - exact: lt_wf.
  Qed.
(**
定義がそのまま取り出せるので、gcdnE 相当の補題を用意する必要はありません。
 *)
  Check gcd_equation
    : forall m n : nat, gcd m n = match m with
                                  | 0 => n
                                  | _.+1 => gcd (n %% m) m
                                  end.
(**
しかし、Compute では計算できません。
*)
  Compute gcd 10 3.

(**
ことろで、MathComp では、前述のとおり ``gcdn``
を ``Fixpoint ... {struct m}`` で定義できています。
なぜ、それが可能なのでしょうか？

Fixpoint の場合省略時解釈
で ``{struct id}`` となり、idはCoqが探してくれるのでした。
この場合 ``{struct m}`` に違いありません。

``{struct id}`` は、再帰呼び出し毎に「idが単調減少すること」を示すと説明されますが、
ちょっと正しくありません。実際は、

```
Fixpoint f id := match id with id'.+1 => f id' | ..... end.
``

という ``fix ・・・ match`` の「構造」のなかで減少すること、
つまり match によるパターンマッチを使って
``id - 1 = id'`` という減算が行われることを意味します。

なお、この match は ``if id is id'.+1 then f id' else ....`` というif式でもよいですが、
bool の ``if b then ... else ...`` では、wfのレベルでエラーになるようです。

具体的にいうと、次の ftest1 はFixpoint で定義できます。
 *)
  Fixpoint ftest1 m {struct m} := if m is m'.+1 then ftest1 m' else 0.

(**
パターンマッチではなく、``.-1`` によって減算する場合
は、``{struct m}`` ではエラーになります。
*)
  Fail Function ftest2 m {struct m} := if m is 0 then 0 else ftest2 m.-1.

(**
整礎帰納法を使う必要があります。
*)
  Function ftest3 m {wf lt m} := if m is 0 then 0 else ftest3 m.-1.
  Proof.
    move=> m m' H.
    - have l_test n : n != 0 -> n.-1 < n by case: n.
        by apply/ltP/l_test.
    - by apply: lt_wf.
  Qed.

(**
MathComp の ``gcdn`` の定義を見ると、技巧的に ``match``
(``if ... is ... then ... else ...``) が使われていることが判ります。

補足終わり。
*)
End NU.

(**
# 互いに素 (coprime, relatively prime)
*)
(**
## 互いに素の定義
*)
Print coprime.                              (* boolena述語 *)
(**
fun m n : nat => gcdn m n == 1
 *)

Goal forall m n, gcdn m n = 1 <-> coprime m n.
Proof.
  move=> m n.
  split=> H.
  - apply/eqP.
    done.
  - apply/eqP.
    done.
Qed.

(**
## 互いに素の補題
 *)
Check coprime1n : forall n : nat, coprime 1 n.
Check coprimen1 : forall n : nat, coprime n 1.
Check coprime_sym : forall m n : nat, coprime m n = coprime n m.

(**
# 合同式

以下を参照してください：

コンピュータの数学 4.6 合同関係 の公式の証明

https://qiita.com/suharahiromichi/items/01b8c38b7c6a7f26fe05

https://github.com/suharahiromichi/coq/blob/master/gkp/gkp_4_6_modulo.v
 *)

(* END *)