[MLton-devel] cvs commit: cleanup of Real{32,64} implementation
Stephen Weeks
sweeks@users.sourceforge.net
Sat, 26 Jul 2003 10:54:19 -0700
sweeks 03/07/26 10:54:19
Modified: basis-library/misc primitive.sml
basis-library/real real.fun real.sig
include c-chunk.h
runtime Makefile
runtime/basis/Real frexp.c
Removed: runtime/basis/Real copysign.c isFinite.c isNan.c isNormal.c
nextAfter.c pow.c round.c strtod.c trig.c
Log:
Eliminated a lot of C wrappers for Real.math functions.
When implementing Real32 functions in terms of Real64 functions, moved
the casts from the C runtime library code to the SML basis library
code.
Simplified the real functor to implement
Real.{isFinite,isNan,isNormal} in terms of Real.class. This should
make us more portable andalso ensure that these functions behave well
even on x86's with 80 bit floating point registers, because
Real{32,64}.class is implemented by storing the float or double to
memory and inspecting it there.
Revision Changes Path
1.68 +94 -78 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -r1.67 -r1.68
--- primitive.sml 25 Jul 2003 20:14:46 -0000 1.67
+++ primitive.sml 26 Jul 2003 17:54:18 -0000 1.68
@@ -731,73 +731,6 @@
_import "Ptrace_ptrace4": int * pid * word * word ref -> int;
end
- structure Real32 =
- struct
- type real = Real32.real
-
- structure Math =
- struct
- type real = real
-
- val acos = _prim "Real32_Math_acos": real -> real;
- val asin = _prim "Real32_Math_asin": real -> real;
- val atan = _prim "Real32_Math_atan": real -> real;
- val atan2 = _prim "Real32_Math_atan2": real * real -> real;
- val cos = _prim "Real32_Math_cos": real -> real;
- val cosh = _import "Real32_Math_cosh": real -> real;
- val e = _import "Real32_Math_e": real;
- val exp = _prim "Real32_Math_exp": real -> real;
- val ln = _prim "Real32_Math_ln": real -> real;
- val log10 = _prim "Real32_Math_log10": real -> real;
- val pi = _import "Real32_Math_pi": real;
- val pow = _import "Real32_Math_pow": real * real -> real;
- val sin = _prim "Real32_Math_sin": real -> real;
- val sinh = _import "Real32_Math_sinh": real -> real;
- val sqrt = _prim "Real32_Math_sqrt": real -> real;
- val tan = _prim "Real32_Math_tan": real -> real;
- val tanh = _import "Real32_Math_tanh": real -> real;
- end
-
- val * = _prim "Real32_mul": real * real -> real;
- val *+ = _prim "Real32_muladd": real * real * real -> real;
- val *- = _prim "Real32_mulsub": real * real * real -> real;
- val + = _prim "Real32_add": real * real -> real;
- val - = _prim "Real32_sub": real * real -> real;
- val / = _prim "Real32_div": real * real -> real;
- val < = _prim "Real32_lt": real * real -> bool;
- val <= = _prim "Real32_le": real * real -> bool;
- val == = _prim "Real32_equal": real * real -> bool;
- val > = _prim "Real32_gt": real * real -> bool;
- val >= = _prim "Real32_ge": real * real -> bool;
- val ?= = _prim "Real32_qequal": real * real -> bool;
- val abs = _prim "Real32_abs": real -> real;
- val class = _import "Real32_class": real -> int;
- val copySign = _import "Real32_copysign": real * real -> real;
- val frexp = _import "Real32_frexp": real * int ref -> real;
- val gdtoa =
- _import "Real32_gdtoa": real * int * int * int ref -> cstring;
- val fromInt = _prim "Int32_toReal32": int -> real;
- val isFinite = _import "Real32_isFinite": real -> bool;
- val isNan = _import "Real32_isNan": real -> bool;
- val isNormal = _import "Real32_isNormal": real -> bool;
- val ldexp = _prim "Real32_ldexp": real * int -> real;
- val maxFinite = _import "Real32_maxFinite": real;
- val minNormalPos = _import "Real32_minNormalPos": real;
- val minPos = _import "Real32_minPos": real;
- val modf = _import "Real32_modf": real * real ref -> real;
- val nextAfter = _import "Real32_nextAfter": real * real -> real;
- val round = _prim "Real32_round": real -> real;
- val signBit = _import "Real32_signBit": real -> bool;
- val strto = _import "Real32_strto": nullString -> real;
- val toInt = _prim "Real32_toInt32": real -> int;
- val ~ = _prim "Real32_neg": real -> real;
-
- val fromLarge = _prim "Real64_toReal32": real64 -> real;
- val toLarge = _prim "Real32_toReal64": real -> real64;
- val precision : int = 23
- val radix : int = 2
- end
-
structure Real64 =
struct
type real = Real64.real
@@ -811,18 +744,18 @@
val atan = _prim "Real64_Math_atan": real -> real;
val atan2 = _prim "Real64_Math_atan2": real * real -> real;
val cos = _prim "Real64_Math_cos": real -> real;
- val cosh = _import "Real64_Math_cosh": real -> real;
+ val cosh = _import "cosh": real -> real;
val e = _import "Real64_Math_e": real;
val exp = _prim "Real64_Math_exp": real -> real;
val ln = _prim "Real64_Math_ln": real -> real;
val log10 = _prim "Real64_Math_log10": real -> real;
val pi = _import "Real64_Math_pi": real;
- val pow = _import "Real64_Math_pow": real * real -> real;
+ val pow = _import "pow": real * real -> real;
val sin = _prim "Real64_Math_sin": real -> real;
- val sinh = _import "Real64_Math_sinh": real -> real;
+ val sinh = _import "sinh": real -> real;
val sqrt = _prim "Real64_Math_sqrt": real -> real;
val tan = _prim "Real64_Math_tan": real -> real;
- val tanh = _import "Real64_Math_tanh": real -> real;
+ val tanh = _import "tanh": real -> real;
end
val * = _prim "Real64_mul": real * real -> real;
@@ -839,21 +772,24 @@
val ?= = _prim "Real64_qequal": real * real -> bool;
val abs = _prim "Real64_abs": real -> real;
val class = _import "Real64_class": real -> int;
- val copySign = _import "Real64_copysign": real * real -> real;
+ val copySign = _import "copysign": real * real -> real;
val frexp = _import "Real64_frexp": real * int ref -> real;
val gdtoa =
_import "Real64_gdtoa": real * int * int * int ref -> cstring;
val fromInt = _prim "Int32_toReal64": int -> real;
- val isFinite = _import "Real64_isFinite": real -> bool;
- val isNan = _import "Real64_isNan": real -> bool;
- val isNormal = _import "Real64_isNormal": real -> bool;
- val ldexp = _prim "Real64_ldexp": real * int -> real;
+ val ldexp =
+ if Native.native
+ then _prim "Real64_ldexp": real * int -> real;
+ else _import "ldexp": real * int -> real;
val maxFinite = _import "Real64_maxFinite": real;
val minNormalPos = _import "Real64_minNormalPos": real;
val minPos = _import "Real64_minPos": real;
val modf = _import "Real64_modf": real * real ref -> real;
- val nextAfter = _import "Real64_nextAfter": real * real -> real;
- val round = _prim "Real64_round": real -> real;
+ val nextAfter = _import "nextAfter": real * real -> real;
+ val round =
+ if Native.native
+ then _prim "Real64_round": real -> real;
+ else _import "rint": real -> real;
val signBit = _import "Real64_signBit": real -> bool;
val strto = _import "Real64_strto": nullString -> real;
val toInt = _prim "Real64_toInt32": real -> int;
@@ -865,6 +801,86 @@
val radix : int = 2
end
+ structure Real32 =
+ struct
+ type real = Real32.real
+
+ val precision : int = 23
+ val radix : int = 2
+
+ val fromLarge = _prim "Real64_toReal32": real64 -> real;
+ val toLarge = _prim "Real32_toReal64": real -> real64;
+
+ fun unary (f: Real64.real -> Real64.real) (r: real): real =
+ fromLarge (f (toLarge r))
+
+ fun binary (f: Real64.real * Real64.real -> Real64.real)
+ (r: real, r': real): real =
+ fromLarge (f (toLarge r, toLarge r'))
+
+ structure Math =
+ struct
+ type real = real
+
+ val acos = _prim "Real32_Math_acos": real -> real;
+ val asin = _prim "Real32_Math_asin": real -> real;
+ val atan = _prim "Real32_Math_atan": real -> real;
+ val atan2 = _prim "Real32_Math_atan2": real * real -> real;
+ val cos = _prim "Real32_Math_cos": real -> real;
+ val cosh = unary Real64.Math.cosh
+ val e = _import "Real32_Math_e": real;
+ val exp = _prim "Real32_Math_exp": real -> real;
+ val ln = _prim "Real32_Math_ln": real -> real;
+ val log10 = _prim "Real32_Math_log10": real -> real;
+ val pi = _import "Real32_Math_pi": real;
+ val pow = binary Real64.Math.pow
+ val sin = _prim "Real32_Math_sin": real -> real;
+ val sinh = unary Real64.Math.sinh
+ val sqrt = _prim "Real32_Math_sqrt": real -> real;
+ val tan = _prim "Real32_Math_tan": real -> real;
+ val tanh = unary Real64.Math.tanh
+ end
+
+ val * = _prim "Real32_mul": real * real -> real;
+ val *+ = _prim "Real32_muladd": real * real * real -> real;
+ val *- = _prim "Real32_mulsub": real * real * real -> real;
+ val + = _prim "Real32_add": real * real -> real;
+ val - = _prim "Real32_sub": real * real -> real;
+ val / = _prim "Real32_div": real * real -> real;
+ val < = _prim "Real32_lt": real * real -> bool;
+ val <= = _prim "Real32_le": real * real -> bool;
+ val == = _prim "Real32_equal": real * real -> bool;
+ val > = _prim "Real32_gt": real * real -> bool;
+ val >= = _prim "Real32_ge": real * real -> bool;
+ val ?= = _prim "Real32_qequal": real * real -> bool;
+ val abs = _prim "Real32_abs": real -> real;
+ val class = _import "Real32_class": real -> int;
+ val copySign = _import "copysignf": real * real -> real;
+ fun frexp (r: real, ir: int ref): real =
+ fromLarge (Real64.frexp (toLarge r, ir))
+ val gdtoa =
+ _import "Real32_gdtoa": real * int * int * int ref -> cstring;
+ val fromInt = _prim "Int32_toReal32": int -> real;
+ val ldexp =
+ if Native.native
+ then _prim "Real32_ldexp": real * int -> real;
+ else fn (r, i) => fromLarge (Real64.ldexp (toLarge (r, i)))
+ val maxFinite = _import "Real32_maxFinite": real;
+ val minNormalPos = _import "Real32_minNormalPos": real;
+ val minPos = _import "Real32_minPos": real;
+ val modf = _import "Real32_modf": real * real ref -> real;
+ val nextAfter = _import "nextAfterf": real * real -> real;
+ val round =
+ if Native.native
+ then _prim "Real32_round": real -> real;
+ else _import "rintf": real -> real;
+ val signBit = _import "Real32_signBit": real -> bool;
+ val strto = _import "Real32_strto": nullString -> real;
+ val toInt = _prim "Real32_toInt32": real -> int;
+ val ~ = _prim "Real32_neg": real -> real;
+ end
+
+
structure Ref =
struct
val deref = fn x => _prim "Ref_deref": 'a ref -> 'a; x
1.2 +28 -20 mlton/basis-library/real/real.fun
Index: real.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- real.fun 25 Jul 2003 20:14:46 -0000 1.1
+++ real.fun 26 Jul 2003 17:54:18 -0000 1.2
@@ -18,9 +18,6 @@
val abs = abs
val copySign = copySign
val fromInt = fromInt
- val isFinite = isFinite
- val isNan = isNan
- val isNormal = isNormal
val maxFinite = maxFinite
val minNormalPos = minNormalPos
val minPos = minPos
@@ -39,11 +36,6 @@
val signBit = signBit
val ~ = ~
end
-
- val op ?= =
- if Primitive.MLton.native
- then op ?=
- else fn (r, r') => isNan r orelse isNan r' orelse r == r'
val radix: int = Prim.radix
@@ -94,6 +86,33 @@
else (acos, asin, ln, log10)
end
+
+ (* See runtime/basis/Real.c for the integers returned by class. *)
+ fun class x =
+ case Prim.class x of
+ 0 => NAN
+ | 1 => NAN
+ | 2 => INF
+ | 3 => ZERO
+ | 4 => NORMAL
+ | 5 => SUBNORMAL
+ | _ => raise Fail "Real_class returned bogus integer"
+
+ fun isFinite r =
+ case class r of
+ INF => false
+ | NAN => false
+ | _ => true
+
+ fun isNan r = class r = NAN
+
+ fun isNormal r = class r = NORMAL
+
+ val op ?= =
+ if Primitive.MLton.native
+ then op ?=
+ else fn (r, r') => isNan r orelse isNan r' orelse r == r'
+
val op != = not o op ==
fun min (x, y) = if x < y orelse isNan y then x else y
@@ -129,18 +148,7 @@
end
fun unordered (x, y) = isNan x orelse isNan y
-
- (* See runtime/basis/Real.c for the integers returned by class. *)
- fun class x =
- case Prim.class x of
- 0 => NAN (* QUIET *)
- | 1 => NAN (* SIGNALLING *)
- | 2 => INF
- | 3 => ZERO
- | 4 => NORMAL
- | 5 => SUBNORMAL
- | _ => raise Fail "Primitive.Real.class returned bogus integer"
-
+
val toManExp =
let
val r: int ref = ref 0
1.9 +6 -10 mlton/basis-library/real/real.sig
Index: real.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.sig,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- real.sig 25 Jul 2003 20:14:46 -0000 1.8
+++ real.sig 26 Jul 2003 17:54:18 -0000 1.9
@@ -34,27 +34,23 @@
val abs: real -> real
val class: real -> int
val copySign: real * real -> real
- val frexp: real * int ref -> real;
- val gdtoa: real * int * int * int ref -> Primitive.cstring;
+ val frexp: real * int ref -> real
+ val gdtoa: real * int * int * int ref -> Primitive.cstring
val fromInt: int -> real
- val isFinite: real -> bool
- val isNan: real -> bool
- val isNormal: real -> bool
+ val fromLarge: IEEEReal.rounding_mode -> LargeReal.real -> real
val ldexp: real * int -> real
val maxFinite: real
val minNormalPos: real
val minPos: real
val modf: real * real ref -> real
val nextAfter: real * real -> real
+ val precision: int
+ val radix: int
val round: real -> real
val signBit: real -> bool
val strto: nullString -> real
val toInt: real -> int
-
- val fromLarge: IEEEReal.rounding_mode -> LargeReal.real -> real
- val toLarge: real -> LargeReal.real
- val precision: int
- val radix: int
+ val toLarge: real -> LargeReal.real
end
signature REAL_GLOBAL =
1.11 +0 -8 mlton/include/c-chunk.h
Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- c-chunk.h 25 Jul 2003 20:14:46 -0000 1.10
+++ c-chunk.h 26 Jul 2003 17:54:19 -0000 1.11
@@ -501,20 +501,12 @@
binaryReal(le, <=)
binaryReal(lt, <)
-Real64 ldexp (Real64 x, Int i);
-static inline Real64 Real64_ldexp (Real64 x, Int i) {
- return ldexp (x, i);
-}
-static inline Real32 Real32_ldexp (Real32 x, Int i) {
- return (Real32)(Real64_ldexp ((Real64)x, i));
-}
#define Real32_muladd(x, y, z) ((x) * (y) + (z))
#define Real32_mulsub(x, y, z) ((x) * (y) - (z))
#define Real64_muladd(x, y, z) ((x) * (y) + (z))
#define Real64_mulsub(x, y, z) ((x) * (y) - (z))
#define Real32_neg(x) (-(x))
#define Real64_neg(x) (-(x))
-Real64 Real64_round (Real64 x);
#define Real32_toInt(x) ((Int)(x))
#define Real64_toInt(x) ((Int)(x))
1.70 +0 -16 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- Makefile 25 Jul 2003 20:14:47 -0000 1.69
+++ Makefile 26 Jul 2003 17:54:19 -0000 1.70
@@ -78,20 +78,12 @@
basis/Ptrace/ptrace2.o \
basis/Ptrace/ptrace4.o \
basis/Real/class.o \
- basis/Real/copysign.o \
basis/Real/frexp.o \
basis/Real/gdtoa.o \
- basis/Real/isFinite.o \
- basis/Real/isNan.o \
- basis/Real/isNormal.o \
basis/Real/modf.o \
- basis/Real/nextAfter.o \
- basis/Real/pow.o \
basis/Real/real.o \
- basis/Real/round.o \
basis/Real/signBit.o \
basis/Real/strto.o \
- basis/Real/trig.o \
basis/Stdio.o \
basis/Thread.o \
basis/Time.o \
@@ -250,20 +242,12 @@
basis/Ptrace/ptrace2-gdb.o \
basis/Ptrace/ptrace4-gdb.o \
basis/Real/class-gdb.o \
- basis/Real/copysign-gdb.o \
basis/Real/frexp-gdb.o \
basis/Real/gdtoa-gdb.o \
- basis/Real/isFinite-gdb.o \
- basis/Real/isNan-gdb.o \
- basis/Real/isNormal-gdb.o \
basis/Real/modf-gdb.o \
- basis/Real/nextAfter-gdb.o \
- basis/Real/pow-gdb.o \
basis/Real/real-gdb.o \
- basis/Real/round-gdb.o \
basis/Real/signBit-gdb.o \
basis/Real/strto-gdb.o \
- basis/Real/trig-gdb.o \
basis/Stdio-gdb.o \
basis/Thread-gdb.o \
basis/Time-gdb.o \
1.2 +1 -9 mlton/runtime/basis/Real/frexp.c
Index: frexp.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Real/frexp.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- frexp.c 25 Jul 2003 20:14:48 -0000 1.1
+++ frexp.c 26 Jul 2003 17:54:19 -0000 1.2
@@ -1,15 +1,7 @@
#include <math.h>
#include "mlton-basis.h"
-double frexp(double x, int* exp);
-
-Real32 Real32_frexp(Real32 x, Int *exp) {
- int exp_;
- Real32 res;
- res = (Real32)(frexp((Real64) x, &exp_));
- *exp = exp_;
- return res;
-}
+double frexp (double x, int* exp);
Real64 Real64_frexp(Real64 x, Int *exp) {
int exp_;
-------------------------------------------------------
This SF.Net email sponsored by: Free pre-built ASP.NET sites including
Data Reports, E-commerce, Portals, and Forums are available now.
Download today and enter to win an XBOX or Visual Studio .NET.
http://aspnet.click-url.com/go/psa00100003ave/direct;at.aspnet_072303_01/01
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel