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

* Added fxbit-set?

This commit is contained in:
Abdulaziz Ghuloum 2007-11-15 06:40:50 -05:00
parent 42866c21c3
commit edb0abd366
3 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
scheme/ikarus.numerics.ss
View File

@ -2888,7 +2888,8 @@
(library (ikarus bitwise misc) (library (ikarus bitwise misc)
(export fxfirst-bit-set bitwise-first-bit-set (export fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count fxbit-count bitwise-bit-count
fxlength) fxlength
fxbit-set?)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $bignums) (ikarus system $bignums)
@ -2896,7 +2897,8 @@
(except (ikarus) (except (ikarus)
fxfirst-bit-set bitwise-first-bit-set fxfirst-bit-set bitwise-first-bit-set
fxbit-count bitwise-bit-count fxbit-count bitwise-bit-count
fxlength)) fxlength
fxbit-set?))
(module (bitwise-first-bit-set fxfirst-bit-set) (module (bitwise-first-bit-set fxfirst-bit-set)
(define (byte-first-bit-set x i) (define (byte-first-bit-set x i)
@ -2988,7 +2990,6 @@
[(bignum? n) (bnbitcount n)] [(bignum? n) (bnbitcount n)]
[else (error 'bitwise-bit-count "not an exact integer" n)]))) [else (error 'bitwise-bit-count "not an exact integer" n)])))
(define (fxlength x) (define (fxlength x)
(if (fixnum? x) (if (fixnum? x)
(let ([fl ($fixnum->flonum (let ([fl ($fixnum->flonum
@ -3001,6 +3002,16 @@
[else ($fx- sbe 1022)]))) [else ($fx- sbe 1022)])))
(error 'fxlength "not a fixnum" x))) (error 'fxlength "not a fixnum" x)))
(define (fxbit-set? x i)
(define who 'fxbit-set?)
(if (fixnum? x)
(if (fixnum? i)
(if (and ($fx<= 0 i) ($fx< i (fixnum-width)))
(not ($fxzero? ($fxlogand ($fxsra x i) 1)))
(error who "index out of range" i))
(error who "index is not a fixnum" i))
(error who "not a fixnum" x)))
) )

2
scheme/makefile.ss
View File

@ -788,7 +788,7 @@
[fxarithmetic-shift-right i r fx] [fxarithmetic-shift-right i r fx]
[fxbit-count i r fx] [fxbit-count i r fx]
[fxbit-field r fx] [fxbit-field r fx]
[fxbit-set? r fx] [fxbit-set? i r fx]
[fxcopy-bit r fx] [fxcopy-bit r fx]
[fxcopy-bit-field r fx] [fxcopy-bit-field r fx]
[fxdiv i r fx] [fxdiv i r fx]

4
scheme/todo-r6rs.ss
View File

@ -290,7 +290,7 @@
[fxarithmetic-shift-right C fx] [fxarithmetic-shift-right C fx]
[fxbit-count C fx] [fxbit-count C fx]
[fxbit-field S fx] [fxbit-field S fx]
[fxbit-set? S fx] [fxbit-set? C fx]
[fxcopy-bit S fx] [fxcopy-bit S fx]
[fxcopy-bit-field S fx] [fxcopy-bit-field S fx]
[fxdiv C fx] [fxdiv C fx]
@ -298,7 +298,7 @@
[fxdiv0 C fx] [fxdiv0 C fx]
[fxdiv0-and-mod0 C fx] [fxdiv0-and-mod0 C fx]
[fxeven? C fx] [fxeven? C fx]
[fxfirst-bit-set S fx] [fxfirst-bit-set C fx]
[fxif C fx] [fxif C fx]
[fxior C fx] [fxior C fx]
[fxlength C fx] [fxlength C fx]