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

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 15895184df8c25d7698831cf452f16c386b01df1..1fa9a94677e378fa7859be3e7026d73a80e3f2fb 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/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

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 87963848bf32ccdba218b0ce17dcaf27a57cc913..c466b0c1f84fe6dea7648a58c0a6fe920032c099 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/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 )) }

diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index 5bb024db9dd3c85cae95744c940f64e9232c88de..14fd6a298392451ad9749fe63dc998fa67eed173 100644 (file)
--- a/core/math/parser/parser.factor
+++ b/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>

diff --git a/vm/math.cpp b/vm/math.cpp
index a4622323449742677ce9f37786c019ea8e60f8d3..e64db2690ed43e58da2fca01da78a6606a316b2b 100755 (executable)
--- a/vm/math.cpp
+++ b/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));
 }
 

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index ff0947912cad70cd3c35a3f1cb35e224bc753afb..e98cf508b6bb0be67db8d2caa3ba3b0c602b02d1 100644 (file)
--- a/vm/primitives.hpp
+++ b/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) \

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 36ec3260d6563352128e28876f5d052b92836ec2..dd1d48cf0388184f631b63f14a99dee9efcaa1c3 100755 (executable)
--- a/vm/vm.hpp
+++ b/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();