[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-44-g93da40
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-44-g93da406 |
Date: |
Sun, 21 Jul 2013 14:24:46 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=93da406f331a1849f05e63387442b9aaf33f9540
The branch, stable-2.0 has been updated
via 93da406f331a1849f05e63387442b9aaf33f9540 (commit)
from eba5c07715f556d3c27b85afb01baa8a189d7849 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 93da406f331a1849f05e63387442b9aaf33f9540
Author: Mark H Weaver <address@hidden>
Date: Sun Jul 21 10:00:48 2013 -0400
Optimize R6RS bitwise operators.
* module/rnrs/arithmetic/bitwise.scm (bitwise-if, bitwise-length,
bitwise-first-bit-set, bitwise-bit-field, bitwise-reverse-bit-field):
Replace these with aliases to the identical SRFI-60 operators
'bitwise-if', 'integer-length', 'first-set-bit', 'bit-field', and
'reverse-bit-field'.
(bitwise-copy-bit, bitwise-copy-bit-field, bitwise-rotate-bit-field):
Reimplement these based upon the similar SRFI-60 operators 'copy-bit',
'copy-bit-field', and 'rotate-bit-field'.
* test-suite/tests/r6rs-arithmetic-bitwise.test (bitwise-copy-bit): Fix
test to conform to the specification, which requires the third
argument to be either 0 or 1.
* test-suite/tests/r6rs-arithmetic-fixnums.test (fxcopy-bit): Fix test
to conform to the specification, which requires the third argument to
be either 0 or 1.
-----------------------------------------------------------------------
Summary of changes:
module/rnrs/arithmetic/bitwise.scm | 81 +++++++------------------
test-suite/tests/r6rs-arithmetic-bitwise.test | 2 +-
test-suite/tests/r6rs-arithmetic-fixnums.test | 2 +-
3 files changed, 24 insertions(+), 61 deletions(-)
diff --git a/module/rnrs/arithmetic/bitwise.scm
b/module/rnrs/arithmetic/bitwise.scm
index 0acbc8c..5f66cf1 100644
--- a/module/rnrs/arithmetic/bitwise.scm
+++ b/module/rnrs/arithmetic/bitwise.scm
@@ -41,6 +41,18 @@
bitwise-reverse-bit-field)
(import (rnrs base (6))
(rnrs control (6))
+ (rename (only (srfi srfi-60) bitwise-if
+ integer-length
+ first-set-bit
+ copy-bit
+ bit-field
+ copy-bit-field
+ rotate-bit-field
+ reverse-bit-field)
+ (integer-length bitwise-length)
+ (first-set-bit bitwise-first-bit-set)
+ (bit-field bitwise-bit-field)
+ (reverse-bit-field bitwise-reverse-bit-field))
(rename (only (guile) lognot
logand
logior
@@ -60,70 +72,21 @@
(bitwise-not (logcount ei))
(logcount ei)))
- (define (bitwise-if ei1 ei2 ei3)
- (bitwise-ior (bitwise-and ei1 ei2) (bitwise-and (bitwise-not ei1) ei3)))
-
- (define (bitwise-length ei)
- (do ((result 0 (+ result 1))
- (bits (if (negative? ei) (bitwise-not ei) ei)
- (bitwise-arithmetic-shift bits -1)))
- ((zero? bits)
- result)))
-
- (define (bitwise-first-bit-set ei)
- (define (bitwise-first-bit-set-inner bits count)
- (cond ((zero? bits) -1)
- ((logbit? 0 bits) count)
- (else (bitwise-first-bit-set-inner
- (bitwise-arithmetic-shift bits -1) (+ count 1)))))
- (bitwise-first-bit-set-inner ei 0))
-
(define (bitwise-bit-set? ei1 ei2) (logbit? ei2 ei1))
(define (bitwise-copy-bit ei1 ei2 ei3)
- (bitwise-if (bitwise-arithmetic-shift-left 1 ei2)
- (bitwise-arithmetic-shift-left ei3 ei2)
- ei1))
-
- (define (bitwise-bit-field ei1 ei2 ei3)
- (bitwise-arithmetic-shift-right
- (bitwise-and ei1 (bitwise-not (bitwise-arithmetic-shift-left -1 ei3)))
- ei2))
+ ;; The specification states that ei3 should be either 0 or 1.
+ ;; However, other values have been tolerated by both Guile 2.0.x and
+ ;; the sample implementation given the R6RS library document, so for
+ ;; backward compatibility we continue to permit it.
+ (copy-bit ei2 ei1 (logbit? 0 ei3)))
(define (bitwise-copy-bit-field ei1 ei2 ei3 ei4)
- (bitwise-if (bitwise-and (bitwise-arithmetic-shift-left -1 ei2)
- (bitwise-not
- (bitwise-arithmetic-shift-left -1 ei3)))
- (bitwise-arithmetic-shift-left ei4 ei2)
- ei1))
+ (copy-bit-field ei1 ei4 ei2 ei3))
- (define bitwise-arithmetic-shift-left bitwise-arithmetic-shift)
- (define (bitwise-arithmetic-shift-right ei1 ei2)
- (bitwise-arithmetic-shift ei1 (- ei2)))
-
(define (bitwise-rotate-bit-field ei1 ei2 ei3 ei4)
- (let ((width (- ei3 ei2)))
- (if (positive? width)
- (let ((field (bitwise-bit-field ei1 ei2 ei3))
- (count (modulo ei4 width)))
- (bitwise-copy-bit-field
- ei1 ei2 ei3
- (bitwise-ior (bitwise-arithmetic-shift-left field count)
- (bitwise-arithmetic-shift-right
- field (- width count)))))
- ei1)))
+ (rotate-bit-field ei1 ei4 ei2 ei3))
- (define (bitwise-reverse-bit-field ei1 ei2 ei3)
- (define (reverse-bit-field-recursive n1 n2 len)
- (if (> len 0)
- (reverse-bit-field-recursive
- (bitwise-arithmetic-shift-right n1 1)
- (bitwise-copy-bit (bitwise-arithmetic-shift-left n2 1) 0 n1)
- (- len 1))
- n2))
- (let ((width (- ei3 ei2)))
- (if (positive? width)
- (let ((field (bitwise-bit-field ei1 ei2 ei3)))
- (bitwise-copy-bit-field
- ei1 ei2 ei3 (reverse-bit-field-recursive field 0 width)))
- ei1))))
+ (define bitwise-arithmetic-shift-left bitwise-arithmetic-shift)
+ (define (bitwise-arithmetic-shift-right ei1 ei2)
+ (bitwise-arithmetic-shift ei1 (- ei2))))
diff --git a/test-suite/tests/r6rs-arithmetic-bitwise.test
b/test-suite/tests/r6rs-arithmetic-bitwise.test
index 3b35846..3e23d81 100644
--- a/test-suite/tests/r6rs-arithmetic-bitwise.test
+++ b/test-suite/tests/r6rs-arithmetic-bitwise.test
@@ -62,7 +62,7 @@
(with-test-prefix "bitwise-copy-bit"
(pass-if "bitwise-copy-bit simple"
- (eqv? (bitwise-copy-bit #b010 2 #b111) #b110)))
+ (eqv? (bitwise-copy-bit #b010 2 1) #b110)))
(with-test-prefix "bitwise-bit-field"
(pass-if "bitwise-bit-field simple"
diff --git a/test-suite/tests/r6rs-arithmetic-fixnums.test
b/test-suite/tests/r6rs-arithmetic-fixnums.test
index 60c3b87..2d9b177 100644
--- a/test-suite/tests/r6rs-arithmetic-fixnums.test
+++ b/test-suite/tests/r6rs-arithmetic-fixnums.test
@@ -184,7 +184,7 @@
(pass-if "fxbit-set? is #f on index of unset bit" (not (fxbit-set? 5 1))))
-(with-test-prefix "fxcopy-bit" (pass-if "simple" (fx=? (fxcopy-bit 2 2 7) 6)))
+(with-test-prefix "fxcopy-bit" (pass-if "simple" (fx=? (fxcopy-bit 2 2 1) 6)))
(with-test-prefix "fxbit-field"
(pass-if "simple" (fx=? (fxbit-field 50 1 4) 1)))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-44-g93da406,
Mark H Weaver <=