float - Factor Documentation (original) (raw)
Class description
The class of double-precision floating point numbers.
USING: bootstrap.image.private math ;
USING: io math serialize serialize.private ;
M: float (serialize) 70 write1 double>bits serialize-cell ;
M: float /i float/f >integer ; inline
USING: alien.c-types alien.data core-foundation.numbers kernel
math ;
M: float
[ f kCFNumberDoubleType ] dip double CFNumberCreate ;
USING: combinators kernel math math.parser math.parser.private ;
M: float >base
{
{ [ over fp-nan? ] [ drop fp-sign "-0/0." "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 ;
M: float >bignum float>bignum ; inline
M: float >fixnum float>fixnum ; inline
USING: math python python.errors python.ffi ;
M: float >py PyFloat_FromDouble check-new-ref ;
USING: math math.functions.private math.libm ;
M: float ^n [ >float fpow ] unless-zero ;
M: float abs double>bits 63 2^ bitnot bitand bits>double ;
inline
USING: math math.functions math.libm ;
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 ;
USING: math math.functions math.libm ;
USING: math math.functions math.libm ;
USING: kernel math math.functions ;
M: float e^-1
dup abs 0.7 < [
dup e^ dup 1.0 =
[ drop ] [ [ 1.0 - * ] [ log / ] bi ] if
] [ e^ 1.0 - ] if ; 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
M: float fp-infinity?
dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ;
inline
M: float fp-nan-payload double>bits 52 2^ 1 - bitand ; inline
USING: kernel math math.private ;
M: float fp-nan? dup float= not ;
M: float fp-qnan?
dup fp-nan? [ fp-nan-payload 51 bit? ] [ drop f ] if ;
inline
M: float fp-sign double>bits 63 bit? ; inline
M: float fp-snan?
dup fp-nan? [ fp-nan-payload 51 bit? not ] [ drop f ] if ;
inline
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
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: json json.private math ;
M: float json-coerce float>json ;
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: math math.functions math.libm ;
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.vectors.simd.intrinsics.private ;
M: float neg? fp-sign ; inline
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 ;
M: float number= float= ; inline
USING: combinators kernel math math.parser math.text.english
math.text.english.private sequences splitting ;
M: float number>text
{
{ 1/0. [ "infinity" ] }
{ -1/0. [ "negative infinity" ] }
[
dup fp-nan?
[ drop "not a number" ] [
number>string "-" ?head swap "e-" split1 [
[ 46 swap remove ] dip string>number 1 -
48 prepend "0" swap
] [
"e+" split1 [
~quotation~ dip string>number swap -
48 append "0"
] [ "." split1 ] if*
] if* [ string>number number>text ] dip
[ 48 - small-numbers ] { } map-as
join-words " point " glue swap
[ "negative " prepend ] when
] if
]
} case ;
USING: combinators generic kernel math math.parser
prettyprint.backend prettyprint.custom prettyprint.sections ;
M: float pprint*
{
{ [ dup 0/0. fp-bitwise= ] [ drop "0/0." text ] }
{ [ dup -0/0. fp-bitwise= ] [ drop "-0/0." text ] }
{
[ dup fp-nan? ]
[
\ NAN: [
[ fp-nan-payload ] [ fp-sign ] bi
[ 4503599627370495 bitxor 1 + neg ] when
>hex text
] pprint-prefix
]
}
{ [ dup 1/0. = ] [ drop "1/0." text ] }
{ [ dup -1/0. = ] [ drop "-1/0." text ] }
{ [ dup 0.0 fp-bitwise= ] [ drop "0.0" text ] }
{ [ dup -0.0 fp-bitwise= ] [ drop "-0.0" text ] }
[ M\ float pprint* (call-next-method) ]
} cond ;
USING: bootstrap.image.private math ;
M: float prepare-object
[ float [ 8 (align-here) double>bits emit-64 ] emit-object ]
cache-eql-object ;
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
M: float random*
[ f ] swap [ [ 0.0 ] ] dip [ uniform-random* ] curry compose
if-zero ; inline
USING: kernel.private math math.order.private ;
M: float real<=> { float float } declare (real<=>) ; inline
USING: math math.parser yaml.conversion ;
M: float represent-scalar number>string ;
USING: kernel math math.functions ;
M: float round dup sgn 2 /f + truncate ;
M: float round-to-even [ (round-to-even?) ] (float-round) ;
M: float round-to-odd [ (round-to-odd?) ] (float-round) ;
USING: math math.functions math.libm ;
USING: math math.functions math.libm ;
M: float stream-write-json [ float>json ] [ stream-write ] bi* ;
USING: math math.functions math.libm ;
USING: math math.functions math.libm ;
USING: kernel math math.functions ;
M: float truncate
dup double>bits dup -52 shift 2047 bitand 1023 - dup 52 < [
nipd dup 0 <
[ 2drop 0.0 ] [
4503599627370495 swap neg shift bitnot bitand
bits>double
] if
] [ nip 1024 = [ dup + ] when ] if ; inline
M: float u<= float-u<= ; inline
M: float u>= float-u>= ; inline
USING: math math.floats.private ;
M: float unordered? float-unordered? ; inline
M: float write-cbor 251 write1 double>bits 8 >be write ;
USING: gml.printer io math math.parser ;
M: float write-gml number>string write ;
USING: endian io math msgpack ;
M: float write-msgpack 203 write1 double>bits 8 >be write ;
USING: cuda.ptx io math math.parser sequences ;
M: float write-ptx-operand
"0d" write double>bits >hex 16 48 pad-head write ;