unify types for quotient, remainder and quotient/remainder

use the same spec to generate types for them.

closes #1039

Author: capfredf

typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt

@@ -682,6 +682,55 @@
      ((Un -PosReal -NegReal) . -> . -PosReal)
      (-Real . -> . -NonNegReal)))
 
+
+  (define-syntax (quotient-reminder-cases stx)
+    (syntax-parse stx #:datum-literals (->)
+                  [(_ (-> a b (c d)) ...)
+                   #'(values (list (-> a b c) ...)
+                             (list (-> a b d) ...)
+                             (list (-> a b (-values (list c d))) ...))]))
+
+  (define-values (quotient-spec remainder-spec quotient/remainder-spec)
+    (quotient-reminder-cases
+     (-Zero -Int . -> . (-Zero -Zero))
+     (-One -One . -> . (-Zero -One))
+     ;; division by one is identity, and has no remainder
+     (-PosByte -One . -> . (-PosByte -Zero))
+     (-Byte -One . -> . (-Byte -Zero))
+     (-PosIndex -One . -> . (-PosIndex -Zero))
+     (-Index -One . -> . (-Index -Zero))
+     (-PosFixnum -One . -> . (-PosFixnum -Zero))
+     (-NonNegFixnum -One . -> . (-NonNegFixnum -Zero))
+     (-NegFixnum -One . -> . (-NegFixnum -Zero))
+     (-NonPosFixnum -One . -> . (-NonPosFixnum -Zero))
+     (-Fixnum -One . -> . (-Fixnum -Zero))
+     (-Byte -Nat . -> . (-Byte -Byte))
+     (-Byte -Int . -> . (-Fixnum -Byte))
+     (-Index -Nat . -> . (-Index -Index))
+     (-Index -Int . -> . (-Fixnum -Index))
+     (-NonNegFixnum -Byte . -> . (-NonNegFixnum -Byte))
+     (-NonNegFixnum -NonNegFixnum . -> . (-NonNegFixnum -NonNegFixnum))
+     (-NonNegFixnum -NonPosFixnum . -> . (-NonPosFixnum -NonNegFixnum))
+     (-NonPosFixnum -NonNegFixnum . -> . (-NonPosFixnum -NonPosFixnum))
+     (-NonPosFixnum -NonPosFixnum . -> . (-Nat -NonPosFixnum))
+     (-NonNegFixnum -Nat . -> . (-NonNegFixnum -NonNegFixnum))
+     (-NonNegFixnum -Int . -> . (-Fixnum -NonNegFixnum))
+     (-Nat -Byte . -> . (-Nat -Byte))
+     (-Nat -Index . -> . (-Nat -Index))
+     (-Nat -NonNegFixnum . -> . (-Nat -NonNegFixnum))
+     ;; in the following cases, we can't guarantee that the quotient is within
+     ;; fixnum range: (quotient min-fixnum -1) -> max-fixnum + 1
+     (-NonPosFixnum -Int . -> . (-Int -NonPosFixnum))
+     (-Fixnum -Int . -> . (-Int -Fixnum))
+     (-Int -Fixnum . -> . (-Int -Fixnum))
+     (-Nat -Nat . -> . (-Nat -Nat))
+     (-Nat -NonPosInt . -> . (-NonPosInt -Nat))
+     (-Nat -Int . -> . (-Int -Nat))
+     (-NonPosInt -Nat . -> . (-NonPosInt -NonPosInt))
+     (-NonPosInt -NonPosInt . -> . (-Nat -NonPosInt))
+     (-NonPosInt -Int . -> . (-Int -NonPosInt))
+     (-Int -Int . -> . (-Int -Int))))
+
   ;Check to ensure we fail fast if the flonum bindings change
   (define-namespace-anchor anchor)
   (let ((flonum-ops #'([unsafe-flround    flround]
@@ -1309,36 +1358,10 @@
        (-> -NonPosReal -NegReal)
        (map unop (list -Real -FloatComplex -SingleFlonumComplex -InexactComplex N)))]
 
-[quotient
- (from-cases
-  (-Zero -Int . -> . -Zero)
-  (map (lambda (t) (-> t -One t)) ; division by one is identity
-       (list -PosByte -Byte -PosIndex -Index
-             -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum))
-  (-Byte -Nat . -> . -Byte)
-  (-Byte -Int . -> . -Fixnum) ; may be negative
-  (-Index -Nat . -> . -Index)
-  (-Index -Int . -> . -Fixnum) ; same.
-  ;; we don't have equivalent for fixnums:
-  ;; (quotient min-fixnum -1) -> max-fixnum + 1
-  (commutative-binop -NonNegFixnum -NonPosFixnum -NonPosFixnum)
-  (-NonPosFixnum -NonPosFixnum . -> . -Nat)
-  (-NonNegFixnum -Nat . -> . -NonNegFixnum)
-  (-NonNegFixnum -Int . -> . -Fixnum)
-  (binop -Nat)
-  (commutative-binop -Nat -NonPosInt -NonPosInt)
-  (-NonPosInt -NonPosInt . -> . -Nat)
-  (binop -Int))]
-[remainder ; result has same sign as first arg
- (from-cases
-  (-One -One . -> . -Zero)
-  (map (lambda (t) (list (-> -Nat t t)
-                         (-> t -Int t)))
-       (list -Byte -Index -NonNegFixnum -Nat))
-  (-NonPosFixnum -Int . -> . -NonPosFixnum)
-  (-NonPosInt -Int . -> . -NonPosInt)
-  (commutative-binop -Fixnum -Int)
-  (binop -Int))]
+[quotient (from-cases quotient-spec)]
+
+[remainder (from-cases remainder-spec)]; result has same sign as first arg
+
 [modulo ; result has same sign as second arg
  (from-cases
   (-One -One . -> . -Zero)
@@ -1350,39 +1373,7 @@
   (commutative-binop -Fixnum -Int)
   (binop -Int))]
 ;; should be consistent with quotient and remainder
-[quotient/remainder
- (from-cases
-  (-Zero -Int . -> . (-values (list -Zero -Zero)))
-  (-One -One . -> . (-values (list -Zero -One)))
-  ;; division by one is identity, and has no remainder
-  (map (lambda (t) (t -One . -> . (-values (list t -Zero))))
-       (list -PosByte -Byte -PosIndex -Index
-             -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum))
-  (-Byte -Nat . -> . (-values (list -Byte -Byte)))
-  (-Byte -Int . -> . (-values (list -Fixnum -Byte)))
-  (-Index -Nat . -> . (-values (list -Index -Index)))
-  (-Index -Int . -> . (-values (list -Fixnum -Index)))
-  (-Nat -Byte . -> . (-values (list -Nat -Byte)))
-  (-Nat -Index . -> . (-values (list -Nat -Index)))
-  (-NonNegFixnum -NonNegFixnum . -> . (-values (list -NonNegFixnum -NonNegFixnum)))
-  (-NonNegFixnum -NonPosFixnum . -> . (-values (list -NonPosFixnum -NonNegFixnum)))
-  (-NonPosFixnum -NonNegFixnum . -> . (-values (list -NonPosFixnum -NonPosFixnum)))
-  (-NonPosFixnum -NonPosFixnum . -> . (-values (list -NonNegFixnum -NonPosFixnum)))
-  (-NonNegFixnum -Nat . -> . (-values (list -NonNegFixnum -NonNegFixnum)))
-  (-NonNegFixnum -Int . -> . (-values (list -Fixnum -NonNegFixnum)))
-  (-Nat -NonNegFixnum . -> . (-values (list -Nat -NonNegFixnum)))
-  ;; in the following cases, we can't guarantee that the quotient is within
-  ;; fixnum range: (quotient min-fixnum -1) -> max-fixnum + 1
-  (-NonPosFixnum -Int . -> . (-values (list -Int -NonPosFixnum)))
-  (-Fixnum -Int . -> . (-values (list -Int -Fixnum)))
-  (-Int -Fixnum . -> . (-values (list -Int -Fixnum)))
-  (-Nat -Nat . -> . (-values (list -Nat -Nat)))
-  (-Nat -NonPosInt . -> . (-values (list -NonPosInt -Nat)))
-  (-Nat -Int . -> . (-values (list -Int -Nat)))
-  (-NonPosInt -Nat . -> . (-values (list -NonPosInt -NonPosInt)))
-  (-NonPosInt -NonPosInt . -> . (-values (list -Nat -NonPosInt)))
-  (-NonPosInt -Int . -> . (-values (list -Int -NonPosInt)))
-  (-Int -Int . -> . (-values (list -Int -Int))))]
+[quotient/remainder (from-cases quotient/remainder-spec)]
 
 [arithmetic-shift (cl->* (-Zero -NonPosInt . -> . -Zero)
                          (-Byte -NonPosInt . -> . -Byte)

typed-racket-test/succeed/gh-issue-1039.rkt

@@ -0,0 +1,11 @@
+#lang typed/racket/base
+
+(: my-remainder1 (-> Integer Fixnum Fixnum))
+(define (my-remainder1 x y)
+  (define-values [q r]
+    (quotient/remainder x y))
+  r)
+
+(: my-remainder2 (-> Integer Fixnum Fixnum))
+(define (my-remainder2 x y)
+  (remainder x y))