Add more unit-tests and docs for math.bitwise. Fix a bug with >signed so that it truncates a number to however many bits you tell it the number is before doing the calculation.

basis/math/bitwise/bitwise-docs.factor

@@ -154,6 +154,45 @@ HELP: symbols>flags
     }
 } ;
 
+HELP: >even
+{ $values
+    { "m" integer }
+    { "n" integer }
+}
+{ $examples
+    { $example "USING: math.bitwise prettyprint ;"
+        "7 >even ."
+        "6"
+    }
+}
+{ $description "Sets the lowest bit in the integer to 0, which either does nothing or outputs 1 less than the input integer." } ;
+
+HELP: >odd
+{ $values
+    { "m" integer }
+    { "n" integer }
+}
+{ $examples
+    { $example "USING: math.bitwise prettyprint ;"
+        "4 >odd ."
+        "5"
+    }
+}
+{ $description "Sets the lowest bit in the integer to 1, which either does nothing or outputs 1 more than the input integer." } ;
+
+HELP: >signed
+{ $values
+    { "x" integer } { "n" integer }
+    { "y" integer }
+}
+{ $examples
+    { $example "USING: math.bitwise prettyprint ;"
+        "HEX: ff 8 >signed ."
+        "-1"
+    }
+}
+{ $description "Interprets a number " { $snippet "x" } " as an " { $snippet "n" } "-bit number and converts it to a negative number " { $snippet "n" } "-bit number if the topmost bit is set." } ;
+
 HELP: mask
 { $values
      { "x" integer } { "n" integer }
@@ -298,7 +337,7 @@ HELP: w*
      { "x" integer } { "y" integer }
      { "z" integer }
 }
-{ $description "Multiplies two integers and wraps the result to 32 bits." }
+{ $description "Multiplies two integers and wraps the result to a 32-bit unsigned integer." }
 { $examples
     { $example "USING: math.bitwise kernel prettyprint ;"
         "HEX: ffffffff HEX: 2 w* ."
@@ -311,7 +350,7 @@ HELP: w+
      { "x" integer } { "y" integer }
      { "z" integer }
 }
-{ $description "Adds two integers and wraps the result to 32 bits." }
+{ $description "Adds two integers and wraps the result to a 32-bit unsigned integer." }
 { $examples
     { $example "USING: math.bitwise kernel prettyprint ;"
         "HEX: ffffffff HEX: 2 w+ ."
@@ -324,7 +363,7 @@ HELP: w-
      { "x" integer } { "y" integer }
      { "z" integer }
 }
-{ $description "Subtracts two integers and wraps the result to 32 bits." }
+{ $description "Subtracts two integers and wraps the result to a 32-bit unsigned integer." }
 { $examples
     { $example "USING: math.bitwise kernel prettyprint ;"
         "HEX: 0 HEX: ff w- ."
@@ -332,6 +371,45 @@ HELP: w-
     }
 } ;
 
+HELP: W*
+{ $values
+     { "x" integer } { "y" integer }
+     { "z" integer }
+}
+{ $description "Multiplies two integers and wraps the result to a 64-bit unsigned integer." }
+{ $examples
+    { $example "USING: math.bitwise kernel prettyprint ;"
+        "HEX: ffffffffffffffff HEX: 2 W* ."
+        "18446744073709551614"
+    }
+} ;
+
+HELP: W+
+{ $values
+     { "x" integer } { "y" integer }
+     { "z" integer }
+}
+{ $description "Adds two integers and wraps the result to 64-bit unsigned integer." }
+{ $examples
+    { $example "USING: math.bitwise kernel prettyprint ;"
+        "HEX: ffffffffffffffff HEX: 2 W+ ."
+        "1"
+    }
+} ;
+
+HELP: W-
+{ $values
+     { "x" integer } { "y" integer }
+     { "z" integer }
+}
+{ $description "Subtracts two integers and wraps the result to a 64-bit unsigned integer." }
+{ $examples
+    { $example "USING: math.bitwise kernel prettyprint ;"
+        "HEX: 0 HEX: ff W- ."
+        "18446744073709551361"
+    }
+} ;
+
 HELP: wrap
 { $values
      { "m" integer } { "n" integer }
@@ -394,6 +472,17 @@ $nl
     w-
     w*
 }
+"64-bit arithmetic:"
+{ $subsections
+    W+
+    W-
+    W*
+}
+"Converting a number to the nearest even/odd:"
+{ $subsections
+    >even
+    >odd
+}
 "Bitfields:"
 { $subsections
     "math-bitfields"

basis/math/bitwise/bitwise-tests.factor

@@ -1,6 +1,6 @@
 USING: accessors math math.bitwise tools.test kernel words
 specialized-arrays alien.c-types math.vectors.simd
-sequences destructors libc literals ;
+sequences destructors libc literals classes.struct ;
 SPECIALIZED-ARRAY: int
 IN: math.bitwise.tests
 
@@ -29,6 +29,13 @@ IN: math.bitwise.tests
 [ 4 ] [ BIN: 1010101 bit-count ] unit-test
 [ 0 ] [ BIN: 0 bit-count ] unit-test
 [ 1 ] [ BIN: 1 bit-count ] unit-test
+[ 2 ] [ B{ 1 1 } bit-count ] unit-test
+[ 64 ] [ HEX: ffffffffffffffff bit-count ] unit-test
+
+STRUCT: bit-count-struct { a uint } ;
+
+[ 2 ] [ S{ bit-count-struct { a 3 } } bit-count ] unit-test
+
 
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: uint-4
@@ -48,3 +55,25 @@ SPECIALIZED-ARRAY: uint-4
 [ f ] [ BIN: 1 even-parity? ] unit-test
 [ f ] [ BIN: 0 odd-parity? ] unit-test
 [ t ] [ BIN: 1 odd-parity? ] unit-test
+
+[ -1 ] [ HEX: ff 4 >signed ] unit-test
+[ -1 ] [ HEX: ff 8 >signed ] unit-test
+[ 255 ] [ HEX: ff 16 >signed ] unit-test
+
+[ 2 ] [ 3 >even ] unit-test
+[ 3 ] [ 3 >odd ] unit-test
+[ 5 ] [ 4 >odd ] unit-test
+
+[ t ] [ HEX: ff 1 mask? ] unit-test
+[ f ] [ HEX: 0 1 mask? ] unit-test
+
+[ 7 ] [ 5 next-odd ] unit-test
+[ 7 ] [ 6 next-odd ] unit-test
+
+[ 6 ] [ 5 next-even ] unit-test
+[ 8 ] [ 6 next-even ] unit-test
+
+[ f ] [ HEX: 1 0 bit-clear? ] unit-test
+[ t ] [ HEX: 0 1 bit-clear? ] unit-test
+
+[ -1 bit-count ] [ invalid-bit-count-target? ] must-fail-with

basis/math/bitwise/bitwise.factor

@@ -19,7 +19,8 @@ IN: math.bitwise
 : mask-bit ( m n -- m' ) 2^ mask ; inline
 : on-bits ( m -- n ) 2^ 1 - ; inline
 : toggle-bit ( m n -- m' ) 2^ bitxor ; inline
-: >signed ( x n -- y ) 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
+: >signed ( x n -- y )
+    [ bits ] keep 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
 : >odd ( m -- n ) 0 set-bit ; foldable
 : >even ( m -- n ) 0 clear-bit ; foldable
 : next-even ( m -- n ) >even 2 + ; foldable