steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix a bug in bit-count that assumed 32bit fixnums, make bit-count work on byte-arrays, SIMD types, specialized-arrays, and aliens

db4
Doug Coleman 2009-10-05 18:55:26 -05:00
parent f800285327
commit b56880bfd7
3 changed files with 77 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/math/bitwise/bitwise-docs.factor
View File

@ -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:"

25
basis/math/bitwise/bitwise-tests.factor
View File

@ -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

40
basis/math/bitwise/bitwise.factor
View File

@ -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? ;