mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

(rnrs arithmetic fixnums) fixnum? export a procedure again

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-04-13 12:50:16 +02:00
parent 37325c9bd2
commit 9d6a151fbd
2 changed files with 338 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/rnrs/arithmetic/fixnums.scm
View file

@ -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)