diff options
author | Andy Wingo <wingo@pobox.com> | 2011-04-13 12:50:16 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-04-13 12:50:41 +0200 |
commit | 9d6a151fbd54c813194f4907220f9f2f04ff4f1c (patch) | |
tree | acabbb4884497ec6b57c80662143a6c7c139b272 /module/rnrs/arithmetic | |
parent | 37325c9bd2c70d19a663541a4e23f7bf6f86d478 (diff) | |
download | guile-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.scm | 19 |
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) |