floats

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

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

library/platform/native/kernel.factor

@@ -47,8 +47,7 @@ USE: unparser
     [
         [ cons? ] [ 4 cons-hashcode ]
         [ string? ] [ str-hashcode ]
-        [ fixnum? ] [ ( return the object ) ]
+        [ number? ] [ >fixnum ]
-        [ bignum? ] [ >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" ]

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
+        [ "/" swap str-contains? ] [ str>ratio   ]
-    ] [
+        [ "." swap str-contains? ] [ str>float   ]
-        str>integer
+        [ drop t                 ] [ str>integer ]
-    ] ifte ;
+    ] cond ;
 
 : parse-number ( str -- num/f )
     [ str>number ] [ [ drop f ] when ] catch ;

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 ;

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

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

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:

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

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);

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,

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 102
+#define PRIMITIVE_COUNT 107
 
 CELL primitive_to_xt(CELL primitive);

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;