57 lines
1.5 KiB
Factor
57 lines
1.5 KiB
Factor
! Copyright (C) 2008 Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel math sequences prettyprint math.parser io
|
|
math.functions math.bitwise combinators.short-circuit ;
|
|
IN: math.floating-point
|
|
|
|
: (double-sign) ( bits -- n ) -63 shift ; inline
|
|
: double-sign ( double -- n ) double>bits (double-sign) ;
|
|
|
|
: (double-exponent-bits) ( bits -- n )
|
|
-52 shift 11 on-bits mask ; inline
|
|
|
|
: double-exponent-bits ( double -- n )
|
|
double>bits (double-exponent-bits) ;
|
|
|
|
: (double-mantissa-bits) ( double -- n )
|
|
52 on-bits mask ;
|
|
|
|
: double-mantissa-bits ( double -- n )
|
|
double>bits (double-mantissa-bits) ;
|
|
|
|
: >double ( S E M -- frac )
|
|
[ 52 shift ] dip
|
|
[ 63 shift ] 2dip bitor bitor bits>double ;
|
|
|
|
: >double< ( double -- S E M )
|
|
double>bits
|
|
[ (double-sign) ]
|
|
[ (double-exponent-bits) ]
|
|
[ (double-mantissa-bits) ] tri ;
|
|
|
|
: double. ( double -- )
|
|
double>bits
|
|
[ (double-sign) .b ]
|
|
[ (double-exponent-bits) >bin 11 CHAR: 0 pad-head bl print ]
|
|
[
|
|
(double-mantissa-bits) >bin 52 CHAR: 0 pad-head
|
|
11 [ bl ] times print
|
|
] tri ;
|
|
|
|
: infinity? ( double -- ? )
|
|
double>bits
|
|
{
|
|
[ (double-exponent-bits) 11 on-bits = ]
|
|
[ (double-mantissa-bits) 0 = ]
|
|
} 1&& ;
|
|
|
|
: check-special ( n -- n )
|
|
dup fp-special? [ "cannot be special" throw ] when ;
|
|
|
|
: double>ratio ( double -- a/b )
|
|
check-special double>bits
|
|
[ (double-sign) zero? 1 -1 ? ]
|
|
[ (double-mantissa-bits) 52 2^ / ]
|
|
[ (double-exponent-bits) ] tri
|
|
[ 1 ] [ [ 1 + ] dip ] if-zero 1023 - 2 swap ^ * * ;
|