Add functions to convert back and forth between floating-point representations.

collects/scribblings/reference/numbers.scrbl

@@ -217,6 +217,14 @@ number, @racket[#f] otherwise.}
 
 @mz-examples[(exact->inexact 1) (exact->inexact 1.0)]}
 
+@defproc[(real->single-flonum [z real?]) single-flonum?]{ Coerces @racket[z]
+ to a single-precision floating-point number. If @racket[z] is already
+ a single-precision floating-point number, it is returned.}
+
+@defproc[(real->double-flonum [z real?]) flonum?]{ Coerces @racket[z]
+ to a double-precision floating-point number. If @racket[z] is already
+ a double-precision floating-point number, it is returned.}
+
 @; ----------------------------------------
 @section[#:tag "generic-numbers"]{Generic Numerics}
 

collects/tests/racket/number.rktl

@@ -679,6 +679,13 @@
 (err/rt-test (inexact->exact -inf.0))
 (err/rt-test (inexact->exact +nan.0))
 
+(test 2.0f0 real->single-flonum 2)
+(test 2.25f0 real->single-flonum 2.25)
+(test 2.25f0 real->single-flonum 2.25f0)
+(test 2.0 real->double-flonum 2)
+(test 2.25 real->double-flonum 2.25)
+(test 2.25 real->double-flonum 2.25f0)
+
 (err/rt-test (* 'a 0))
 (err/rt-test (+ 'a 0))
 (err/rt-test (/ 'a 0))

src/racket/src/number.c

@@ -65,6 +65,8 @@ static Scheme_Object *fixnum_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *inexact_real_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *flonum_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *single_flonum_p (int argc, Scheme_Object *argv[]);
+static Scheme_Object *real_to_single_flonum (int argc, Scheme_Object *argv[]);
+static Scheme_Object *real_to_double_flonum (int argc, Scheme_Object *argv[]);
 static Scheme_Object *exact_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *even_p (int argc, Scheme_Object *argv[]);
 static Scheme_Object *bitwise_or (int argc, Scheme_Object *argv[]);
@@ -164,6 +166,9 @@ static Scheme_Object *unsafe_make_flrectangular (int argc, Scheme_Object *argv[]
 static Scheme_Object *unsafe_flreal_part (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_flimag_part (int argc, Scheme_Object *argv[]);
 
+static Scheme_Object *TO_FLOAT(const Scheme_Object *n);
+Scheme_Object *scheme_TO_DOUBLE(const Scheme_Object *n);
+
 /* globals */
 READ_ONLY double scheme_infinity_val;
 READ_ONLY double scheme_minus_infinity_val;
@@ -370,6 +375,12 @@ scheme_init_number (Scheme_Env *env)
   SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
   scheme_add_global_constant("single-flonum?", p, env);
 
+  p = scheme_make_folding_prim(real_to_single_flonum, "real->single-flonum", 1, 1, 1);
+  scheme_add_global_constant("real->single-flonum", p, env);
+
+  p = scheme_make_folding_prim(real_to_double_flonum, "real->double-flonum", 1, 1, 1);
+  scheme_add_global_constant("real->double-flonum", p, env);
+  
   scheme_add_global_constant("exact?", 
 			     scheme_make_folding_prim(exact_p,
 						      "exact?",
@@ -1349,6 +1360,28 @@ single_flonum_p (int argc, Scheme_Object *argv[])
     return scheme_false;
 }
 
+static Scheme_Object *
+real_to_single_flonum (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *n = argv[0];
+
+  if (!SCHEME_REALP(n))
+    NEED_REAL(real->single-flonum);
+
+  return TO_FLOAT(n);
+}
+
+static Scheme_Object *
+real_to_double_flonum (int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *n = argv[0];
+
+  if (!SCHEME_REALP(n))
+    NEED_REAL(real->double-flonum);
+
+  return scheme_TO_DOUBLE(n);
+}
+
 int scheme_is_exact(const Scheme_Object *n)
 {
   if (SCHEME_INTP(n)) {

src/racket/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1019
+#define EXPECTED_PRIM_COUNT 1021
 #define EXPECTED_UNSAFE_COUNT 76
 #define EXPECTED_FLFXNUM_COUNT 68
 #define EXPECTED_FUTURES_COUNT 5