[MLton-commit] r5766
Matthew Fluet
fluet at mlton.org
Wed Jul 11 21:23:09 PDT 2007
Float to/from unsigned integer conversion primitives were never exercised; added float to/from word conversions
----------------------------------------------------------------------
U mlton/trunk/basis-library/build/sources.mlb
U mlton/trunk/basis-library/integer/num0.sml
U mlton/trunk/basis-library/integer/word.sig
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis-sigs.sml
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/trunk/basis-library/mlton/mlton.sig
U mlton/trunk/basis-library/mlton/mlton.sml
A mlton/trunk/basis-library/mlton/real.sig
U mlton/trunk/basis-library/mlton.mlb
U mlton/trunk/basis-library/primitive/prim-real.sml
U mlton/trunk/basis-library/real/real.sig
U mlton/trunk/basis-library/real/real.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/build/sources.mlb
===================================================================
--- mlton/trunk/basis-library/build/sources.mlb 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/build/sources.mlb 2007-07-12 04:23:01 UTC (rev 5766)
@@ -357,6 +357,7 @@
../mlton/weak.sml
../mlton/finalizable.sig
../mlton/finalizable.sml
+ ../mlton/real.sig
../mlton/word.sig
../mlton/world.sig
../mlton/world.sml
Modified: mlton/trunk/basis-library/integer/num0.sml
===================================================================
--- mlton/trunk/basis-library/integer/num0.sml 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/integer/num0.sml 2007-07-12 04:23:01 UTC (rev 5766)
@@ -57,6 +57,8 @@
val zero: word
val one: word
+ val maxWord': word
+
val div: word * word -> word
val mod: word * word -> word
@@ -84,6 +86,8 @@
val zero = zextdFromWord32 0w0
val one = zextdFromWord32 0w1
+ val maxWord' = notb zero
+
local
fun make f (w, w') =
if Primitive.Controls.safe andalso w' = zero
Modified: mlton/trunk/basis-library/integer/word.sig
===================================================================
--- mlton/trunk/basis-library/integer/word.sig 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/integer/word.sig 2007-07-12 04:23:01 UTC (rev 5766)
@@ -62,6 +62,8 @@
val zero: word
val one: word
+ val maxWord' : word
+
val toWord: word -> Word.word
val toWordX: word -> Word.word
val fromWord: Word.word -> word
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis-sigs.sml
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis-sigs.sml 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis-sigs.sml 2007-07-12 04:23:01 UTC (rev 5766)
@@ -100,6 +100,7 @@
signature MLTON_PROCESS = MLTON_PROCESS
signature MLTON_PROFILE = MLTON_PROFILE
signature MLTON_RANDOM = MLTON_RANDOM
+signature MLTON_REAL = MLTON_REAL
signature MLTON_RLIMIT = MLTON_RLIMIT
signature MLTON_RUSAGE = MLTON_RUSAGE
signature MLTON_SIGNAL = MLTON_SIGNAL
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2007-07-12 04:23:01 UTC (rev 5766)
@@ -325,6 +325,8 @@
sharing type MLton.IntInf.t = IntInf.int
sharing type MLton.Process.pid = Posix.Process.pid
sharing type MLton.ProcEnv.gid = Posix.ProcEnv.gid
+ sharing type MLton.Real32.t = Real32.real
+ sharing type MLton.Real64.t = Real64.real
sharing type MLton.Signal.t = Posix.Signal.signal
sharing type MLton.Word.t = Word.word
sharing type MLton.Word8.t = Word8.word
Modified: mlton/trunk/basis-library/mlton/mlton.sig
===================================================================
--- mlton/trunk/basis-library/mlton/mlton.sig 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/mlton/mlton.sig 2007-07-12 04:23:01 UTC (rev 5766)
@@ -38,12 +38,14 @@
structure Process: MLTON_PROCESS
structure Profile: MLTON_PROFILE
(* structure Ptrace: MLTON_PTRACE *)
- structure Random: MLTON_RANDOM
+ structure Random: MLTON_RANDOM
structure Real32: sig
- val castFromWord: Word32.word -> Real32.real
- val castToWord: Real32.real -> Word32.word
+ include MLTON_REAL
+ val castFromWord: Word32.word -> t
+ val castToWord: t -> Word32.word
end
structure Real64: sig
+ include MLTON_REAL
val castFromWord: Word64.word -> Real64.real
val castToWord: Real64.real -> Word64.word
end
Modified: mlton/trunk/basis-library/mlton/mlton.sml
===================================================================
--- mlton/trunk/basis-library/mlton/mlton.sml 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/mlton/mlton.sml 2007-07-12 04:23:01 UTC (rev 5766)
@@ -60,8 +60,18 @@
(* structure Ptrace = MLtonPtrace *)
structure Profile = MLtonProfile
structure Random = MLtonRandom
-structure Real32 = Primitive.PackReal32
-structure Real64 = Primitive.PackReal64
+structure Real32 =
+ struct
+ open Real32
+ type t = real
+ open Primitive.PackReal32
+ end
+structure Real64 =
+ struct
+ open Real64
+ type t = real
+ open Primitive.PackReal64
+ end
structure Rlimit = MLtonRlimit
structure Rusage = MLtonRusage
structure Signal = MLtonSignal
Added: mlton/trunk/basis-library/mlton/real.sig
===================================================================
--- mlton/trunk/basis-library/mlton/real.sig 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/mlton/real.sig 2007-07-12 04:23:01 UTC (rev 5766)
@@ -0,0 +1,17 @@
+(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature MLTON_REAL =
+ sig
+ type t
+
+ val fromWord: word -> t
+ val fromLargeWord: LargeWord.word -> t
+ val toWord: IEEEReal.rounding_mode -> t -> word
+ val toLargeWord: IEEEReal.rounding_mode -> t -> LargeWord.word
+ end
Modified: mlton/trunk/basis-library/mlton.mlb
===================================================================
--- mlton/trunk/basis-library/mlton.mlb 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/mlton.mlb 2007-07-12 04:23:01 UTC (rev 5766)
@@ -32,6 +32,7 @@
signature MLTON_PROCESS
signature MLTON_PROFILE
signature MLTON_RANDOM
+ signature MLTON_REAL
signature MLTON_RLIMIT
signature MLTON_RUSAGE
signature MLTON_SIGNAL
Modified: mlton/trunk/basis-library/primitive/prim-real.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-real.sml 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/primitive/prim-real.sml 2007-07-12 04:23:01 UTC (rev 5766)
@@ -76,6 +76,12 @@
val fromReal32Unsafe: Primitive.Real32.real -> real
val fromReal64Unsafe: Primitive.Real64.real -> real
+ (* Word to float; depends on rounding mode. *)
+ val fromWord8Unsafe: Primitive.Word8.word -> real
+ val fromWord16Unsafe: Primitive.Word16.word -> real
+ val fromWord32Unsafe: Primitive.Word32.word -> real
+ val fromWord64Unsafe: Primitive.Word64.word -> real
+
(* Float to integer, taking lowbits. *)
val toInt8Unsafe: real -> Primitive.Int8.int
val toInt16Unsafe: real -> Primitive.Int16.int
@@ -85,6 +91,12 @@
(* Float to float; depends on rounding mode. *)
val toReal32Unsafe: real -> Primitive.Real32.real
val toReal64Unsafe: real -> Primitive.Real64.real
+
+ (* Float to word, taking lowbits. *)
+ val toWord8Unsafe: real -> Primitive.Word8.word
+ val toWord16Unsafe: real -> Primitive.Word16.word
+ val toWord32Unsafe: real -> Primitive.Word32.word
+ val toWord64Unsafe: real -> Primitive.Word64.word
end
structure Primitive = struct
@@ -156,6 +168,11 @@
val fromReal32Unsafe = _prim "Real32_rndToReal32": Real32.real -> real;
val fromReal64Unsafe = _prim "Real64_rndToReal32": Real64.real -> real;
+ val fromWord8Unsafe = _prim "WordU8_rndToReal32": Word8.word -> real;
+ val fromWord16Unsafe = _prim "WordU16_rndToReal32": Word16.word -> real;
+ val fromWord32Unsafe = _prim "WordU32_rndToReal32": Word32.word -> real;
+ val fromWord64Unsafe = _prim "WordU64_rndToReal32": Word64.word -> real;
+
val toInt8Unsafe = _prim "Real32_rndToWordS8": real -> Int8.int;
val toInt16Unsafe = _prim "Real32_rndToWordS16": real -> Int16.int;
val toInt32Unsafe = _prim "Real32_rndToWordS32": real -> Int32.int;
@@ -163,6 +180,11 @@
val toReal32Unsafe = _prim "Real32_rndToReal32": real -> Real32.real;
val toReal64Unsafe = _prim "Real32_rndToReal64": real -> Real64.real;
+
+ val toWord8Unsafe = _prim "Real32_rndToWordU8": real -> Word8.word;
+ val toWord16Unsafe = _prim "Real32_rndToWordU16": real -> Word16.word;
+ val toWord32Unsafe = _prim "Real32_rndToWordU32": real -> Word32.word;
+ val toWord64Unsafe = _prim "Real32_rndToWordU64": real -> Word64.word;
end
structure Real32 =
struct
@@ -243,6 +265,11 @@
val fromReal32Unsafe = _prim "Real32_rndToReal64": Real32.real -> real;
val fromReal64Unsafe = _prim "Real64_rndToReal64": Real64.real -> real;
+ val fromWord8Unsafe = _prim "WordU8_rndToReal64": Word8.word -> real;
+ val fromWord16Unsafe = _prim "WordU16_rndToReal64": Word16.word -> real;
+ val fromWord32Unsafe = _prim "WordU32_rndToReal64": Word32.word -> real;
+ val fromWord64Unsafe = _prim "WordU64_rndToReal64": Word64.word -> real;
+
val toInt8Unsafe = _prim "Real64_rndToWordS8": real -> Int8.int;
val toInt16Unsafe = _prim "Real64_rndToWordS16": real -> Int16.int;
val toInt32Unsafe = _prim "Real64_rndToWordS32": real -> Int32.int;
@@ -251,6 +278,11 @@
val toReal32Unsafe = _prim "Real64_rndToReal32": real -> Real32.real;
val toReal64Unsafe = _prim "Real64_rndToReal64": real -> Real64.real;
+ val toWord8Unsafe = _prim "Real64_rndToWordU8": real -> Word8.word;
+ val toWord16Unsafe = _prim "Real64_rndToWordU16": real -> Word16.word;
+ val toWord32Unsafe = _prim "Real64_rndToWordU32": real -> Word32.word;
+ val toWord64Unsafe = _prim "Real64_rndToWordU64": real -> Word64.word;
+
val castFromWord64 = _prim "Word64_castToReal64": Word64.t -> real;
val castToWord64 = _prim "Real64_castToWord64": real -> Word64.t;
end
Modified: mlton/trunk/basis-library/real/real.sig
===================================================================
--- mlton/trunk/basis-library/real/real.sig 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/real/real.sig 2007-07-12 04:23:01 UTC (rev 5766)
@@ -53,6 +53,11 @@
val fromReal32Unsafe: Primitive.Real32.real -> real
val fromReal64Unsafe: Primitive.Real64.real -> real
+ val fromWord8Unsafe: Primitive.Word8.word -> real
+ val fromWord16Unsafe: Primitive.Word16.word -> real
+ val fromWord32Unsafe: Primitive.Word32.word -> real
+ val fromWord64Unsafe: Primitive.Word64.word -> real
+
val toInt8Unsafe: real -> Primitive.Int8.int
val toInt16Unsafe: real -> Primitive.Int16.int
val toInt32Unsafe: real -> Primitive.Int32.int
@@ -60,6 +65,11 @@
val toReal32Unsafe: real -> Primitive.Real32.real
val toReal64Unsafe: real -> Primitive.Real64.real
+
+ val toWord8Unsafe: real -> Primitive.Word8.word
+ val toWord16Unsafe: real -> Primitive.Word16.word
+ val toWord32Unsafe: real -> Primitive.Word32.word
+ val toWord64Unsafe: real -> Primitive.Word64.word
end
signature REAL_GLOBAL =
@@ -140,4 +150,9 @@
sig
include REAL
val realSize: Int.int
+
+ val fromWord: word -> real
+ val fromLargeWord: LargeWord.word -> real
+ val toWord: IEEEReal.rounding_mode -> real -> word
+ val toLargeWord: IEEEReal.rounding_mode -> real -> LargeWord.word
end
Modified: mlton/trunk/basis-library/real/real.sml
===================================================================
--- mlton/trunk/basis-library/real/real.sml 2007-07-12 04:17:17 UTC (rev 5765)
+++ mlton/trunk/basis-library/real/real.sml 2007-07-12 04:23:01 UTC (rev 5766)
@@ -771,6 +771,147 @@
val trunc = toInt TO_ZERO
val round = toInt TO_NEAREST
+ local
+ fun 'a make {fromWordUnsafe: 'a -> real,
+ toWordUnsafe: real -> 'a,
+ other : {maxWord': 'a,
+ wordSize: int,
+ zeroWord: 'a}} =
+ (fromWordUnsafe,
+ if Int.<= (precision, #wordSize other)
+ then let
+ val maxWord' = #maxWord' other
+ (* maxWord can't be represented exactly. *)
+ val maxWord =
+ IEEEReal.withRoundingMode
+ (TO_ZERO, fn () => fromWordUnsafe maxWord')
+ val zeroWord = #zeroWord other
+ in
+ fn (m: rounding_mode) => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN => raise Domain
+ | _ => if zero <= x
+ then if x <= maxWord
+ then toWordUnsafe (roundReal (x, m))
+ else raise Overflow
+ else if x > ~one
+ then (case m of
+ TO_NEGINF => raise Overflow
+ | TO_POSINF => zeroWord
+ | TO_ZERO => zeroWord
+ | TO_NEAREST =>
+ if x < ~half
+ then raise Overflow
+ else zeroWord)
+ else raise Overflow
+ end
+ else let
+ val maxWord' = #maxWord' other
+ val maxWord = fromWordUnsafe maxWord'
+ val zeroWord = #zeroWord other
+ in
+ fn (m: rounding_mode) => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN => raise Domain
+ | _ => if zero <= x
+ then if x <= maxWord
+ then toWordUnsafe (roundReal (x, m))
+ else if x < maxWord + one
+ then (case m of
+ TO_NEGINF => maxWord'
+ | TO_POSINF => raise Overflow
+ | TO_ZERO => maxWord'
+ | TO_NEAREST =>
+ (* Depends on maxWord being odd. *)
+ if x - maxWord >= half
+ then raise Overflow
+ else maxWord')
+ else raise Overflow
+ else if x > ~one
+ then (case m of
+ TO_NEGINF => raise Overflow
+ | TO_POSINF => zeroWord
+ | TO_ZERO => zeroWord
+ | TO_NEAREST =>
+ if x < ~half
+ then raise Overflow
+ else zeroWord)
+ else raise Overflow
+ end)
+ in
+ val (fromWord8,toWord8) =
+ make {fromWordUnsafe = R.fromWord8Unsafe,
+ toWordUnsafe = R.toWord8Unsafe,
+ other = {maxWord' = Word8.maxWord',
+ wordSize = Word8.wordSize,
+ zeroWord = Word8.zero}}
+ val (fromWord16,toWord16) =
+ make {fromWordUnsafe = R.fromWord16Unsafe,
+ toWordUnsafe = R.toWord16Unsafe,
+ other = {maxWord' = Word16.maxWord',
+ wordSize = Word16.wordSize,
+ zeroWord = Word16.zero}}
+ val (fromWord32,toWord32) =
+ make {fromWordUnsafe = R.fromWord32Unsafe,
+ toWordUnsafe = R.toWord32Unsafe,
+ other = {maxWord' = Word32.maxWord',
+ wordSize = Word32.wordSize,
+ zeroWord = Word32.zero}}
+ val (fromWord64,toWord64) =
+ make {fromWordUnsafe = R.fromWord64Unsafe,
+ toWordUnsafe = R.toWord64Unsafe,
+ other = {maxWord' = Word64.maxWord',
+ wordSize = Word64.wordSize,
+ zeroWord = Word64.zero}}
+ end
+
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> real
+ val fWord8 = fromWord8
+ val fWord16 = fromWord16
+ val fWord32 = fromWord32
+ val fWord64 = fromWord64)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> real
+ val fWord8 = fromWord8
+ val fWord16 = fromWord16
+ val fWord32 = fromWord32
+ val fWord64 = fromWord64)
+ in
+ val fromLargeWord = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = rounding_mode -> real -> 'a
+ val fWord8 = toWord8
+ val fWord16 = toWord16
+ val fWord32 = toWord32
+ val fWord64 = toWord64)
+ in
+ val toWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = rounding_mode -> real -> 'a
+ val fWord8 = toWord8
+ val fWord16 = toWord16
+ val fWord32 = toWord32
+ val fWord64 = toWord64)
+ in
+ val toLargeWord = S.f
+ end
+
structure Math =
struct
open Prim.Math
More information about the MLton-commit
mailing list