Remove bignum>float VM primitive, and use bignum/f to implement >float on bignums...

diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index dc16cf8b246b4b7e99eb9db215f3721ad1516339..abfb3199a2989574f3a1fc0546cc9a7d942c5310 100644 (file)
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -3,9 +3,9 @@
 USING: accessors arrays assocs byte-arrays byte-vectors classes
 combinators definitions effects fry generic generic.single
 generic.standard hashtables io.binary io.encodings
-io.streams.string kernel kernel.private math
-math.integers.private math.parser namespaces parser sbufs
-sequences splitting splitting.private strings vectors words ;
+io.streams.string kernel kernel.private math math.parser
+namespaces parser sbufs sequences splitting splitting.private
+strings vectors words ;
 IN: hints
 
 GENERIC: specializer-predicate ( spec -- quot )
@@ -130,6 +130,4 @@ M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-pr
 
 M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
 
-\ bignum/f { { bignum bignum } { bignum fixnum } { fixnum bignum } { fixnum fixnum } } "specializer" set-word-prop
-
 \ encode-string { string object object } "specializer" set-word-prop

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 47e882f2277501705ddc2dfea87da23128876aca..43bff4e96a833b4e85aa0037036a90b43df17b19 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -338,7 +338,6 @@ M: object infer-call* \ call bad-macro-input ;
 \ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable
 \ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable
 \ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable
-\ bignum>float { bignum } { float } define-primitive \ bignum>float make-foldable
 \ bits>double { integer } { float } define-primitive \ bits>double make-foldable
 \ bits>float { integer } { float } define-primitive \ bits>float make-foldable
 \ both-fixnums? { object object } { object } define-primitive

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 8e3af26932377db2c1a3cf7bfae6f083d0b75e8e..90b48c6a375db455fb447dfddf3c4929c5e65e73 100755 (executable)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -491,7 +491,6 @@ tuple
     { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) }
     { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) }
     { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) }
-    { "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) }
     { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) }
     { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) }
     { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) }

diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor
index 45fce36ee6f5f23e645d0bd5c607769cbc0c337a..49e5ec30ccb3ff8cb747ff5c326f380cc8a1ca6c 100644 (file)
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@@ -7,9 +7,6 @@ IN: math.floats.private
 : float-min ( x y -- z ) [ float< ] most ; foldable
 : float-max ( x y -- z ) [ float> ] most ; foldable
 
-M: fixnum >float fixnum>float ; inline
-M: bignum >float bignum>float ; inline
-
 M: float >fixnum float>fixnum ; inline
 M: float >bignum float>bignum ; inline
 M: float >float ; inline

diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 22fe01f1ab743dd37060b1994554207736e6dca1..eded605ddd5cae98774ce07494a348bb514dae55 100644 (file)
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -14,6 +14,7 @@ M: integer denominator drop 1 ; inline
 M: fixnum >fixnum ; inline
 M: fixnum >bignum fixnum>bignum ; inline
 M: fixnum >integer ; inline
+M: fixnum >float fixnum>float ; inline
 
 M: fixnum hashcode* nip ; inline
 M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ; inline
@@ -37,16 +38,6 @@ M: fixnum - fixnum- ; inline
 M: fixnum * fixnum* ; inline
 M: fixnum /i fixnum/i ; inline
 
-DEFER: bignum/f
-CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
-
-: fixnum/f ( m n -- m/n )
-    [ >float ] bi@ float/f ; inline
-
-M: fixnum /f
-    2dup [ abs bignum/f-threshold >= ] either?
-    [ bignum/f ] [ fixnum/f ] if ; inline
-
 M: fixnum mod fixnum-mod ; inline
 
 M: fixnum /mod fixnum/mod ; inline
@@ -130,15 +121,12 @@ M: bignum (log2) bignum-log2 ; inline
     [ /mod ] dip ; inline
 
 ! Third step: post-scaling
-: unscaled-float ( mantissa -- n )
-    52 2^ 1 - bitand 1022 52 shift bitor bits>double ; inline
-
-: scale-float ( mantissa scale -- float' )
-    dup 0 < [ neg 2^ recip ] [ 2^ ] if * ; inline
+: scaled-float ( mantissa scale -- n )
+    [ 52 2^ 1 - bitand ] dip 1022 + 52 shift bitor bits>double ; inline
 
 : post-scale ( mantissa scale -- n )
     [ 2/ ] dip over log2 52 > [ [ 2/ ] [ 1 + ] bi* ] when
-    [ unscaled-float ] dip scale-float ; inline
+    scaled-float ; inline
 
 : round-to-nearest ( fraction-and-guard rem -- fraction-and-guard' )
     over odd?
@@ -157,7 +145,21 @@ M: bignum (log2) bignum-log2 ; inline
     ] if ; inline
 
 : bignum/f ( m n -- f )
-    [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ;
+    [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; inline
+
+M: bignum /f ( m n -- f ) { bignum bignum } declare bignum/f ;
+
+CONSTANT: bignum/f-threshold HEX: 20,0000,0000,0000
+
+: fixnum/f ( m n -- m/n )
+    [ >float ] bi@ float/f ; inline
+
+M: fixnum /f
+    { fixnum fixnum } declare
+    2dup [ abs bignum/f-threshold >= ] either?
+    [ bignum/f ] [ fixnum/f ] if ; inline
+
+: bignum>float ( bignum -- float )
+    { bignum } declare 1 >bignum bignum/f ;
 
-M: bignum /f ( m n -- f )
-    bignum/f ;
+M: bignum >float bignum>float ; inline

diff --git a/core/math/math.factor b/core/math/math.factor
index bc7658feba439629e44aa846561f907db80bd75e..e8f2813a959418d2408c37b5d2815a7edae7b8e0 100644 (file)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -59,11 +59,7 @@ PRIVATE>
 ERROR: log2-expects-positive x ;
 
 : log2 ( x -- n )
-    dup 0 <= [
-        log2-expects-positive
-    ] [
-        (log2)
-    ] if ; inline
+    dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline
 
 : zero? ( x -- ? ) 0 number= ; inline
 : 2/ ( x -- y ) -1 shift ; inline
@@ -74,8 +70,8 @@ ERROR: log2-expects-positive x ;
 : ?1+ ( x -- y ) [ 1 + ] [ 0 ] if* ; inline
 : rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable
 : 2^ ( n -- 2^n ) 1 swap shift ; inline
-: even? ( n -- ? ) 1 bitand zero? ;
-: odd? ( n -- ? ) 1 bitand 1 number= ;
+: even? ( n -- ? ) 1 bitand zero? ; inline
+: odd? ( n -- ? ) 1 bitand 1 number= ; inline
 
 : if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b )
     [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline

diff --git a/vm/bignum.cpp b/vm/bignum.cpp
index 47896340cd8ce45dfaa686d5b9a1f4eeadb2e0b4..adcfa6f4da4655943615233b5da092bb350d7b20 100755 (executable)
--- a/vm/bignum.cpp
+++ b/vm/bignum.cpp
@@ -381,25 +381,11 @@ FOO_TO_BIGNUM(ulong_long,u64,s64,u64)
                }                                                       \
        }
 
-BIGNUM_TO_FOO(cell,cell,fixnum,cell);
-BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell);
+BIGNUM_TO_FOO(cell,cell,fixnum,cell)
+BIGNUM_TO_FOO(fixnum,fixnum,fixnum,cell)
 BIGNUM_TO_FOO(long_long,s64,s64,u64)
 BIGNUM_TO_FOO(ulong_long,u64,s64,u64)
 
-double factor_vm::bignum_to_double(bignum * bignum)
-{
-       if (BIGNUM_ZERO_P (bignum))
-               return (0);
-       {
-               double accumulator = 0;
-               bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
-               bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
-               while (start < scan)
-                       accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
-               return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
-       }
-}
-
 #define DTB_WRITE_DIGIT(factor)                                                \
 {                                                                      \
        significand *= (factor);                                        \

diff --git a/vm/math.cpp b/vm/math.cpp
index 67cab3570dc756378a7a0a122c23ce692e32dc9a..4bc918ad66ab29d81fe82a2cacbba08f57050d82 100755 (executable)
--- a/vm/math.cpp
+++ b/vm/math.cpp
@@ -255,11 +255,6 @@ void factor_vm::primitive_fixnum_to_float()
        ctx->replace(allot_float(fixnum_to_float(ctx->peek())));
 }
 
-void factor_vm::primitive_bignum_to_float()
-{
-       ctx->replace(allot_float(bignum_to_float(ctx->peek())));
-}
-
 void factor_vm::primitive_format_float()
 {
        byte_array *array = allot_byte_array(100);

diff --git a/vm/math.hpp b/vm/math.hpp
index ffe60dced5f0f0e0c04e198dedea7588d1a10ff0..62c007be8df605cf522ab14a65804e4ad3319fe0 100644 (file)
--- a/vm/math.hpp
+++ b/vm/math.hpp
@@ -33,11 +33,6 @@ inline bignum *factor_vm::float_to_bignum(cell tagged)
        return double_to_bignum(untag_float(tagged));
 }
 
-inline double factor_vm::bignum_to_float(cell tagged)
-{
-       return bignum_to_double(untag<bignum>(tagged));
-}
-
 inline double factor_vm::untag_float(cell tagged)
 {
        return untag<boxed_float>(tagged)->n;

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index ce40ca0a7e97de642cf8a94f96663e49d4a5f6a7..573f91b072ba71757170727a5fb94bb554eaff5b 100644 (file)
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -27,7 +27,6 @@ namespace factor
        _(bignum_shift) \
        _(bignum_subtract) \
        _(bignum_to_fixnum) \
-       _(bignum_to_float) \
        _(bignum_xor) \
        _(bits_double) \
        _(bits_float) \

diff --git a/vm/vm.hpp b/vm/vm.hpp
index f940bd593734bf6167c30f0e4f14e8589e80c803..38eb5033d77060239706363b600a83e34db4a581 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -192,7 +192,6 @@ struct factor_vm
        fixnum bignum_to_fixnum(bignum * bignum);
        s64 bignum_to_long_long(bignum * bignum);
        u64 bignum_to_ulong_long(bignum * bignum);
-       double bignum_to_double(bignum * bignum);
        bignum *double_to_bignum(double x);
        int bignum_equal_p_unsigned(bignum * x, bignum * y);
        enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y);
@@ -457,7 +456,6 @@ struct factor_vm
        inline cell unbox_array_size();
        cell unbox_array_size_slow();
        void primitive_fixnum_to_float();
-       void primitive_bignum_to_float();
        void primitive_format_float();
        void primitive_float_eq();
        void primitive_float_add();
@@ -487,7 +485,6 @@ struct factor_vm
        inline cell from_unsigned_cell(cell x);
        inline cell allot_float(double n);
        inline bignum *float_to_bignum(cell tagged);
-       inline double bignum_to_float(cell tagged);
        inline double untag_float(cell tagged);
        inline double untag_float_check(cell tagged);
        inline fixnum float_to_fixnum(cell tagged);