conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added bitwise-copy-bit.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-20 22:21:54 -05:00
parent cc7066441c
commit eedbe65e44
4 changed files with 50 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
scheme/ikarus.numerics.ss
View File

@ -398,6 +398,7 @@
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift bitwise-arithmetic-shift
bitwise-length bitwise-length
bitwise-copy-bit
positive? negative? expt gcd lcm numerator denominator positive? negative? expt gcd lcm numerator denominator
exact-integer-sqrt exact-integer-sqrt
quotient+remainder number->string string->number min max quotient+remainder number->string string->number min max
@ -420,6 +421,7 @@
bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left bitwise-arithmetic-shift-right bitwise-arithmetic-shift-left
bitwise-arithmetic-shift bitwise-arithmetic-shift
bitwise-length bitwise-length
bitwise-copy-bit
positive? negative? bitwise-and bitwise-not positive? negative? bitwise-and bitwise-not
string->number expt gcd lcm numerator denominator string->number expt gcd lcm numerator denominator
exact->inexact inexact floor ceiling round log exact->inexact inexact floor ceiling round log
@ -2422,7 +2424,51 @@
(cond (cond
[(fixnum? n) (fxlength n)] [(fixnum? n) (fxlength n)]
[(bignum? n) (foreign-call "ikrt_bignum_length" n)] [(bignum? n) (foreign-call "ikrt_bignum_length" n)]
[else (error 'bitwise-length "not an exact integer" n)])) [else (die 'bitwise-length "not an exact integer" n)]))
(define (bitwise-copy-bit n idx bit)
(define who 'bitwise-copy-bit)
(define (do-copy-bit n idx bit)
(case bit
[(0)
(cond
[(bitwise-bit-set? n idx)
(bitwise-and n (bitwise-not (sll 1 idx)))]
[else n])]
[(1)
(cond
[(bitwise-bit-set? n idx) n]
[(>= n 0) (+ n (sll 1 idx))]
[else
(bitwise-not
(bitwise-and
(bitwise-not n)
(bitwise-not (sll 1 idx))))])]
[else (die who "bit must be either 0 or 1" bit)]))
(cond
[(fixnum? idx)
(cond
[(fx< idx 0)
(die who "negative bit index" idx)]
[(or (fixnum? n) (bignum? n))
(do-copy-bit n idx bit)]
[else (die who "not an exact integer" n)])]
[(bignum? idx)
(unless (or (fixnum? n) (bignum? n))
(die who "not an exact integer" n))
(if ($bignum-positive? idx)
(case bit
[(0)
(if (>= n 0)
n
(die who "unrepresentable result"))]
[(1)
(if (< n 0)
n
(die who "unrepresentable result"))]
[else (die who "bit must be either 0 or 1" bit)])
(die who "negative bit index" idx))]
[else (die who "index is not an exact integer" idx)]))
) )

2
scheme/last-revision
View File

@ -1 +1 @@
1354 1355

2
scheme/makefile.ss
View File

@ -764,7 +764,7 @@
[bitwise-bit-count i r bw] [bitwise-bit-count i r bw]
[bitwise-bit-field r bw] [bitwise-bit-field r bw]
[bitwise-bit-set? i r bw] [bitwise-bit-set? i r bw]
[bitwise-copy-bit r bw] [bitwise-copy-bit i r bw]
[bitwise-copy-bit-field r bw] [bitwise-copy-bit-field r bw]
[bitwise-first-bit-set i r bw] [bitwise-first-bit-set i r bw]
[bitwise-if r bw] [bitwise-if r bw]

2
scheme/todo-r6rs.ss
View File

@ -261,7 +261,7 @@
[bitwise-bit-count C bw] [bitwise-bit-count C bw]
[bitwise-bit-field S bw] [bitwise-bit-field S bw]
[bitwise-bit-set? C bw] [bitwise-bit-set? C bw]
[bitwise-copy-bit S bw] [bitwise-copy-bit C bw]
[bitwise-copy-bit-field S bw] [bitwise-copy-bit-field S bw]
[bitwise-first-bit-set C bw] [bitwise-first-bit-set C bw]
[bitwise-if S bw] [bitwise-if S bw]