From d7eb8e8b2db2703fedcb9a1b6ebf9152f8b40e62 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 5 Aug 2004 21:33:02 +0000 Subject: [PATCH] floats --- TODO.FACTOR.txt | 1 + library/cross-compiler.factor | 11 ++++++++ library/platform/native/kernel.factor | 4 +-- library/platform/native/parse-numbers.factor | 10 +++---- library/platform/native/unparser.factor | 1 + library/test/math/float.factor | 29 ++++++++++++++++++++ library/test/math/rational.factor | 8 ++++++ native/arithmetic.c | 1 + native/float.c | 14 ++++++++++ native/float.h | 2 ++ native/primitives.c | 5 ++++ native/primitives.h | 2 +- native/types.c | 3 ++ 13 files changed, 83 insertions(+), 8 deletions(-) create mode 100644 library/test/math/float.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index ae2c1b4d74..791979ccff 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,5 +1,6 @@ + native: +- do something about "base" variable -- too fragile ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ] - errors: don't show .factor-rc - ratio comparsion, ratio bitops that coerce to integers diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index e59dc1e34d..bbe6582448 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -66,6 +66,9 @@ DEFER: write-fd-8 DEFER: flush-fd DEFER: shutdown-fd +IN: parser +DEFER: str>float + IN: random DEFER: init-random DEFER: (random-int) @@ -79,6 +82,9 @@ DEFER: set-word-parameter DEFER: word-plist DEFER: set-word-plist +IN: unparser +DEFER: unparse-float + IN: cross-compiler : primitives, ( -- ) @@ -118,16 +124,21 @@ IN: cross-compiler >fixnum >bignum >integer + >float number= fixnum? bignum? ratio? numerator denominator + float? + str>float + unparse-float + - * /i + /f / mod /mod diff --git a/library/platform/native/kernel.factor b/library/platform/native/kernel.factor index 0a0c59da07..8d16c30eb4 100644 --- a/library/platform/native/kernel.factor +++ b/library/platform/native/kernel.factor @@ -47,8 +47,7 @@ USE: unparser [ [ cons? ] [ 4 cons-hashcode ] [ string? ] [ str-hashcode ] - [ fixnum? ] [ ( return the object ) ] - [ bignum? ] [ >fixnum ] + [ number? ] [ >fixnum ] [ drop t ] [ drop 0 ] ] cond ; @@ -77,6 +76,7 @@ USE: unparser [ fixnum? ] [ drop "fixnum" ] [ bignum? ] [ drop "bignum" ] [ ratio? ] [ drop "ratio" ] + [ float? ] [ drop "float" ] [ cons? ] [ drop "cons" ] [ word? ] [ drop "word" ] [ f = ] [ drop "f" ] diff --git a/library/platform/native/parse-numbers.factor b/library/platform/native/parse-numbers.factor index 8430865c44..dd083e9729 100644 --- a/library/platform/native/parse-numbers.factor +++ b/library/platform/native/parse-numbers.factor @@ -81,11 +81,11 @@ USE: unparser swap str>integer swap str>integer / ; : str>number ( str -- num ) - "/" over str-contains? [ - str>ratio - ] [ - str>integer - ] ifte ; + [ + [ "/" swap str-contains? ] [ str>ratio ] + [ "." swap str-contains? ] [ str>float ] + [ drop t ] [ str>integer ] + ] cond ; : parse-number ( str -- num/f ) [ str>number ] [ [ drop f ] when ] catch ; diff --git a/library/platform/native/unparser.factor b/library/platform/native/unparser.factor index 741c5e9584..881b450ea7 100644 --- a/library/platform/native/unparser.factor +++ b/library/platform/native/unparser.factor @@ -112,6 +112,7 @@ USE: vocabularies [ word? ] [ unparse-word ] [ integer? ] [ unparse-integer ] [ ratio? ] [ unparse-ratio ] + [ float? ] [ unparse-float ] [ string? ] [ unparse-str ] [ drop t ] [ <% "#<" % class-of % ">" % %> ] ] cond ; diff --git a/library/test/math/float.factor b/library/test/math/float.factor new file mode 100644 index 0000000000..dd18fe1bd5 --- /dev/null +++ b/library/test/math/float.factor @@ -0,0 +1,29 @@ +IN: scratchpad +USE: arithmetic +USE: kernel +USE: stack +USE: test + +[ t ] [ 0.0 float? ] unit-test +[ t ] [ 3.1415 number? ] unit-test +[ f ] [ 12 float? ] unit-test + +[ t ] [ 1 1.0 = ] unit-test +[ t ] [ 1 >bignum 1.0 = ] unit-test +[ t ] [ 1.0 1 = ] unit-test +[ t ] [ 1.0 1 >bignum = ] unit-test + +[ f ] [ 1 1.3 = ] unit-test +[ f ] [ 1 >bignum 1.3 = ] unit-test +[ f ] [ 1.3 1 = ] unit-test +[ f ] [ 1.3 1 >bignum = ] unit-test + +[ t ] [ 134.3 >fixnum 134 eq? ] unit-test + +[ 2.1 ] [ -2.1 neg ] unit-test + +[ 1 ] [ 0.5 1/2 + ] unit-test +[ 1 ] [ 1/2 0.5 + ] unit-test + +[ 3 ] [ 3.1415 >fixnum ] unit-test +[ 3 ] [ 3.1415 >bignum ] unit-test diff --git a/library/test/math/rational.factor b/library/test/math/rational.factor index edcc8ff101..239907e90f 100644 --- a/library/test/math/rational.factor +++ b/library/test/math/rational.factor @@ -5,6 +5,8 @@ USE: stack USE: test [ t ] [ 0 fixnum? ] unit-test +[ t ] [ 31415 number? ] unit-test +[ t ] [ 31415 >bignum number? ] unit-test [ t ] [ 2345621 fixnum? ] unit-test [ t ] [ 2345621 dup >bignum >fixnum = ] unit-test @@ -69,5 +71,11 @@ USE: test [ t ] [ 2/3 3/4 <= ] unit-test [ f ] [ -2/3 1/3 > ] unit-test +[ t ] [ 1000000000/999999 1000 > ] unit-test +[ f ] [ 100000 100000000000/999999 > ] unit-test +[ t ] +[ 1000000000000/999999999999 1000000000001/999999999998 < ] +unit-test + [ 3 ] [ 10/3 >integer ] unit-test [ -3 ] [ -10/3 >integer ] unit-test diff --git a/native/arithmetic.c b/native/arithmetic.c index 9bd13db66c..8cc8670273 100644 --- a/native/arithmetic.c +++ b/native/arithmetic.c @@ -45,6 +45,7 @@ void primitive_numberp(void) case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE: + case FLOAT_TYPE: env.dt = T; break; default: diff --git a/native/float.c b/native/float.c index f8c81b0ccf..92dbff6b16 100644 --- a/native/float.c +++ b/native/float.c @@ -29,6 +29,20 @@ void primitive_to_float(void) env.dt = tag_object(to_float(env.dt)); } +void primitive_str_to_float(void) +{ + char* c_str = to_c_string(untag_string(env.dt)); + env.dt = tag_object(make_float(atof(c_str))); +} + +void primitive_float_to_str(void) +{ + char tmp[33]; + snprintf(&tmp,32,"%.16g",untag_float(env.dt)->n); + tmp[32] = '\0'; + env.dt = tag_object(from_c_string(tmp)); +} + CELL number_eq_float(CELL x, CELL y) { return tag_boolean(((FLOAT*)UNTAG(x))->n diff --git a/native/float.h b/native/float.h index acdbc1faee..d4d7ecab91 100644 --- a/native/float.h +++ b/native/float.h @@ -19,6 +19,8 @@ INLINE FLOAT* untag_float(CELL tagged) void primitive_floatp(void); FLOAT* to_float(CELL tagged); void primitive_to_float(void); +void primitive_str_to_float(void); +void primitive_float_to_str(void); CELL number_eq_float(CELL x, CELL y); CELL add_float(CELL x, CELL y); CELL subtract_float(CELL x, CELL y); diff --git a/native/primitives.c b/native/primitives.c index faa282ab3c..2d15625eef 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -38,16 +38,21 @@ XT primitives[] = { primitive_to_fixnum, primitive_to_bignum, primitive_to_integer, + primitive_to_float, primitive_number_eq, primitive_fixnump, primitive_bignump, primitive_ratiop, primitive_numerator, primitive_denominator, + primitive_floatp, + primitive_str_to_float, + primitive_float_to_str, primitive_add, primitive_subtract, primitive_multiply, primitive_divint, + primitive_divfloat, primitive_divide, primitive_mod, primitive_divmod, diff --git a/native/primitives.h b/native/primitives.h index 8d32ff1680..8146fe1669 100644 --- a/native/primitives.h +++ b/native/primitives.h @@ -1,4 +1,4 @@ extern XT primitives[]; -#define PRIMITIVE_COUNT 102 +#define PRIMITIVE_COUNT 107 CELL primitive_to_xt(CELL primitive); diff --git a/native/types.c b/native/types.c index 35d1d45a4d..a549d3b6f5 100644 --- a/native/types.c +++ b/native/types.c @@ -104,6 +104,9 @@ CELL untagged_object_size(CELL pointer) case BIGNUM_TYPE: size = sizeof(BIGNUM); break; + case FLOAT_TYPE: + size = sizeof(FLOAT); + break; case HANDLE_TYPE: size = sizeof(HANDLE); break;