summaryrefslogtreecommitdiff
path: root/module/rnrs/arithmetic
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-04-13 12:50:16 +0200
committerAndy Wingo <wingo@pobox.com>2011-04-13 12:50:41 +0200
commit9d6a151fbd54c813194f4907220f9f2f04ff4f1c (patch)
treeacabbb4884497ec6b57c80662143a6c7c139b272 /module/rnrs/arithmetic
parent37325c9bd2c70d19a663541a4e23f7bf6f86d478 (diff)
downloadguile-9d6a151fbd54c813194f4907220f9f2f04ff4f1c.tar.gz
(rnrs arithmetic fixnums) fixnum? export a procedure again
* module/rnrs/arithmetic/fixnums.scm (fixnum?): Restore this export to be a procedure, not syntax. (inline-fixnum?): This is what fixnum? was. Use it internally.
Diffstat (limited to 'module/rnrs/arithmetic')
-rw-r--r--module/rnrs/arithmetic/fixnums.scm19
1 files changed, 12 insertions, 7 deletions
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index 0ce245811..e6261999a 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -102,17 +102,20 @@
(define (greatest-fixnum) most-positive-fixnum)
(define (least-fixnum) most-negative-fixnum)
- (define-inlinable (fixnum? obj)
+ (define (fixnum? obj)
+ (not (= 0 (logand 2 (object-address obj)))))
+
+ (define-inlinable (inline-fixnum? obj)
(not (= 0 (logand 2 (object-address obj)))))
(define-syntax assert-fixnum
(syntax-rules ()
((_ arg ...)
- (or (and (fixnum? arg) ...)
+ (or (and (inline-fixnum? arg) ...)
(raise (make-assertion-violation))))))
(define (assert-fixnums args)
- (or (for-all fixnum? args) (raise (make-assertion-violation))))
+ (or (for-all inline-fixnum? args) (raise (make-assertion-violation))))
(define-syntax define-fxop*
(syntax-rules ()
@@ -147,13 +150,15 @@
(define (fx+ fx1 fx2)
(assert-fixnum fx1 fx2)
(let ((r (+ fx1 fx2)))
- (or (fixnum? r) (raise (make-implementation-restriction-violation)))
+ (or (inline-fixnum? r)
+ (raise (make-implementation-restriction-violation)))
r))
(define (fx* fx1 fx2)
(assert-fixnum fx1 fx2)
(let ((r (* fx1 fx2)))
- (or (fixnum? r) (raise (make-implementation-restriction-violation)))
+ (or (inline-fixnum? r)
+ (raise (make-implementation-restriction-violation)))
r))
(define* (fx- fx1 #:optional fx2)
@@ -162,10 +167,10 @@
(begin
(assert-fixnum fx2)
(let ((r (- fx1 fx2)))
- (or (fixnum? r) (raise (make-assertion-violation)))
+ (or (inline-fixnum? r) (raise (make-assertion-violation)))
r))
(let ((r (- fx1)))
- (or (fixnum? r) (raise (make-assertion-violation)))
+ (or (inline-fixnum? r) (raise (make-assertion-violation)))
r)))
(define (fxdiv fx1 fx2)