diff --git a/src/Lib/Common/bitwise.sch b/src/Lib/Common/bitwise.sch index 29cc799a..600b4a79 100644 --- a/src/Lib/Common/bitwise.sch +++ b/src/Lib/Common/bitwise.sch @@ -27,6 +27,7 @@ (define (bitwise:low k) (mod k bitwise:modulus)) ; Returns the (possibly negative) high-order bits of an exact integer. +; FIXME: functions that call this repeatedly are slow. (define (bitwise:high k) (div k bitwise:modulus)) @@ -48,8 +49,6 @@ (- (- x) 1)) (else bitwise:complain x 'bitwise-not))) -; FIXME: These procedures shouldn't be this slow. - (define (bitwise-and . args) (define (bitwise-and2 x y) (cond ((and (fixnum? x) (fixnum? y)) @@ -59,9 +58,7 @@ ((= x -1) y) ((= y -1) x) (else - (bitwise:combine - (bitwise-and2 (bitwise:high x) (bitwise:high y)) - (fxand (bitwise:low x) (bitwise:low y)))))) + (integer-logand x y)))) (cond ((null? args) -1) ((null? (cdr args)) (car args)) ((null? (cddr args)) @@ -80,9 +77,7 @@ ((= x -1) -1) ((= y -1) -1) (else - (bitwise:combine - (bitwise-ior2 (bitwise:high x) (bitwise:high y)) - (fxior (bitwise:low x) (bitwise:low y)))))) + (integer-logior x y)))) (cond ((null? args) 0) ((null? (cdr args)) (car args)) ((null? (cddr args)) @@ -100,9 +95,7 @@ ((= y 0) x) ((= x y) 0) (else - (bitwise:combine - (bitwise-xor2 (bitwise:high x) (bitwise:high y)) - (fxxor (bitwise:low x) (bitwise:low y)))))) + (integer-logxor x y)))) (cond ((null? args) 0) ((null? (cdr args)) (car args)) ((null? (cddr args)) diff --git a/test/Benchmarking/R6RS/inputs/primes2.input b/test/Benchmarking/R6RS/inputs/primes2.input new file mode 100644 index 00000000..26f20285 --- /dev/null +++ b/test/Benchmarking/R6RS/inputs/primes2.input @@ -0,0 +1,5 @@ +10 +200 +(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 + 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 + 167 173 179 181 191 193 197 199) diff --git a/test/Benchmarking/R6RS/src/primes2.sch b/test/Benchmarking/R6RS/src/primes2.sch new file mode 100644 index 00000000..b53bff72 --- /dev/null +++ b/test/Benchmarking/R6RS/src/primes2.sch @@ -0,0 +1,51 @@ +;;; Implementation of the Sieve of Eratosthenes, using a bitset. +;;; The bitset is immutable and thus copied on each modification, +;;; which ruins the efficiency of the algorithm but makes it a +;;; good benchmark for bitwise operations. + +(import (rnrs base) + (rnrs arithmetic bitwise) + (rnrs io simple)) + +;;; A bitset is a non-negative exact integer. + +;; Returns a list of the indexes at which the bitset has a one. +(define (bitset->list bs) + (define (loop bs l) + (if (zero? bs) + l + (let ((k (bitwise-first-bit-set bs))) + (loop (bitwise-copy-bit bs k 0) + (cons k l))))) + (reverse (loop bs '()))) + +;; Returns a list of the prime numbers within the given bound. +(define (primes<= n) + (define (filter-loop k m comps) + (if (> m n) + comps + (filter-loop k (+ k m) (bitwise-copy-bit comps m 1)))) + (define (base-loop i comps) + (cond ((> i n) + comps) + ((bitwise-bit-set? comps i) + (base-loop (+ i 1) comps)) + (else + (base-loop (+ i 1) (filter-loop i (+ i i) comps))))) + (bitset->list + (bitwise-not + (bitwise-ior (base-loop 2 3) + (bitwise-arithmetic-shift-left -1 (+ n 1)))))) + +(define (main) + (let* ((count (read)) + (input1 (read)) + (output (read)) + (s2 (number->string count)) + (s1 (number->string input1)) + (name "primes")) + (run-r6rs-benchmark + (string-append name ":" s1 ":" s2) + count + (lambda () (primes<= (hide count input1))) + (lambda (result) (equal? result output)))))