diff --git a/scheme/ikarus.not-yet-implemented.ss b/scheme/ikarus.not-yet-implemented.ss index 9036c75..2bbc0a8 100644 --- a/scheme/ikarus.not-yet-implemented.ss +++ b/scheme/ikarus.not-yet-implemented.ss @@ -1,8 +1,8 @@ (library (ikarus not-yet-implemented) (export - bitwise-copy-bit-field bitwise-reverse-bit-field - bitwise-rotate-bit-field bitwise-if fxreverse-bit-field + bitwise-reverse-bit-field + bitwise-rotate-bit-field fxreverse-bit-field make-custom-binary-input/output-port make-custom-textual-input/output-port open-file-input/output-port output-port-buffer-mode @@ -15,8 +15,8 @@ string-upcase) (import (except (ikarus) - bitwise-copy-bit-field bitwise-reverse-bit-field - bitwise-rotate-bit-field bitwise-if fxreverse-bit-field + bitwise-reverse-bit-field + bitwise-rotate-bit-field fxreverse-bit-field make-custom-binary-input/output-port make-custom-textual-input/output-port open-file-input/output-port output-port-buffer-mode @@ -53,8 +53,7 @@ (not-yet ;;; should be implemented string-downcase string-titlecase string-upcase - bitwise-if - bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field + bitwise-rotate-bit-field bitwise-reverse-bit-field fxreverse-bit-field ;;; not top priority at the moment make-eqv-hashtable make-hashtable equal-hash diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index 5b30091..66086dd 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -370,10 +370,10 @@ (library (ikarus generic-arithmetic) (export + - * / zero? = < <= > >= add1 sub1 quotient remainder modulo even? odd? bitwise-and bitwise-not bitwise-ior - bitwise-xor + bitwise-xor bitwise-if bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift - bitwise-length + bitwise-length bitwise-copy-bit-field bitwise-copy-bit bitwise-bit-field positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt @@ -398,10 +398,10 @@ remainder modulo even? odd? quotient+remainder number->string bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift - bitwise-length + bitwise-length bitwise-copy-bit-field bitwise-copy-bit bitwise-bit-field positive? negative? bitwise-and bitwise-not bitwise-ior - bitwise-xor + bitwise-xor bitwise-if expt gcd lcm numerator denominator exact->inexact inexact floor ceiling round log exact-integer-sqrt min max abs real->flonum @@ -1002,6 +1002,29 @@ [(bignum? x) (foreign-call "ikrt_bnlognot" x)] [else (die 'bitwise-not "invalid argument" x)])) + (define (bitwise-if x y z) + (define who 'bitwise-if) + (define (err x) (die who "not an exact integer" x)) + (unless (or (fixnum? x) (bignum? x)) (err x)) + (unless (or (fixnum? y) (bignum? y)) (err y)) + (unless (or (fixnum? z) (bignum? z)) (err z)) + (bitwise-ior + (bitwise-and x y) + (bitwise-and (bitwise-not x) z))) + + (define (bitwise-copy-bit-field x i j n) + (define who 'bitwise-copy-bit-field) + (define (err x) (die who "not an exact integer" x)) + (define (err2 x) (die who "index must be nonnegative" x)) + (define (err3 x y) (die who "indices must be in nondescending order" x y)) + (unless (or (fixnum? x) (bignum? x)) (err x)) + (unless (or (fixnum? i) (bignum? i)) (err i)) + (unless (or (fixnum? j) (bignum? j)) (err j)) + (unless (or (fixnum? n) (bignum? n)) (err n)) + (when (< i 0) (err2 i)) + (when (< j i) (err3 i j)) + (bitwise-if (sll (sub1 (sll 1 (- j i))) i) (sll n i) x)) + (define - (case-lambda [(x y) (binary- x y)] diff --git a/scheme/last-revision b/scheme/last-revision index 0a02468..3603fbf 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1572 +1573