[MLton-commit] r4411

[Matthew Fluet]

Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library specification
----------------------------------------------------------------------

U   mlton/trunk/basis-library/real/pack-real.sml
U   mlton/trunk/doc/changelog
A   mlton/trunk/regression/pack-real.2.ok
A   mlton/trunk/regression/pack-real.2.sml

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/real/pack-real.sml
===================================================================
--- mlton/trunk/basis-library/real/pack-real.sml	2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/basis-library/real/pack-real.sml	2006-04-25 16:42:23 UTC (rev 4411)
@@ -24,15 +24,19 @@
       then (subVec, update)
    else (subVecRev, updateRev)
 
-fun check (size, i) =
-   if Int.< (i, 0) orelse Int.> (i, size -? bytesPerElem) then
-      raise Subscript
-   else
-      ()
+fun offset (size, i) =
+   let
+      val off = Int.* (bytesPerElem, i)
+   in
+      if Int.< (i, 0) orelse Int.> (off, size -? bytesPerElem) 
+         then raise Subscript
+         else off
+   end
+   handle Overflow => raise Subscript
 
 fun update (a, i, r) =
    let
-      val () = check (Word8Array.length a, i)
+      val i = offset (Word8Array.length a, i)
       val a = Word8Array.toPoly a
    in
       up (a, i, r)
@@ -48,7 +52,7 @@
 
 fun subVec (v, i) =
    let
-      val () = check (Word8Vector.length v, i)
+      val i = offset (Word8Vector.length v, i)
       val v = Word8Vector.toPoly v
    in
       sub (v, i)

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/doc/changelog	2006-04-25 16:42:23 UTC (rev 4411)
@@ -1,5 +1,9 @@
 Here are the changes since version 20051202.
 
+* 2006-04-25
+  - Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library
+    specification. 
+	
 * 2006-04-19
   - Fixed a bug in MLton.share that could cause a segfault.
 

Added: mlton/trunk/regression/pack-real.2.ok
===================================================================
--- mlton/trunk/regression/pack-real.2.ok	2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/regression/pack-real.2.ok	2006-04-25 16:42:23 UTC (rev 4411)
@@ -0,0 +1,4 @@
+576.105263158
+576.105263158
+9.93985099471E~242
+9.93985099471E~242

Added: mlton/trunk/regression/pack-real.2.sml
===================================================================
--- mlton/trunk/regression/pack-real.2.sml	2006-04-25 15:28:59 UTC (rev 4410)
+++ mlton/trunk/regression/pack-real.2.sml	2006-04-25 16:42:23 UTC (rev 4411)
@@ -0,0 +1,15 @@
+
+val v =
+   Word8Vector.fromList
+   [0wx0D,0wxE5,0wx35,0wx94,0wxD7,0wx00,0wx82,0wx40,
+    0wx0D,0wxE5,0wx35,0wx94,0wxD7,0wx00,0wx82,0wx40]
+
+val r = PackReal64Little.subVec(v, 0)
+val () = print (concat [Real64.toString r, "\n"])
+val r = PackReal64Little.subVec(v, 1)
+val () = print (concat [Real64.toString r, "\n"])
+
+val r = PackReal64Big.subVec(v, 0)
+val () = print (concat [Real64.toString r, "\n"])
+val r = PackReal64Big.subVec(v, 1)
+val () = print (concat [Real64.toString r, "\n"])