From 288090d99346e28b4b64976a2c0a917abdfcad65 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 13 Apr 2010 21:21:28 -0700
Subject: [PATCH] math.parser: expose a format-float primitive for use by
 formatting vocabulary

---
 basis/stack-checker/known-words/known-words.factor |  2 +-
 core/bootstrap/primitives.factor                   |  2 +-
 core/math/parser/parser.factor                     | 13 +++++++------
 vm/math.cpp                                        |  8 +++++---
 vm/primitives.hpp                                  |  2 +-
 vm/vm.hpp                                          |  2 +-
 6 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 15895184df..1fa9a94677 100644
--- 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 87963848bf..c466b0c1f8 100644
--- 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 5bb024db9d..14fd6a2983 100644
--- 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 a462232344..e64db2690e 100755
--- 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 ff0947912c..e98cf508b6 100644
--- 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 36ec3260d6..dd1d48cf03 100755
--- 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();