IN: math

BUILTIN: float ;

USING: bootstrap.image.private math ;

M: float '
[
float
[ 8 (align-here) double>bits emit-64 ] emit-object
] cache-eql-object ;

USING: bootstrap.image.private math ;

M: float (eql?) fp-bitwise= ;

USING: io math serialize serialize.private ;

M: float (serialize) 70 write1 double>bits serialize-cell ;

USING: math math.private ;

M: float * float* ; inline

USING: math math.private ;

M: float + float+ ; inline

USING: math math.private ;

M: float - float- ; inline

USING: math math.private ;

M: float / float/f ; inline

USING: math math.private ;

M: float /f float/f ; inline

USING: math math.private ;

M: float /i float/f >integer ; inline

USING: math math.private ;

M: float < float< ; inline

USING: math math.private ;

M: float <= float<= ; inline

USING: math math.private ;

M: float > float> ; inline

USING: math math.private ;

M: float >= float>= ; inline

USING: combinators kernel math math.parser math.parser.private
;

M: float >base
{
{ [ over fp-nan? ] [ 2drop "0/0." ] }
{ [ over 1/0. = ] [ 2drop "1/0." ] }
{ [ over -1/0. = ] [ 2drop "-1/0." ] }
{ [ over 0.0 fp-bitwise= ] [ 2drop "0.0" ] }
{ [ over -0.0 fp-bitwise= ] [ 2drop "-0.0" ] }
[ float>base ]
} cond ;

USING: math math.private ;

M: float >bignum float>bignum ; inline

USING: math math.private ;

M: float >fixnum float>fixnum ; inline

USING: math ;

M: float >float ; inline

USING: math math.functions.private ;

M: float ^n (^n) ;

USING: math ;

M: float abs double>bits 63 2^ bitnot bitand bits>double ;
inline

USING: math math.functions math.libm ;

M: float atan fatan ; inline

USING: alien.data math ;

M: float binary-zero? double>bits zero? ; inline

USING: kernel math math.functions ;

M: float copysign
[ double>bits ] [ fp-sign ] bi*
[ 63 2^ bitor ] [ 63 2^ bitnot bitand ] if bits>double ;

USING: math math.functions math.libm ;

M: float cos fcos ; inline

USING: math math.functions math.libm ;

M: float cosh fcosh ; inline

USING: math math.functions math.libm ;

M: float e^ fexp ; inline

USING: compiler.tree.propagation.info kernel math ;

M: float eql?
over float? [ [ double>bits ] same? ] [ 2drop f ] if ;

USING: kernel math math.private ;

M: float equal? over float? [ float= ] [ 2drop f ] if ; inline

USING: kernel math ;

M: float fp-infinity?
dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ;
inline

USING: math ;

M: float fp-nan-payload double>bits 52 2^ 1 - bitand ; inline

USING: kernel math math.private ;

M: float fp-nan? dup float= not ;

USING: kernel math ;

M: float fp-qnan?
dup fp-nan?
[ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ;
inline

USING: math ;

M: float fp-sign double>bits 63 bit? ; inline

USING: kernel math ;

M: float fp-snan?
dup fp-nan?
[ fp-nan-payload 51 2^ bitand zero? ] [ drop f ] if ;
inline

USING: kernel math ;

M: float fp-special?
double>bits -52 shift 2047 [ bitand ] keep = ; inline

USING: kernel math math.functions ;

M: float frexp
dup fp-special? [ dup zero? ] unless*
[ 0 ] [
double>bits [
9227875636482146303 bitand 0.5 double>bits bitor
bits>double
] [ -52 shift 2047 bitand 1022 - ] bi
] if ; inline

USING: kernel math ;

M: float hashcode* nip float>bits ; inline

USING: math math.parser xml-rpc xml.data xml.syntax.private ;

M: float item>xml
number>string 1 nenum T{ xml-chunk
{ seq
V{
""
T{ tag { name ~name~ } { children ~vector~ } }
""
}
}
} interpolate-xml ;

USING: combinators kernel math math.functions ;

M: float ldexp
over fp-special? [ over zero? ] unless*
[ drop ] [
[ double>bits dup -52 shift 2047 bitand 1023 - ] dip +
{
{ [ dup -1074 < ] [ drop 0 copysign ] }
{ [ dup 1023 > ] [ drop 0 < -1/0. 1/0. ? ] }
[
dup -1022 < [ 52 + -52 2^ ] [ 1 ] if
[ -9218868437227405313 bitand ]
[ 1023 + 52 shift bitor bits>double ] [ * ]
tri*
]
} cond
] if ;

USING: kernel math math.functions math.libm ;

M: float log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; inline

USING: kernel math math.functions math.libm ;

M: float log1+
dup -1.0 >= [ flog1+ ] [ 1.0 + 0.0 rect> log ] if ; inline

USING: generic kernel math math.floats.private math.order ;

M: float max
over float?
[ float-max ] [ M\ float max (call-next-method) ] if ;
inline

USING: generic kernel math math.floats.private math.order ;

M: float min
over float?
[ float-min ] [ M\ float min (call-next-method) ] if ;
inline

USING: math math.libm ;

M: float mod fmod ; inline

USING: math math.vectors.simd.intrinsics.private ;

M: float native/ /f ; inline

USING: math ;

M: float neg? fp-sign ; inline

USING: kernel math ;

M: float next-float
double>bits dup -0.0 double>bits >
[ 1 - bits>double ] [
dup -0.0 double>bits =
[ drop 0.0 ] [ 1 + bits>double ] if
] if ; inline

USING: combinators kernel math math.floating-point
math.hashcodes ;

M: float number-hashcode
{
{ [ dup fp-nan? ] [ drop 0 ] }
{ [ dup fp-infinity? ] [ 0 > 314159 -314159 ? ] }
[ double>ratio number-hashcode ]
} cond ;

USING: math math.private ;

M: float number= float= ; inline

USING: combinators kernel math math.parser namespaces
prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections ;

M: float pprint*
dup fp-nan?
[ \ NAN: [ fp-nan-payload >hex text ] pprint-prefix ] [
number-base get {
{ 16 [ [ >hex ] "0x" pprint-prefixed-number ] }
[ drop number>string text ]
} case
] if ;

USING: kernel math ;

M: float prev-float
double>bits dup -0.0 double>bits >=
[ 1 + bits>double ] [
dup 0.0 double>bits =
[ drop -0.0 ] [ 1 - bits>double ] if
] if ; inline

USING: kernel math random ;

M: float random
[ f ] [ 0.0 swap uniform-random-float ] if-zero ;

USING: kernel.private math math.order.private ;

M: float real<=> { float float } declare (real<=>) ; inline

USING: kernel math math.functions ;

M: float round dup sgn 2 /f + truncate ;

USING: kernel math math.extras ;

M: float round-to-even
dup 0 > [
dup 4503599627370496.0 <=
[ 4503599627370496.0 + 4503599627370496.0 - ] when
] [
dup -4503599627370496.0 >=
[ 4503599627370496.0 - 4503599627370496.0 + ] when
] if ;

USING: math math.functions math.libm ;

M: float sin fsin ; inline

USING: math math.functions math.libm ;

M: float sinh fsinh ; inline

USING: math math.functions math.libm ;

M: float tan ftan ; inline

USING: math math.functions math.libm ;

M: float tanh ftanh ; inline

USING: math math.private ;

M: float u< float-u< ; inline

USING: math math.private ;

M: float u<= float-u<= ; inline

USING: math math.private ;

M: float u> float-u> ; inline

USING: math math.private ;

M: float u>= float-u>= ; inline

USING: math math.floats.private ;

M: float unordered? float-unordered? ; inline

USING: cuda.ptx io math math.parser sequences ;

M: float write-ptx-operand
"0d" write double>bits >hex 16 48 pad-head write ;