basis/math/hashcodes/hashcodes.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: combinators kernel layouts math math.bitwise
   5 math.floating-point math.functions ;
   6
   7 IN: math.hashcodes
   8
   9 GENERIC: number-hashcode ( x -- h )
  10
  11 <PRIVATE
  12
  13 : P ( -- x )
  14     cell-bits 64 = 61 31 ? 2^ 1 - ; inline foldable
  15
  16 : M ( -- x )
  17     cell-bits 1 - 2^ ; inline foldable
  18
  19 : hash-fraction ( m n -- h )
  20
  21     [ 2dup [ P mod zero? ] both? ] [
  22         [ P /i ] bi@
  23     ] while
  24
  25     dup P mod zero? [
  26         2drop 1/0.
  27     ] [
  28         over [
  29             [ abs P mod ] [ P 2 - P ^mod P mod ] bi* *
  30         ] dip 0 < [ neg ] when
  31         dup -1 = [ drop -2 ] when
  32     ] if ; inline
  33
  34 PRIVATE>
  35
  36 M: integer number-hashcode 1 hash-fraction ;
  37
  38 M: ratio number-hashcode >fraction hash-fraction ;
  39
  40 M: float number-hashcode
  41     {
  42         { [ dup fp-nan? ] [ drop 0 ] }
  43         { [ dup fp-infinity? ] [ 0 > 314159 -314159 ? ] }
  44         [ double>ratio number-hashcode ]
  45     } cond ;
  46
  47 M: complex number-hashcode
  48     >rect [ number-hashcode ] bi@ 1000003 * +
  49     cell-bits on-bits bitand dup -1 = [ drop -2 ] when ;