math.parser: expose a format-float primitive for use by formatting vocabulary

basis/stack-checker/known-words/known-words.factor

@@ -289,7 +289,7 @@ M: bad-executable summary
 \ (dlsym) { byte-array object } { c-ptr } define-primitive
 \ (exists?) { string } { object } define-primitive
 \ (exit) { integer } { } define-primitive
-\ (float>string) { float } { byte-array } define-primitive \ (float>string) make-foldable
+\ (format-float) { float byte-array } { byte-array } define-primitive \ (format-float) make-foldable
 \ (fopen) { byte-array byte-array } { alien } define-primitive
 \ (identity-hashcode) { object } { fixnum } define-primitive
 \ (save-image) { byte-array byte-array } { } define-primitive

core/bootstrap/primitives.factor

@@ -470,7 +470,7 @@ tuple
     { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) }
     { "double>bits" "math" "primitive_double_bits" (( x -- n )) }
     { "float>bits" "math" "primitive_float_bits" (( x -- n )) }
-    { "(float>string)" "math.parser.private" "primitive_float_to_str" (( n -- str )) }
+    { "(format-float)" "math.parser.private" "primitive_format_float" (( n format -- byte-array )) }
     { "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) }
     { "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) }
     { "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) }

core/math/parser/parser.factor

@@ -1,6 +1,7 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors combinators kernel kernel.private math
-namespaces sequences sequences.private splitting strings make ;
+USING: accessors byte-arrays combinators kernel kernel.private
+math namespaces sequences sequences.private splitting strings
+make ;
 IN: math.parser
 
 : digit> ( ch -- n )
@@ -356,15 +357,15 @@ M: ratio >base
         mantissa-expt [ float>hex-value ] [ float>hex-expt ] bi*
     ] bi 3append ;
 
-: float>decimal ( n -- str )
-    (float>string)
-    [ 0 = ] trim-tail >string
+: format-float ( n format -- string )
+    0 suffix >byte-array (format-float)
+    dup [ 0 = ] find drop head >string
     fix-float ;
 
 : float>base ( n base -- str )
     {
         { 16 [ float>hex ] }
-        [ drop float>decimal ]
+        [ drop "%.16g" format-float ]
     } case ; inline
 
 PRIVATE>

vm/math.cpp

@@ -260,10 +260,12 @@ void factor_vm::primitive_bignum_to_float()
 	ctx->replace(allot_float(bignum_to_float(ctx->peek())));
 }
 
-void factor_vm::primitive_float_to_str()
+void factor_vm::primitive_format_float()
 {
-	byte_array *array = allot_byte_array(33);
-	SNPRINTF((char *)(array + 1),32,"%.16g",untag_float_check(ctx->pop()));
+	byte_array *array = allot_byte_array(100);
+	char *format = alien_offset(ctx->pop());
+	double value = untag_float_check(ctx->pop());
+	SNPRINTF(array->data<char>(),99,format,value);
 	ctx->push(tag<byte_array>(array));
 }
 

vm/primitives.hpp

@@ -82,8 +82,8 @@ namespace factor
 	_(float_subtract) \
 	_(float_to_bignum) \
 	_(float_to_fixnum) \
-	_(float_to_str) \
 	_(fopen) \
+	_(format_float) \
 	_(fputc) \
 	_(fread) \
 	_(fseek) \

vm/vm.hpp

@@ -464,7 +464,7 @@ struct factor_vm
 	cell unbox_array_size_slow();
 	void primitive_fixnum_to_float();
 	void primitive_bignum_to_float();
-	void primitive_float_to_str();
+	void primitive_format_float();
 	void primitive_float_eq();
 	void primitive_float_add();
 	void primitive_float_subtract();