prettyprinter, locale independant float printing
parent
3cd2775855
commit
19fadb6c96
|
@ -150,7 +150,7 @@ M: timestamp year. ( timestamp -- )
|
||||||
! Should be enough for anyone, allows to not do a fancy
|
! Should be enough for anyone, allows to not do a fancy
|
||||||
! algorithm to detect infinite decimals (e.g 1/3)
|
! algorithm to detect infinite decimals (e.g 1/3)
|
||||||
: ss.SSSSSS ( timestamp -- )
|
: ss.SSSSSS ( timestamp -- )
|
||||||
second>> >float "%09.6f" format-float write ;
|
second>> >float "0" 9 6 "f" "C" format-float write ;
|
||||||
|
|
||||||
: (timestamp>rfc3339) ( timestamp -- )
|
: (timestamp>rfc3339) ( timestamp -- )
|
||||||
{
|
{
|
||||||
|
|
|
@ -30,8 +30,7 @@ IN: formatting
|
||||||
[ 0 ] [ string>number ] if-empty ;
|
[ 0 ] [ string>number ] if-empty ;
|
||||||
|
|
||||||
: format-simple ( x digits string -- string )
|
: format-simple ( x digits string -- string )
|
||||||
[ [ >float ] [ number>string ] bi* "%." ] dip
|
[ >float "" -1 ] 2dip "" format-float ;
|
||||||
surround format-float ;
|
|
||||||
|
|
||||||
: format-scientific ( x digits -- string ) "e" format-simple ;
|
: format-scientific ( x digits -- string ) "e" format-simple ;
|
||||||
|
|
||||||
|
|
|
@ -420,7 +420,7 @@ M: object infer-call* \ call bad-macro-input ;
|
||||||
{ fixnum>float { fixnum } { float } }
|
{ fixnum>float { fixnum } { float } }
|
||||||
|
|
||||||
! float
|
! float
|
||||||
{ (format-float) { float byte-array } { byte-array } }
|
{ (format-float) { float byte-array fixnum fixnum byte-array byte-array } { byte-array } }
|
||||||
{ bits>float { integer } { float } }
|
{ bits>float { integer } { float } }
|
||||||
{ float* { float float } { float } }
|
{ float* { float float } { float } }
|
||||||
{ float+ { float float } { float } }
|
{ float+ { float float } { float } }
|
||||||
|
|
|
@ -476,7 +476,7 @@ tuple
|
||||||
{ "bits>float" "math" "primitive_bits_float" ( n -- x ) }
|
{ "bits>float" "math" "primitive_bits_float" ( n -- x ) }
|
||||||
{ "double>bits" "math" "primitive_double_bits" ( x -- n ) }
|
{ "double>bits" "math" "primitive_double_bits" ( x -- n ) }
|
||||||
{ "float>bits" "math" "primitive_float_bits" ( x -- n ) }
|
{ "float>bits" "math" "primitive_float_bits" ( x -- n ) }
|
||||||
{ "(format-float)" "math.parser.private" "primitive_format_float" ( n format -- byte-array ) }
|
{ "(format-float)" "math.parser.private" "primitive_format_float" ( n fill width precision format locale -- byte-array ) }
|
||||||
{ "bignum*" "math.private" "primitive_bignum_multiply" ( x y -- z ) }
|
{ "bignum*" "math.private" "primitive_bignum_multiply" ( x y -- z ) }
|
||||||
{ "bignum+" "math.private" "primitive_bignum_add" ( x y -- z ) }
|
{ "bignum+" "math.private" "primitive_bignum_add" ( x y -- z ) }
|
||||||
{ "bignum-" "math.private" "primitive_bignum_subtract" ( x y -- z ) }
|
{ "bignum-" "math.private" "primitive_bignum_subtract" ( x y -- z ) }
|
||||||
|
|
|
@ -6,7 +6,7 @@ sequences.private splitting strings strings.private ;
|
||||||
IN: math.parser
|
IN: math.parser
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
PRIMITIVE: (format-float) ( n format -- byte-array )
|
PRIMITIVE: (format-float) ( n fill width precision format locale -- byte-array )
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: digit> ( ch -- n )
|
: digit> ( ch -- n )
|
||||||
|
@ -488,12 +488,12 @@ M: ratio >base
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: fix-float ( str -- newstr )
|
: fix-float ( str exponent -- newstr )
|
||||||
CHAR: e over index [
|
2dup first swap member? [
|
||||||
cut [ fix-float ] dip append
|
[ [ split1 ] keep swap [ fix-float ] dip ] [ glue ] bi
|
||||||
] [
|
] [
|
||||||
CHAR: . over member? [ ".0" append ] unless
|
drop CHAR: . over member? [ ".0" append ] unless
|
||||||
] if* ;
|
] if ;
|
||||||
|
|
||||||
: mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
|
: mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
|
||||||
[ dup log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + neg ] bi ]
|
[ dup log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + neg ] bi ]
|
||||||
|
@ -548,14 +548,17 @@ M: ratio >base
|
||||||
] 2curry each-integer
|
] 2curry each-integer
|
||||||
] keep ; inline
|
] keep ; inline
|
||||||
|
|
||||||
: format-float ( n format -- string )
|
: format-float ( n fill width precision format locale -- string )
|
||||||
format-string (format-float)
|
[
|
||||||
dup [ 0 = ] find drop
|
[ format-string ] 4dip [ format-string ] bi@ (format-float)
|
||||||
format-head fix-float ; inline
|
dup [ 0 = ] find drop format-head
|
||||||
|
] [
|
||||||
|
"C" = [ [ "G" = ] [ "E" = ] bi or "E" "e" ? fix-float ] [ drop ] if
|
||||||
|
] 2bi ; inline
|
||||||
|
|
||||||
: float>base ( n radix -- str )
|
: float>base ( n radix -- str )
|
||||||
{
|
{
|
||||||
{ 10 [ "%.16g" format-float ] }
|
{ 10 [ "" -1 16 "" "C" format-float ] }
|
||||||
[ bin-float>base ]
|
[ bin-float>base ]
|
||||||
} case ; inline
|
} case ; inline
|
||||||
|
|
||||||
|
|
32
vm/math.cpp
32
vm/math.cpp
|
@ -1,4 +1,6 @@
|
||||||
#include "master.hpp"
|
#include "master.hpp"
|
||||||
|
#include <sstream>
|
||||||
|
#include <iomanip>
|
||||||
|
|
||||||
namespace factor {
|
namespace factor {
|
||||||
|
|
||||||
|
@ -211,10 +213,36 @@ void factor_vm::primitive_fixnum_to_float() {
|
||||||
|
|
||||||
/* Allocates memory */
|
/* Allocates memory */
|
||||||
void factor_vm::primitive_format_float() {
|
void factor_vm::primitive_format_float() {
|
||||||
byte_array* array = allot_byte_array(100);
|
char* locale = alien_offset(ctx->pop());
|
||||||
char* format = alien_offset(ctx->pop());
|
char* format = alien_offset(ctx->pop());
|
||||||
|
fixnum precision = untag_fixnum(ctx->pop());
|
||||||
|
fixnum width = untag_fixnum(ctx->pop());
|
||||||
|
char* fill = alien_offset(ctx->pop());
|
||||||
double value = untag_float_check(ctx->peek());
|
double value = untag_float_check(ctx->peek());
|
||||||
SNPRINTF(array->data<char>(), 99, format, value);
|
std::ostringstream localized_stream;
|
||||||
|
localized_stream.imbue(std::locale(locale));
|
||||||
|
switch (format[0]) {
|
||||||
|
case 'f': localized_stream << std::fixed; break;
|
||||||
|
case 'e': localized_stream << std::scientific; break;
|
||||||
|
}
|
||||||
|
if (isupper(format[0])) {
|
||||||
|
localized_stream << std::uppercase;
|
||||||
|
}
|
||||||
|
if (fill[0] != '\0') {
|
||||||
|
localized_stream << std::setfill(fill[0]);
|
||||||
|
}
|
||||||
|
if (width >= 0) {
|
||||||
|
localized_stream << std::setw(width);
|
||||||
|
}
|
||||||
|
if (precision >= 0) {
|
||||||
|
localized_stream << std::setprecision(precision);
|
||||||
|
}
|
||||||
|
localized_stream << value;
|
||||||
|
const std::string& tmp = localized_stream.str();
|
||||||
|
const char* cstr = tmp.c_str();
|
||||||
|
int size = tmp.length()+1;
|
||||||
|
byte_array* array = allot_byte_array(size);
|
||||||
|
memcpy(array->data<char>(), cstr, size);
|
||||||
ctx->replace(tag<byte_array>(array));
|
ctx->replace(tag<byte_array>(array));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue