steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix integer>bit-array to work with zero as argument

db4
Joe Groff 2008-06-30 19:11:43 -07:00
parent 6b1cea4a6a
commit 5a01439038
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/bit-arrays/bit-arrays-tests.factor
View File

@ -54,6 +54,7 @@ IN: bit-arrays.tests
[ -10 ?{ } resize-bit-array ] must-fail
[ -1 integer>bit-array ] must-fail
[ ?{ } ] [ 0 integer>bit-array ] unit-test
[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
[ ?{
@ -66,6 +67,7 @@ IN: bit-arrays.tests
] unit-test
[ 14 ] [ ?{ f t t t } bit-array>integer ] unit-test
[ 0 ] [ ?{ } bit-array>integer ] unit-test
[ HEX: ffffffffffffffffffffffffffffffff ] [ ?{
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t

14
core/bit-arrays/bit-arrays.factor
View File

@ -52,12 +52,14 @@ M: bit-array resize
resize-bit-array ;
: integer>bit-array ( int -- bit-array )
[ log2 1+ <bit-array> 0 ] keep
[ dup zero? not ] [
[ -8 shift ] [ 255 bitand ] bi
-roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
] [ ] while
2drop ;
dup zero? [ drop ?{ } ] [
[ log2 1+ <bit-array> 0 ] keep
[ dup zero? not ] [
[ -8 shift ] [ 255 bitand ] bi
-roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
] [ ] while
2drop
] if ;
: bit-array>integer ( bit-array -- int )
dup >r length 7 + n>byte 0 r> [