use radix literals

[factor.git] / basis / math / bitwise / bitwise.factor

diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 6b301fa97bf071ca3eae841c015a5d12355bbead..785f77c711a0b0ca5553389de998d8233376de50 100644 (file)
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators combinators.smart fry kernel
 macros math math.bits sequences sequences.private words
-byte-arrays alien alien.c-types specialized-arrays ;
+byte-arrays alien alien.c-types alien.data specialized-arrays
+kernel.private layouts ;
 SPECIALIZED-ARRAY: uchar
 IN: math.bitwise
 
@@ -15,35 +16,35 @@ IN: math.bitwise
 : mask ( x n -- ? ) bitand ; inline
 : mask? ( x n -- ? ) mask 0 > ; inline
 : wrap ( m n -- m' ) 1 - bitand ; inline
-: bits ( m n -- m' ) 2^ wrap ; inline
+: on-bits ( m -- n ) 2^ 1 - ; inline
+: bits ( m n -- m' ) on-bits mask ; inline
 : mask-bit ( m n -- m' ) 2^ mask ; inline
-: on-bits ( n -- m ) 2^ 1 - ; inline
 : toggle-bit ( m n -- m' ) 2^ bitxor ; inline
-
-: shift-mod ( n s w -- n )
-    [ shift ] dip 2^ wrap ; inline
+: >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
+: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
+: shift-mod ( m s w -- n ) [ shift ] dip 2^ wrap ; inline
 
 : bitroll ( x s w -- y )
     [ wrap ] keep
     [ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
 
-: bitroll-32 ( n s -- n' ) 32 bitroll ; inline
+: bitroll-32 ( m s -- n ) 32 bitroll ; inline
 
-: bitroll-64 ( n s -- n' ) 64 bitroll ; inline
+: bitroll-64 ( m s -- n ) 64 bitroll ; inline
 
 ! 32-bit arithmetic
-: w+ ( int int -- int ) + 32 bits ; inline
-: w- ( int int -- int ) - 32 bits ; inline
-: w* ( int int -- int ) * 32 bits ; inline
+: w+ ( x y -- z ) + 32 bits ; inline
+: w- ( x y -- z ) - 32 bits ; inline
+: w* ( x y -- z ) * 32 bits ; inline
 
 ! 64-bit arithmetic
-: W+ ( int int -- int ) + 64 bits ; inline
-: W- ( int int -- int ) - 64 bits ; inline
-: W* ( int int -- int ) * 64 bits ; inline
-
-! flags
-MACRO: flags ( values -- )
-    [ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
+: W+ ( x y -- z ) + 64 bits ; inline
+: W- ( x y -- z ) - 64 bits ; inline
+: W* ( x y -- z ) * 64 bits ; inline
 
 : symbols>flags ( symbols assoc -- flag-bits )
     [ at ] curry map
@@ -76,8 +77,8 @@ DEFER: byte-bit-count
 \ byte-bit-count
 256 iota [
     8 <bits> 0 [ [ 1 + ] when ] reduce
-] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
-(( byte -- table )) define-declared
+] B{ } map-as '[ 0xff bitand _ nth-unsafe ]
+( byte -- table ) define-declared
 
 \ byte-bit-count make-inline
 
@@ -85,13 +86,27 @@ DEFER: byte-bit-count
 
 GENERIC: (bit-count) ( x -- n )
 
+: fixnum-bit-count ( x -- n )
+    { fixnum } declare
+    {
+        [ byte-bit-count ]
+        [ -8 shift byte-bit-count + ]
+        [ -16 shift byte-bit-count + ]
+        [ -24 shift byte-bit-count + ]
+        [
+            cell 8 = [
+                {
+                    [ -32 shift byte-bit-count + ]
+                    [ -40 shift byte-bit-count + ]
+                    [ -48 shift byte-bit-count + ]
+                    [ -56 shift byte-bit-count + ]
+                } cleave >fixnum
+            ] [ drop ] if
+        ]
+    } cleave ;
+
 M: fixnum (bit-count)
-    0 swap [
-        dup 0 >
-    ] [
-        [ 8 bits byte-bit-count ] [ -8 shift ] bi
-        [ + ] dip
-    ] while drop ;
+    fixnum-bit-count { fixnum } declare ; inline
 
 M: bignum (bit-count)
     dup 0 = [ drop 0 ] [
@@ -114,19 +129,7 @@ M: byte-array bit-count
     byte-array-bit-count ;
 
 M: object bit-count
-    [ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
-    byte-array-bit-count ;
-
-: >signed ( x n -- y )
-    2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
-
-: >odd ( n -- int ) 0 set-bit ; foldable
-
-: >even ( n -- int ) 0 clear-bit ; foldable
-
-: next-even ( m -- n ) >even 2 + ; foldable
-
-: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
+    binary-object uchar <c-direct-array> byte-array-bit-count ;
 
 : even-parity? ( obj -- ? ) bit-count even? ;