[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: Allow for inexact integers in quo, rem, and so on
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/02: Allow for inexact integers in quo, rem, and so on |
Date: |
Mon, 9 Dec 2019 16:03:10 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 2178de4d38553adf53e84063dcb7376c88c80e6d
Author: Andy Wingo <address@hidden>
Date: Mon Dec 9 21:08:43 2019 +0100
Allow for inexact integers in quo, rem, and so on
* module/language/cps/types.scm (&integer): New helper definition.
(quo, rem, mod): Fix to allow inexact integer results :(
(even?): Allow inexact integer arguments.
---
module/language/cps/types.scm | 53 ++++++++++++++++++++++---------------------
1 file changed, 27 insertions(+), 26 deletions(-)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index cb1fa81..6447a25 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1282,44 +1282,45 @@ minimum, and maximum."
(lambda (min max)
(define! result &f64 min max)))))
+(define &integer (logior &exact-integer &flonum))
+
(define-type-checker (quo a b)
- (and (check-type a &exact-integer -inf.0 +inf.0)
- (check-type b &exact-integer -inf.0 +inf.0)
+ (and (check-type a &integer -inf.0 +inf.0)
+ (check-type b &integer -inf.0 +inf.0)
;; We only know that there will not be an exception if b is not
;; zero.
(not (<= (&min b) 0 (&max b)))))
(define-type-inferrer (quo a b result)
- (restrict! a &exact-integer -inf.0 +inf.0)
- (restrict! b &exact-integer -inf.0 +inf.0)
- (define! result &exact-integer -inf.0 +inf.0))
+ (restrict! a &integer -inf.0 +inf.0)
+ (restrict! b &integer -inf.0 +inf.0)
+ (define! result (logand (logior (&type a) (&type b)) &integer)
+ -inf.0 +inf.0))
(define-type-checker-aliases quo rem)
(define-type-inferrer (rem a b result)
- (restrict! a &exact-integer -inf.0 +inf.0)
- (restrict! b &exact-integer -inf.0 +inf.0)
+ (restrict! a &integer -inf.0 +inf.0)
+ (restrict! b &integer -inf.0 +inf.0)
;; Same sign as A.
- (let ((max-abs-rem (1- (max (abs (&min b)) (abs (&max b))))))
- (cond
- ((< (&min a) 0)
- (define-exact-integer! result
- (- max-abs-rem)
- (if (< 0 (&max a)) max-abs-rem 0)))
- (else
- (define-exact-integer! result 0 max-abs-rem)))))
+ (let* ((max-abs-rem (1- (max (abs (&min b)) (abs (&max b)))))
+ (t (logand (logior (&type a) (&type b)) &integer))
+ (min-rem (if (< (&min a) 0) (- max-abs-rem) 0))
+ (max-rem (if (< 0 (&max a)) max-abs-rem 0)))
+ (if (type<=? t &exact-integer)
+ (define-exact-integer! result min-rem max-rem)
+ (define! result t min-rem max-rem))))
(define-type-checker-aliases quo mod)
(define-type-inferrer (mod a b result)
- (restrict! a &exact-integer -inf.0 +inf.0)
- (restrict! b &exact-integer -inf.0 +inf.0)
+ (restrict! a &integer -inf.0 +inf.0)
+ (restrict! b &integer -inf.0 +inf.0)
;; Same sign as B.
- (let ((max-abs-mod (1- (max (abs (&min b)) (abs (&max b))))))
- (cond
- ((< (&min b) 0)
- (define-exact-integer! result
- (- max-abs-mod)
- (if (< 0 (&max b)) max-abs-mod 0)))
- (else
- (define-exact-integer! result 0 max-abs-mod)))))
+ (let* ((max-abs-mod (1- (max (abs (&min b)) (abs (&max b)))))
+ (t (logand (logior (&type a) (&type b)) &integer))
+ (min-mod (if (< (&min b) 0) (- max-abs-mod) 0))
+ (max-mod (if (< 0 (&max b)) max-abs-mod 0)))
+ (if (type<=? t &exact-integer)
+ (define-exact-integer! result min-mod max-mod)
+ (define! result t min-mod max-mod))))
;; Predicates.
(define-syntax-rule (define-type-predicate-result val result type)
@@ -1353,7 +1354,7 @@ minimum, and maximum."
(define-type-aliases inf? nan?)
-(define-simple-type (even? &exact-integer)
+(define-simple-type (even? &integer)
(&special-immediate &false &true))
(define-type-aliases even? odd?)