clean up math.floating-point

extra/math/floating-point/floating-point.factor

@@ -1,32 +1,40 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences ;
+USING: kernel math sequences prettyprint math.parser io
+math.functions ;
 IN: math.floating-point
 
-: float-sign ( float -- ? )
-    float>bits -31 shift { 1 -1 } nth ; 
+: (double-sign) ( bits -- n ) -63 shift ; inline
+: double-sign ( double -- n ) double>bits (double-sign) ;
 
-: double-sign ( float -- ? )
-    double>bits -63 shift { 1 -1 } nth ;
-
-: float-exponent-bits ( float -- n )
-    float>bits -23 shift 8 2^ 1- bitand ;
+: (double-exponent-bits) ( bits -- n )
+    -52 shift 11 2^ 1- bitand ; inline
 
 : double-exponent-bits ( double -- n )
-    double>bits -52 shift 11 2^ 1- bitand ;
+    double>bits (double-exponent-bits) ;
 
-: float-mantissa-bits ( float -- n )
-    float>bits 23 2^ 1- bitand ;
+: (double-mantissa-bits) ( double -- n )
+    52 2^ 1- bitand ;
 
 : double-mantissa-bits ( double -- n )
-    double>bits 52 2^ 1- bitand ;
+    double>bits (double-mantissa-bits) ;
 
-: float-e ( -- float ) 127 ; inline
-: double-e ( -- float ) 1023 ; inline
+: >double ( S E M -- frac )
+    [ 52 shift ] dip
+    [ 63 shift ] 2dip bitor bitor bits>double ;
 
-! : calculate-float ( S M E -- float )
-    ! float-e - 2^ * * ; ! bits>float ;
+: >double< ( double -- S E M )
+    double>bits
+    [ (double-sign) ]
+    [ (double-exponent-bits) ]
+    [ (double-mantissa-bits) ] tri ;
 
-! : calculate-double ( S M E -- frac )
-    ! double-e - 2^ swap 52 2^ /f 1+ * * ;
+: double. ( double -- )
+    double>bits
+    [ (double-sign) .b ]
+    [ (double-exponent-bits) >bin 11 CHAR: 0 pad-left bl print ]
+    [
+        (double-mantissa-bits) >bin 52 CHAR: 0 pad-left
+        11 [ bl ] times print
+    ] tri ;