Move theory on int_to_nat to a separate file. Perform some clean up.

src/implementations/nonneg_integers_naturals.v

@@ -1,5 +1,5 @@
 Require 
-  peano_naturals orders.integers theory.integers.
+  peano_naturals.
 Require Import
   Ring abstract_algebra interfaces.integers interfaces.naturals interfaces.orders
   interfaces.additional_operations int_abs.
@@ -12,38 +12,31 @@ Context `{Integers Z} `{Apart Z} `{!TrivialApart Z} `{!FullPseudoSemiRingOrder Z
 Add Ring Z: (rings.stdlib_ring_theory Z).
 
 (* We show that [Z⁺] is an instance of the naturals by constructing a retract to [nat] *)
-Program Definition of_nat (x : nat) : Z⁺ := (naturals_to_semiring nat Z x)↾_.
+Program Let of_nat (x : nat) : Z⁺ := (naturals_to_semiring nat Z x)↾_.
 Next Obligation. apply nat_int.to_semiring_nonneg. Qed.
 
 Local Ltac unfold_equivs := unfold equiv, sig_equiv in *; simpl in *.
 
 Instance: Proper ((=) ==> (=)) of_nat.
-Proof.
-  intros x y E. unfold_equivs. 
-  now rewrite E.
-Qed.
+Proof. intros ?? E. unfold_equivs. now rewrite E. Qed.
 
 Instance: SemiRing_Morphism of_nat.
 Proof.
-  pose proof (_ : SemiRing (Z⁺)).
   repeat (split; try apply _); repeat intro; unfold_equivs.
      now apply rings.preserves_plus.
     unfold mon_unit, zero_is_mon_unit. now apply rings.preserves_0.
    now apply rings.preserves_mult.
   unfold mon_unit, one_is_mon_unit. now apply rings.preserves_1.
 Qed.
 
-Program Instance to_nat: Inverse of_nat := λ x, int_abs Z nat (`x).
+Program Let to_nat: Inverse of_nat := λ x, int_abs Z nat (`x).
+Existing Instance to_nat.
 
 Instance: Proper ((=) ==> (=)) to_nat.
-Proof.
-  intros [x Ex] [y Ey] E. unfold to_nat. unfold_equivs. 
-  now rewrite E.
-Qed.
+Proof. intros [??] [??] E. unfold to_nat. unfold_equivs. now rewrite E. Qed.
 
-Instance ZPos_to_nat_sr_morphism: SemiRing_Morphism to_nat.
+Instance: SemiRing_Morphism to_nat.
 Proof.
-  pose proof (_ : SemiRing (Z⁺)).
   repeat (split; try apply _). 
      intros [x Ex] [y Ey]. unfold to_nat; unfold_equivs. simpl.
      now apply int_abs_nonneg_plus. 
@@ -64,8 +57,10 @@ Qed.
 Global Instance: NaturalsToSemiRing (Z⁺) := naturals.retract_is_nat_to_sr of_nat.
 Global Instance: Naturals (Z⁺) := naturals.retract_is_nat of_nat.
 
-Global Program Instance ZPos_cut_minus `{∀ x y : Z, Decision (x ≤ y)} : CutMinus (Z⁺) 
-  := λ x y, if decide_rel (≤) x y then 0 else ((x : Z) - (y : Z))↾_.
+Context `{∀ x y : Z, Decision (x ≤ y)}.
+
+Global Program Instance ZPos_cut_minus: CutMinus (Z⁺) := λ x y, 
+  if decide_rel (≤) x y then 0 else ((x : Z) - (y : Z))↾_.
 Next Obligation.
   apply <-rings.flip_nonneg_minus. 
   now apply orders.le_flip.

src/orders/semirings.v

@@ -665,6 +665,17 @@ Section another_semiring_strict.
   Context `{StrictSemiRingOrder R1} `{StrictSemiRingOrder R2}
     `{!SemiRing_Morphism (f : R1 → R2)}.
 
+  Lemma strictly_preserving_preserves_pos : (∀ x, 0 < x → 0 < f x) → StrictlyOrderPreserving f.
+  Proof.
+    intros E.
+    repeat (split; try apply _).
+    intros x y F.
+    destruct (decompose_lt F) as [z [Ez1 Ez2]].
+    apply compose_lt with (f z).
+     now apply E.
+    now rewrite Ez2, preserves_plus.
+  Qed.
+
   Instance preserves_pos `{!StrictlyOrderPreserving f} x : PropHolds (0 < x) → PropHolds (0 < f x).
   Proof. intros. rewrite <-(preserves_0 (f:=f)). now apply (strictly_order_preserving f). Qed.
 
@@ -681,3 +692,7 @@ End another_semiring_strict.
 (* Due to bug #2528 *)
 Hint Extern 15 (PropHolds (_ ≤ _ _)) => eapply @preserves_nonneg : typeclass_instances.
 Hint Extern 15 (PropHolds (_ < _ _)) => eapply @preserves_pos : typeclass_instances.
+
+(* Oddly enough, the above hints do not work for goals of the following shape? *)
+Hint Extern 15 (PropHolds (_ ≤ '_)) => eapply @preserves_nonneg : typeclass_instances.
+Hint Extern 15 (PropHolds (_ < '_)) => eapply @preserves_pos : typeclass_instances.

src/theory/int_abs.v

@@ -1,8 +1,6 @@
-Require
-  theory.nat_distance.
 Require Import
-  Ring interfaces.naturals abstract_algebra interfaces.orders natpair_integers
-  theory.integers theory.rings orders.naturals orders.rings.
+  Ring interfaces.naturals abstract_algebra interfaces.orders
+  orders.nat_int theory.integers theory.rings orders.rings.
 
 Section contents. 
 Context `{Integers Z} `{Apart Z} `{!TrivialApart Z} `{!FullPseudoSemiRingOrder Zle Zlt} `{Naturals N}.
@@ -25,49 +23,11 @@ Lemma int_abs_unique (a b : IntAbs Z N) (z : Z) :
   int_abs Z N (ia:=a) z = int_abs Z N (ia:=a) z.
 Proof. now apply int_abs_unique_respectful. Qed.
 
-Lemma int_to_nat_unique_respectful {a b : IntAbs Z N} : 
-  ((=) ==> (=))%signature (int_to_nat Z N (ia:=a)) (int_to_nat Z N (ia:= b)).
-Proof.
-  intros x y E. unfold int_to_nat, int_abs_sig.
-  apply (injective (naturals_to_semiring N Z)).
-  destruct a as [[z1 A]|[z1 A]], b as [[z2 B]|[z2 B]].
-     now rewrite A, B.
-    destruct (naturals.to_ring_zero_sum z2 z1) as [? E2]. 
-     now rewrite B, A, involutive.
-    now rewrite E2.
-   destruct (naturals.to_ring_zero_sum z1 z2) as [? E2]. 
-    now rewrite B, A, involutive.
-   now rewrite E2.
-  reflexivity.
-Qed.
-
-Lemma int_to_nat_unique (a b : IntAbs Z N) (z : Z) : 
-  int_to_nat Z N (ia:=a) z = int_to_nat Z N (ia:=a) z.
-Proof. now apply int_to_nat_unique_respectful. Qed.
-
-Global Program Instance slow_int_abs: IntAbs Z N | 10 := λ x, 
-  match int_abs_sig (SRpair N) N (integers_to_ring Z (SRpair N) x) with
-  | inl (n↾E) => inl n
-  | inr (n↾E) => inr n
-  end.
-Next Obligation.
-  apply (injective (integers_to_ring Z (SRpair N))).
-  rewrite <-E. apply (naturals.to_semiring_twice _ _ _).
-Qed.
-Next Obligation.
-  apply (injective (integers_to_ring Z (SRpair N))).
-  rewrite preserves_negate, <-E.
-  now apply (naturals.to_semiring_twice _ _ _).
-Qed.
-
 Context `{!IntAbs Z N}.
 
 Global Instance int_abs_proper: Setoid_Morphism (int_abs Z N) | 0.
 Proof. split; try apply _. now apply int_abs_unique_respectful. Qed.
 
-Global Instance int_to_nat_proper: Setoid_Morphism (int_to_nat Z N) | 0.
-Proof. split; try apply _. now apply int_to_nat_unique_respectful. Qed.
-
 Context `{!SemiRing_Morphism (f : N → Z)}.
 
 Lemma int_abs_spec x :
@@ -165,81 +125,4 @@ Proof.
    rewrite int_abs_nonpos. ring. now apply nonpos_nonneg_mult.
   rewrite int_abs_nonneg. ring. now apply nonpos_mult.
 Qed.
-
-Lemma int_to_nat_spec x :
-  { 0 ≤ x ∧ f (int_to_nat Z N x) = x } + { x ≤ 0 ∧ int_to_nat Z N x = 0 }.
-Proof.
-  unfold int_to_nat. destruct int_abs_sig as [[n E]|[n E]].
-   left. rewrite <-E. split.
-    now apply to_semiring_nonneg.
-   apply (naturals.to_semiring_unique_alt _ _).
-  right. intuition. apply flip_nonpos_negate. rewrite <-E. 
-  now apply to_semiring_nonneg.
-Qed.
-
-Lemma int_to_nat_nat n : 
-  int_to_nat Z N (f n) = n.
-Proof.
-  apply (injective f). destruct (int_to_nat_spec (f n)) as [[??]|[? E]]; intuition.
-  rewrite E, preserves_0. apply (antisymmetry (≤)); intuition.
-  now apply to_semiring_nonneg.
-Qed. 
-
-Lemma int_to_nat_negate_nat n : 
-  int_to_nat Z N (-f n) = 0.
-Proof.
-  apply (injective f). destruct (int_to_nat_spec (-f n)) as [[? E]|[? E]].
-   rewrite E, preserves_0. apply (antisymmetry (≤)); intuition.
-   now apply negate_to_ring_nonpos.
-  now rewrite E.
-Qed. 
-
-Lemma int_to_nat_0 : int_to_nat Z N 0 = 0.
-Proof. rewrite <-(preserves_0 (f:=f)) at 1. now apply int_to_nat_nat. Qed.
-
-Lemma int_to_nat_nonneg x : 
-  0 ≤ x → f (int_to_nat Z N x) = x.
-Proof.
-  intros E1. destruct (int_to_nat_spec x) as [[? E2]|[? E2]]; intuition.
-  rewrite E2, preserves_0. now apply (antisymmetry (≤)).
-Qed.
-
-Lemma int_to_nat_nonpos x : 
-  x ≤ 0 → f (int_to_nat Z N x) = 0.
-Proof.
-  intros E. destruct (int_to_nat_spec x) as [[? E2]|[? E2]].
-   rewrite E2. now apply (antisymmetry (≤)).
-  now rewrite E2, preserves_0.
-Qed.
-
-Lemma int_to_nat_nonneg_plus x y : 
-  0 ≤ x → 0 ≤ y → int_to_nat Z N (x + y) = int_to_nat Z N x + int_to_nat Z N y.
-Proof.
-  intros. apply (injective f).
-  rewrite preserves_plus, !int_to_nat_nonneg; intuition.
-  now apply nonneg_plus_compat.
-Qed.
-
-Lemma int_to_nat_mult_nonneg_l x y : 
-  0 ≤ x → int_to_nat Z N (x * y) = int_to_nat Z N x * int_to_nat Z N y.
-Proof.
-  intros E. apply (injective f). rewrite preserves_mult. 
-  rewrite (int_to_nat_nonneg x) by easy.
-  destruct (int_to_nat_spec y) as [[? Ey]|[? Ey]]; rewrite Ey, ?preserves_0.
-   rewrite int_to_nat_nonneg. easy. now apply nonneg_mult_compat.
-  rewrite int_to_nat_nonpos. ring. now apply nonneg_nonpos_mult.
-Qed.
-
-Lemma int_to_nat_mult_nonneg_r x y : 
-  0 ≤ y → int_to_nat Z N (x * y) = int_to_nat Z N x * int_to_nat Z N y.
-Proof. 
-  rewrite (commutativity x), (commutativity (int_to_nat Z N x)).
-  now apply int_to_nat_mult_nonneg_l.
-Qed.
-
-Lemma int_to_nat_1 : int_to_nat Z N 1 = 1.
-Proof.
-  apply (injective f). rewrite preserves_1.
-  apply int_to_nat_nonneg; solve_propholds.
-Qed.
 End contents.