1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel math sequences prettyprint math.parser io
4 math.functions math.bitwise combinators.short-circuit ;
5 IN: math.floating-point
7 : (double-sign) ( bits -- n ) -63 shift ; inline
8 : double-sign ( double -- n ) double>bits (double-sign) ;
10 : (double-exponent-bits) ( bits -- n )
11 -52 shift 11 on-bits mask ; inline
13 : double-exponent-bits ( double -- n )
14 double>bits (double-exponent-bits) ;
16 : (double-mantissa-bits) ( double -- n )
19 : double-mantissa-bits ( double -- n )
20 double>bits (double-mantissa-bits) ;
22 : >double ( S E M -- frac )
24 [ 63 shift ] 2dip bitor bitor bits>double ;
26 : >double< ( double -- S E M )
29 [ (double-exponent-bits) ]
30 [ (double-mantissa-bits) ] tri ;
32 : double. ( double -- )
35 [ (double-exponent-bits) >bin 11 CHAR: 0 pad-head bl print ]
37 (double-mantissa-bits) >bin 52 CHAR: 0 pad-head
41 : infinity? ( double -- ? )
44 [ (double-exponent-bits) 11 on-bits = ]
45 [ (double-mantissa-bits) 0 = ]
48 : check-special ( n -- n )
49 dup fp-special? [ "cannot be special" throw ] when ;
51 : double>ratio ( double -- a/b )
52 check-special double>bits
53 [ (double-sign) zero? 1 -1 ? ]
54 [ (double-mantissa-bits) 52 2^ / ]
55 [ (double-exponent-bits) ] tri
56 [ 1 ] [ [ 1 + ] dip ] if-zero 1023 - 2 swap ^ * * ;