[MLton-commit] r5764
Matthew Fluet
fluet at mlton.org
Wed Jul 11 14:02:29 PDT 2007
Fixed bug in Real<N>.toInt<M>, when M >= N.
When M >= N, then Int<M>.{max,min}Int cannot be exactly represented by
a Real<N>.real. The code for Real<N>.toInt<M> had been successively
generalized from Real64.toInt32 to Real<N>.toInt32 to
Real<N>.toInt<M>. For Real64.toInt32, then Int32.{max,min}Int can be
exactly represented by a Real64.real, and one needs to be careful
about the rounding mode near the min and max.
However, for (say) Real32.toInt32, then Int32.maxInt cannot be exactly
represented by a Real32.real, though Int32.minInt can be exactly
represented by a Real32.real (assuming that Real32.real has radix 2,
yielding a twos complement representation). Furthermore,
Real32.fromInt32 Int32.maxInt can round to a Real32.real value
*larger* than Int32.maxInt. Hence, bounding Real32.toInt32 conversion
by Real32.fromInt32 Int32.maxInt (with rounding mode TO_NEAREST) is
wrong -- it allows an unrepresentable real to be (unsafely) converted
to a bogus integer. The right upper bound is given by
IEEE.withRoundingMode (TO_NEGINF, fn () => fromInt32Unsafe Int32.maxInt)
We also don't need to be careful about rounding mode near the min and
max (since only integers are representable at that magnitude).
----------------------------------------------------------------------
U mlton/trunk/basis-library/real/real.sml
U mlton/trunk/doc/changelog
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/real/real.sml
===================================================================
--- mlton/trunk/basis-library/real/real.sml 2007-07-11 20:34:47 UTC (rev 5763)
+++ mlton/trunk/basis-library/real/real.sml 2007-07-11 21:02:25 UTC (rev 5764)
@@ -592,65 +592,89 @@
fun 'a make {fromIntUnsafe: 'a -> real,
toIntUnsafe: real -> 'a,
other : {maxInt': 'a,
- minInt': 'a}} =
- let
- val maxInt' = #maxInt' other
- val minInt' = #minInt' other
- val maxInt = fromIntUnsafe maxInt'
- val minInt = fromIntUnsafe minInt'
- in
- (fromIntUnsafe,
- fn (m: rounding_mode) => fn x =>
- case class x of
- INF => raise Overflow
- | NAN => raise Domain
- | _ => if minInt <= x
- then if x <= maxInt
+ minInt': 'a,
+ precision': int}} =
+ (fromIntUnsafe,
+ if Int.< (precision, #precision' other)
+ then let
+ val maxInt' = #maxInt' other
+ val minInt' = #minInt' other
+ (* maxInt can't be represented exactly. *)
+ (* minInt can be represented exactly. *)
+ val (maxInt,minInt) =
+ IEEEReal.withRoundingMode
+ (TO_ZERO, fn () => (fromIntUnsafe maxInt',
+ fromIntUnsafe minInt'))
+ in
+ fn (m: rounding_mode) => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN => raise Domain
+ | _ => if minInt <= x andalso x <= maxInt
then toIntUnsafe (roundReal (x, m))
- else if x < maxInt + one
- then (case m of
- TO_NEGINF => maxInt'
- | TO_POSINF => raise Overflow
- | TO_ZERO => maxInt'
- | TO_NEAREST =>
- (* Depends on maxInt being odd. *)
- if x - maxInt >= half
- then raise Overflow
- else maxInt')
- else raise Overflow
- else if x > minInt - one
- then (case m of
- TO_NEGINF => raise Overflow
- | TO_POSINF => minInt'
- | TO_ZERO => minInt'
- | TO_NEAREST =>
- (* Depends on minInt being even. *)
- if x - minInt < ~half
- then raise Overflow
- else minInt')
- else raise Overflow)
- end
+ else raise Overflow
+ end
+ else let
+ val maxInt' = #maxInt' other
+ val minInt' = #minInt' other
+ val maxInt = fromIntUnsafe maxInt'
+ val minInt = fromIntUnsafe minInt'
+ in
+ fn (m: rounding_mode) => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN => raise Domain
+ | _ => if minInt <= x
+ then if x <= maxInt
+ then toIntUnsafe (roundReal (x, m))
+ else if x < maxInt + one
+ then (case m of
+ TO_NEGINF => maxInt'
+ | TO_POSINF => raise Overflow
+ | TO_ZERO => maxInt'
+ | TO_NEAREST =>
+ (* Depends on maxInt being odd. *)
+ if x - maxInt >= half
+ then raise Overflow
+ else maxInt')
+ else raise Overflow
+ else if x > minInt - one
+ then (case m of
+ TO_NEGINF => raise Overflow
+ | TO_POSINF => minInt'
+ | TO_ZERO => minInt'
+ | TO_NEAREST =>
+ (* Depends on minInt being even. *)
+ if x - minInt < ~half
+ then raise Overflow
+ else minInt')
+ else raise Overflow
+ end)
in
val (fromInt8,toInt8) =
make {fromIntUnsafe = R.fromInt8Unsafe,
toIntUnsafe = R.toInt8Unsafe,
other = {maxInt' = Int8.maxInt',
- minInt' = Int8.minInt'}}
+ minInt' = Int8.minInt',
+ precision' = Int8.precision'}}
val (fromInt16,toInt16) =
make {fromIntUnsafe = R.fromInt16Unsafe,
toIntUnsafe = R.toInt16Unsafe,
other = {maxInt' = Int16.maxInt',
- minInt' = Int16.minInt'}}
+ minInt' = Int16.minInt',
+ precision' = Int16.precision'}}
val (fromInt32,toInt32) =
make {fromIntUnsafe = R.fromInt32Unsafe,
toIntUnsafe = R.toInt32Unsafe,
other = {maxInt' = Int32.maxInt',
- minInt' = Int32.minInt'}}
+ minInt' = Int32.minInt',
+ precision' = Int32.precision'}}
val (fromInt64,toInt64) =
make {fromIntUnsafe = R.fromInt64Unsafe,
toIntUnsafe = R.toInt64Unsafe,
other = {maxInt' = Int64.maxInt',
- minInt' = Int64.minInt'}}
+ minInt' = Int64.minInt',
+ precision' = Int64.precision'}}
end
val fromIntInf: IntInf.int -> real =
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2007-07-11 20:34:47 UTC (rev 5763)
+++ mlton/trunk/doc/changelog 2007-07-11 21:02:25 UTC (rev 5764)
@@ -1,5 +1,8 @@
Here are the changes since version 20051202.
+* 2007-07-11
+ - Fixed bug in Real32.toInt.
+
* 2007-07-07
- Updates to bytecode code generator: support for amd64-* targets,
support for profiling (including exception history).
More information about the MLton-commit
mailing list