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 <[email protected]> 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
