extra/math/bit-count/bit-count.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.functions quotations words sequences
   4 sequences.private combinators fry ;
   5 IN: math.bit-count
   6
   7 <PRIVATE
   8
   9 DEFER: byte-bit-count
  10
  11 <<
  12
  13 \ byte-bit-count
  14 256 [
  15     0 swap [ [ 1+ ] when ] each-bit
  16 ] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
  17
  18 >>
  19
  20 GENERIC: (bit-count) ( x -- n )
  21
  22 M: fixnum (bit-count)
  23     {
  24         [           byte-bit-count ]
  25         [ -8  shift byte-bit-count ]
  26         [ -16 shift byte-bit-count ]
  27         [ -24 shift byte-bit-count ]
  28     } cleave + + + ;
  29
  30 M: bignum (bit-count)
  31     dup 0 = [ drop 0 ] [
  32         [ byte-bit-count ] [ -8 shift (bit-count) ] bi +
  33     ] if ;
  34
  35 PRIVATE>
  36
  37 : bit-count ( x -- n )
  38     dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline