diff options
author | Andy Wingo <wingo@pobox.com> | 2011-04-28 15:53:35 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-04-28 15:53:35 +0200 |
commit | 1903eae4c9ab97b575dad4ab1f5cf05436d84ab3 (patch) | |
tree | dbb5a83c4dce6f6f10642b3d39ec76ee63dd77a5 /module/rnrs | |
parent | 0c81a0c13ad39c381e4ff4d073e3158bcfd51a7a (diff) | |
parent | 91956a94fe6363cf69d574b56397962ec6ef4468 (diff) | |
download | guile-1903eae4c9ab97b575dad4ab1f5cf05436d84ab3.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
Diffstat (limited to 'module/rnrs')
-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) |