Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / bit-arrays / bit-arrays.factor

diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index 17c391636fcd76bd89e815615f950ce6a1122a35..7aea3c458ae297b67103ac316f14ddfb371571d0 100644 (file)
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -27,6 +27,18 @@ TUPLE: bit-array
     [ [ 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 )
@@ -61,14 +73,15 @@ M: bit-array like drop dup bit-array? [ >bit-array ] unless ;
 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 ;
 
@@ -78,10 +91,10 @@ SYNTAX: ?{ \ } [ >bit-array ] parse-literal ;
     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 ;