diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-07-18 15:31:34 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-07-18 15:31:34 -0400 |
| commit | f82f62944a4e605d385f40b5a4a01e19677bc0b3 (patch) | |
| tree | 7fc4a887fd5033748dc1e9603052514e5e58f2ca /module/rnrs | |
| parent | 902a4e779da1193ff9097c23b40fbd44ab2df6a3 (diff) | |
| parent | 824b9ad8b792ab42c5cc614d66462dfaab489075 (diff) | |
| download | guile-f82f62944a4e605d385f40b5a4a01e19677bc0b3.tar.gz | |
Merge remote-tracking branch 'origin/stable-2.0'
Diffstat (limited to 'module/rnrs')
| -rw-r--r-- | module/rnrs/arithmetic/bitwise.scm | 2 | ||||
| -rw-r--r-- | module/rnrs/arithmetic/fixnums.scm | 16 | ||||
| -rw-r--r-- | module/rnrs/arithmetic/flonums.scm | 2 |
3 files changed, 14 insertions, 6 deletions
diff --git a/module/rnrs/arithmetic/bitwise.scm b/module/rnrs/arithmetic/bitwise.scm index ac870ff79..0acbc8cb6 100644 --- a/module/rnrs/arithmetic/bitwise.scm +++ b/module/rnrs/arithmetic/bitwise.scm @@ -1,6 +1,6 @@ ;;; bitwise.scm --- The R6RS bitwise arithmetic operations library -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index e6261999a..7a5a6215e 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -1,6 +1,6 @@ ;;; fixnums.scm --- The R6RS fixnums arithmetic library -;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -95,8 +95,11 @@ (rnrs exceptions (6)) (rnrs lists (6))) - (define fixnum-width - (let ((w (inexact->exact (round (/ (log (+ most-positive-fixnum 1)) (log 2)))))) + (define fixnum-width + (let ((w (do ((i 0 (+ 1 i)) + (n 1 (* 2 n))) + ((> n most-positive-fixnum) + (+ 1 i))))) (lambda () w))) (define (greatest-fixnum) most-positive-fixnum) @@ -227,7 +230,12 @@ (assert-fixnum fx1 fx2 fx3) (bitwise-if fx1 fx2 fx3)) - (define (fxbit-count fx) (assert-fixnum fx) (logcount fx)) + (define (fxbit-count fx) + (assert-fixnum fx) + (if (negative? fx) + (bitwise-not (logcount fx)) + (logcount fx))) + (define (fxlength fx) (assert-fixnum fx) (bitwise-length fx)) (define (fxfirst-bit-set fx) (assert-fixnum fx) (bitwise-first-bit-set fx)) (define (fxbit-set? fx1 fx2) (assert-fixnum fx1 fx2) (logbit? fx2 fx1)) diff --git a/module/rnrs/arithmetic/flonums.scm b/module/rnrs/arithmetic/flonums.scm index fd04a4a0e..1c4b94ce7 100644 --- a/module/rnrs/arithmetic/flonums.scm +++ b/module/rnrs/arithmetic/flonums.scm @@ -1,6 +1,6 @@ ;;; flonums.scm --- The R6RS flonums arithmetic library -;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public |