Add 0 integer>bit-array fix to bit-arrays in its new home under extra

db4
Joe Groff 2008-07-04 20:52:24 -07:00
parent 64278e2112
commit f70634bb01
1 changed files with 8 additions and 6 deletions

View File

@ -73,12 +73,14 @@ M: bit-array byte-length length 7 + -3 shift ;
\ } [ >bit-array ] parse-literal ; parsing \ } [ >bit-array ] parse-literal ; parsing
: integer>bit-array ( int -- bit-array ) : integer>bit-array ( int -- bit-array )
dup zero? [ drop 0 <bit-array> ] [
[ log2 1+ <bit-array> 0 ] keep [ log2 1+ <bit-array> 0 ] keep
[ dup zero? not ] [ [ dup zero? not ] [
[ -8 shift ] [ 255 bitand ] bi [ -8 shift ] [ 255 bitand ] bi
-roll [ [ >r underlying>> r> set-alien-unsigned-1 ] 2keep 1+ ] dip -roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
] [ ] while ] [ ] while
2drop ; 2drop
] if ;
: bit-array>integer ( bit-array -- int ) : bit-array>integer ( bit-array -- int )
0 swap underlying>> [ length ] keep [ 0 swap underlying>> [ length ] keep [