math.bitwise: hotrod nonintrinsic fixnum-bit-count
parent
d79b462f75
commit
706c9ee3b9
|
@ -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 alien.data specialized-arrays ;
|
||||
byte-arrays alien alien.c-types alien.data specialized-arrays
|
||||
kernel.private layouts ;
|
||||
SPECIALIZED-ARRAY: uchar
|
||||
IN: math.bitwise
|
||||
|
||||
|
@ -86,15 +87,20 @@ DEFER: byte-bit-count
|
|||
GENERIC: (bit-count) ( x -- n )
|
||||
|
||||
: fixnum-bit-count ( x -- n )
|
||||
0 swap [
|
||||
dup 0 >
|
||||
] [
|
||||
[ 8 bits byte-bit-count ] [ -8 shift ] bi
|
||||
[ + ] dip
|
||||
] while drop ;
|
||||
{ fixnum } declare
|
||||
[ byte-bit-count ] keep
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
cell 8 = [
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
[ -8 shift byte-bit-count + ] keep
|
||||
-8 shift byte-bit-count + >fixnum
|
||||
] [ drop ] if ;
|
||||
|
||||
M: fixnum (bit-count)
|
||||
fixnum-bit-count ; inline
|
||||
fixnum-bit-count { fixnum } declare ; inline
|
||||
|
||||
M: bignum (bit-count)
|
||||
dup 0 = [ drop 0 ] [
|
||||
|
|
Loading…
Reference in New Issue