[ [ length bits>cells ] keep ] dip swap underlying>>
'[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
+: clean-up ( bit-array -- )
+ ! Zero bits after the end.
+ dup underlying>> empty? [ drop ] [
+ [
+ [ underlying>> length 8 * ] [ length ] bi -
+ 8 swap - -1 swap shift bitnot
+ ]
+ [ underlying>> last bitand ]
+ [ underlying>> set-last ]
+ tri
+ ] if ; inline
+
PRIVATE>
: <bit-array> ( n -- bit-array )
M: bit-array new-sequence drop <bit-array> ;
M: bit-array equal?
- over bit-array? [ sequence= ] [ 2drop f ] if ;
+ over bit-array? [ [ underlying>> ] bi@ sequence= ] [ 2drop f ] if ;
M: bit-array resize
[ drop ] [
[ bits>bytes ] [ underlying>> ] bi*
resize-byte-array
] 2bi
- bit-array boa ;
+ bit-array boa
+ dup clean-up ;
M: bit-array byte-length length 7 + -3 shift ;
dup 0 = [
<bit-array>
] [
- [ log2 1+ <bit-array> 0 ] keep
+ [ log2 1 + <bit-array> 0 ] keep
[ dup 0 = ] [
[ pick underlying>> pick set-alien-unsigned-1 ] keep
- [ 1+ ] [ -8 shift ] bi*
+ [ 1 + ] [ -8 shift ] bi*
] until 2drop
] if ;