Merge branch 'master' of git://github.com/slavapestov/factor

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

basis/specialized-arrays/specialized-arrays-docs.factor

@@ -41,7 +41,7 @@ ARTICLE: "specialized-array-words" "Specialized array words"
     { { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
     { { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } }
     { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
-    { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } }
+    { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated, zeroed out, unmanaged memory; stack effect " { $snippet "( len -- array )" } } }
     { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
     { { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
     { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }

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

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 )) }

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

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/f ;
+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 >float bignum>float ; inline

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

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);					\

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);

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;

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) \

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);