50 lines
1.1 KiB
Factor
50 lines
1.1 KiB
Factor
! Copyright (C) 2013 John Benediktsson
|
|
! See http://factorcode.org/license.txt for BSD license
|
|
|
|
USING: combinators kernel layouts math math.bitwise
|
|
math.floating-point math.functions ;
|
|
|
|
IN: math.hashcodes
|
|
|
|
GENERIC: number-hashcode ( x -- h )
|
|
|
|
<PRIVATE
|
|
|
|
: P ( -- x )
|
|
cell-bits 64 = 61 31 ? 2^ 1 - ; inline foldable
|
|
|
|
: M ( -- x )
|
|
cell-bits 1 - 2^ ; inline foldable
|
|
|
|
: hash-fraction ( m n -- h )
|
|
|
|
[ 2dup [ P mod zero? ] bi@ and ] [
|
|
[ P /i ] bi@
|
|
] while
|
|
|
|
dup P mod zero? [
|
|
2drop 1/0.
|
|
] [
|
|
over [
|
|
[ abs P mod ] [ P 2 - P ^mod P mod ] bi* *
|
|
] dip 0 < [ neg ] when
|
|
dup -1 = [ drop -2 ] when
|
|
] if ; inline
|
|
|
|
PRIVATE>
|
|
|
|
M: integer number-hashcode 1 hash-fraction ;
|
|
|
|
M: ratio number-hashcode >fraction hash-fraction ;
|
|
|
|
M: float number-hashcode ( x -- h )
|
|
{
|
|
{ [ dup fp-nan? ] [ drop 0 ] }
|
|
{ [ dup fp-infinity? ] [ 0 > 314159 -314159 ? ] }
|
|
[ double>ratio number-hashcode ]
|
|
} cond ;
|
|
|
|
M: complex number-hashcode ( x -- h )
|
|
>rect [ number-hashcode ] bi@ 1000003 * +
|
|
cell-bits on-bits bitand dup -1 = [ drop -2 ] when ;
|