fix a bug in bit-count that assumed 32bit fixnums, make bit-count work on byte-arrays, SIMD types, specialized-arrays, and aliens
parent
f800285327
commit
b56880bfd7
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs help.markup help.syntax math sequences ;
|
||||
USING: assocs help.markup help.syntax math sequences kernel ;
|
||||
IN: math.bitwise
|
||||
|
||||
HELP: bitfield
|
||||
|
@ -67,17 +67,21 @@ HELP: bit-clear?
|
|||
|
||||
HELP: bit-count
|
||||
{ $values
|
||||
{ "x" integer }
|
||||
{ "obj" object }
|
||||
{ "n" integer }
|
||||
}
|
||||
{ $description "Returns the number of set bits as an integer." }
|
||||
{ $description "Returns the number of set bits as an object. This word only works on non-negative integers or objects that can be represented as a byte-array." }
|
||||
{ $examples
|
||||
{ $example "USING: math.bitwise prettyprint ;"
|
||||
"HEX: f0 bit-count ."
|
||||
"4"
|
||||
}
|
||||
{ $example "USING: math.bitwise prettyprint ;"
|
||||
"-7 bit-count ."
|
||||
"-1 32 bits bit-count ."
|
||||
"32"
|
||||
}
|
||||
{ $example "USING: math.bitwise prettyprint ;"
|
||||
"B{ 1 0 1 } bit-count ."
|
||||
"2"
|
||||
}
|
||||
} ;
|
||||
|
@ -206,6 +210,20 @@ HELP: mask?
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: even-parity?
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "?" boolean }
|
||||
}
|
||||
{ $description "Returns true if the number of set bits in an object is even." } ;
|
||||
|
||||
HELP: odd-parity?
|
||||
{ $values
|
||||
{ "obj" object }
|
||||
{ "?" boolean }
|
||||
}
|
||||
{ $description "Returns true if the number of set bits in an object is odd." } ;
|
||||
|
||||
HELP: on-bits
|
||||
{ $values
|
||||
{ "n" integer }
|
||||
|
@ -368,6 +386,8 @@ $nl
|
|||
{ $subsections on-bits }
|
||||
"Counting the number of set bits:"
|
||||
{ $subsections bit-count }
|
||||
"Testing the parity of an object:"
|
||||
{ $subsections even-parity? odd-parity? }
|
||||
"More efficient modding by powers of two:"
|
||||
{ $subsections wrap }
|
||||
"Bit-rolling:"
|
||||
|
|
|
@ -1,4 +1,7 @@
|
|||
USING: accessors math math.bitwise tools.test kernel words ;
|
||||
USING: accessors math math.bitwise tools.test kernel words
|
||||
specialized-arrays alien.c-types math.vectors.simd
|
||||
sequences destructors libc ;
|
||||
SPECIALIZED-ARRAY: int
|
||||
IN: math.bitwise.tests
|
||||
|
||||
[ 0 ] [ 1 0 0 bitroll ] unit-test
|
||||
|
@ -37,3 +40,23 @@ CONSTANT: b 2
|
|||
[ 4 ] [ BIN: 1010101 bit-count ] unit-test
|
||||
[ 0 ] [ BIN: 0 bit-count ] unit-test
|
||||
[ 1 ] [ BIN: 1 bit-count ] unit-test
|
||||
|
||||
SIMD: uint
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: uint-4
|
||||
|
||||
[ 1 ] [ uint-4{ 1 0 0 0 } bit-count ] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
[
|
||||
2 malloc-int-array &free 1 0 pick set-nth bit-count
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [ B{ 1 0 0 } bit-count ] unit-test
|
||||
[ 3 ] [ B{ 1 1 1 } bit-count ] unit-test
|
||||
|
||||
[ t ] [ BIN: 0 even-parity? ] unit-test
|
||||
[ f ] [ BIN: 1 even-parity? ] unit-test
|
||||
[ f ] [ BIN: 0 odd-parity? ] unit-test
|
||||
[ t ] [ BIN: 1 odd-parity? ] unit-test
|
||||
|
|
|
@ -1,7 +1,9 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman.
|
||||
! 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 ;
|
||||
macros math math.bits sequences sequences.private words
|
||||
byte-arrays alien alien.c-types specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: uchar
|
||||
IN: math.bitwise
|
||||
|
||||
! utilities
|
||||
|
@ -84,24 +86,36 @@ DEFER: byte-bit-count
|
|||
GENERIC: (bit-count) ( x -- n )
|
||||
|
||||
M: fixnum (bit-count)
|
||||
[
|
||||
{
|
||||
[ byte-bit-count ]
|
||||
[ -8 shift byte-bit-count ]
|
||||
[ -16 shift byte-bit-count ]
|
||||
[ -24 shift byte-bit-count ]
|
||||
} cleave
|
||||
] sum-outputs ;
|
||||
0 swap [
|
||||
dup 0 >
|
||||
] [
|
||||
[ 8 bits byte-bit-count ] [ -8 shift ] bi
|
||||
[ + ] dip
|
||||
] while drop ;
|
||||
|
||||
M: bignum (bit-count)
|
||||
dup 0 = [ drop 0 ] [
|
||||
[ byte-bit-count ] [ -8 shift (bit-count) ] bi +
|
||||
] if ;
|
||||
|
||||
: byte-array-bit-count ( byte-array -- n )
|
||||
0 [ byte-bit-count + ] reduce ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: bit-count ( x -- n )
|
||||
dup 0 < [ bitnot ] when (bit-count) ; inline
|
||||
ERROR: invalid-bit-count-target object ;
|
||||
|
||||
GENERIC: bit-count ( obj -- n )
|
||||
|
||||
M: integer bit-count
|
||||
dup 0 < [ invalid-bit-count-target ] when (bit-count) ; inline
|
||||
|
||||
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 ;
|
||||
|
@ -113,3 +127,7 @@ PRIVATE>
|
|||
: next-even ( m -- n ) >even 2 + ; foldable
|
||||
|
||||
: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
|
||||
|
||||
: even-parity? ( obj -- ? ) bit-count even? ;
|
||||
|
||||
: odd-parity? ( obj -- ? ) bit-count odd? ;
|
||||
|
|
Loading…
Reference in New Issue