Unsafe Pack{Word,Real}

[Wesley W. Terpstra]

Does anyone have an objection to this patch?

I'd like to be able to do unsafe subscripts with more than just Word8.


[unsafe-pack.patch]

---

Index: basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- basis-library/libs/basis-extra/top-level/basis.sig (revision 7219)
+++ basis-library/libs/basis-extra/top-level/basis.sig (working copy)
@@ -380,6 +380,19 @@
       sharing Unsafe.Word32Vector = Word32Vector
       sharing Unsafe.Word64Array = Word64Array
       sharing Unsafe.Word64Vector = Word64Vector
+      sharing Unsafe.Word64Vector = Word64Vector
+      sharing Unsafe.PackReal32Big = PackReal32Big
+      sharing Unsafe.PackReal32Little = PackReal32Little
+      sharing Unsafe.PackReal64Big = PackReal64Big
+      sharing Unsafe.PackReal64Little = PackReal64Little
+      sharing Unsafe.PackRealBig = PackRealBig
+      sharing Unsafe.PackRealLittle = PackRealLittle
+      sharing Unsafe.PackWord16Big = PackWord16Big
+      sharing Unsafe.PackWord16Little = PackWord16Little
+      sharing Unsafe.PackWord32Big = PackWord32Big
+      sharing Unsafe.PackWord32Little = PackWord32Little
+      sharing Unsafe.PackWord64Big = PackWord64Big
+      sharing Unsafe.PackWord64Little = PackWord64Little
 
       (* ************************************************** *)
       (* ************************************************** *)
Index: basis-library/sml-nj/unsafe.sig
===================================================================
--- basis-library/sml-nj/unsafe.sig (revision 7219)
+++ basis-library/sml-nj/unsafe.sig (working copy)
@@ -79,4 +79,17 @@
       structure Word32Vector: UNSAFE_MONO_VECTOR
       structure Word64Array: UNSAFE_MONO_ARRAY
       structure Word64Vector: UNSAFE_MONO_VECTOR
+      
+      structure PackReal32Big : PACK_REAL
+      structure PackReal32Little : PACK_REAL
+      structure PackReal64Big : PACK_REAL
+      structure PackReal64Little : PACK_REAL
+      structure PackRealBig : PACK_REAL
+      structure PackRealLittle : PACK_REAL
+      structure PackWord16Big : PACK_WORD
+      structure PackWord16Little : PACK_WORD
+      structure PackWord32Big : PACK_WORD
+      structure PackWord32Little : PACK_WORD
+      structure PackWord64Big : PACK_WORD
+      structure PackWord64Little : PACK_WORD
    end
Index: basis-library/sml-nj/unsafe.sml
===================================================================
--- basis-library/sml-nj/unsafe.sml (revision 7219)
+++ basis-library/sml-nj/unsafe.sml (working copy)
@@ -22,6 +22,212 @@
       val sub = unsafeSub
    end
 
+functor PackWord (S: sig
+                        type word
+                        val wordSize: int
+                        val isBigEndian: bool
+                        val subArr: Word8.word array * SeqIndex.int -> word
+                        val subVec: Word8.word vector * SeqIndex.int -> word
+                        val update: Word8.word array * SeqIndex.int * word -> unit
+                        val bswap: word -> word
+                        val toLarge: word -> LargeWord.word
+                        val toLargeX: word -> LargeWord.word
+                        val fromLarge: LargeWord.word -> word
+                     end): PACK_WORD =
+struct
+
+open S
+
+val bytesPerElem = Int.div (wordSize, 8)
+
+val subArrRev = bswap o subArr
+val subVecRev = bswap o subVec
+fun updateRev (a, i, w) = update (a, i, bswap w)
+
+val (subA, subV, updA) =
+   if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+      then (subArr, subVec, update)
+   else (subArrRev, subVecRev, updateRev)
+
+fun update (a, i, w) =
+   let
+      val i = SeqIndex.fromInt i
+      val a = Word8Array.toPoly a
+   in
+      updA (a, i, fromLarge w)
+   end
+
+local
+   fun make (sub, length, toPoly) (av, i) =
+      let
+         val i = SeqIndex.fromInt i
+      in
+         sub (toPoly av, i)
+      end
+in
+   val subArr = toLarge o (make (subA, Word8Array.length, Word8Array.toPoly))
+   val subArrX = toLargeX o (make (subA, Word8Array.length, Word8Array.toPoly))
+   val subVec = toLarge o (make (subV, Word8Vector.length, Word8Vector.toPoly))
+   val subVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
+end
+
+end
+
+functor PackReal (S: sig
+                        type real
+                        val realSize: int
+                        val isBigEndian: bool
+                        val subArr: Word8.word array * SeqIndex.int -> real
+                        val subVec: Word8.word vector * SeqIndex.int -> real
+                        val update: Word8.word array * SeqIndex.int * real -> unit
+                        val subArrRev: Word8.word array * SeqIndex.int -> real
+                        val subVecRev: Word8.word vector * SeqIndex.int -> real
+                        val updateRev: Word8.word array * SeqIndex.int * real -> unit
+                     end): PACK_REAL =
+struct
+
+open S
+
+val bytesPerElem = Int.div (realSize, 8)
+
+val (subA, subV, updA) =
+   if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+      then (subArr, subVec, update)
+   else (subArrRev, subVecRev, updateRev)
+
+fun update (a, i, r) =
+   let
+      val i = SeqIndex.fromInt i
+      val a = Word8Array.toPoly a
+   in
+      updA (a, i, r)
+   end
+
+local
+   fun make (sub, length, toPoly) (av, i) =
+      let
+         val i = SeqIndex.fromInt i
+      in
+         sub (toPoly av, i)
+      end
+in
+   val subArr = make (subA, Word8Array.length, Word8Array.toPoly)
+   val subVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
+end
+
+fun toBytes (r: real): Word8Vector.vector =
+   let
+      val a = Array.arrayUninit bytesPerElem
+   in
+      (updA (a, 0, r)
+       ; Word8Vector.fromPoly (Array.vector a))
+   end
+
+fun fromBytes v = subVec (v, 0)
+
+end
+
+functor PackRealArg (S: sig
+                           type real
+                           type word
+                           val subArr: Word8.word array * SeqIndex.int -> word
+                           val subVec: Word8.word vector * SeqIndex.int -> word
+                           val update: Word8.word array * SeqIndex.int * word -> unit
+                           val bswap: word -> word
+                           val castFromWord: word -> real
+                           val castToWord: real -> word
+                        end) =
+struct
+
+open S
+
+val subArrRev = castFromWord o bswap o subArr
+val subVecRev = castFromWord o bswap o subVec
+fun updateRev (a, i, r) = update (a, i, bswap (castToWord r))
+
+val subArr = castFromWord o subArr
+val subVec = castFromWord o subVec
+val update = fn (a, i, r) => update (a, i, castToWord r)
+
+end
+
+structure PackReal32Arg =
+   PackRealArg (open Primitive.PackReal32
+                open Primitive.PackWord32
+                val bswap = Word32.bswap)
+structure PackReal64Arg =
+   PackRealArg (open Primitive.PackReal64
+                open Primitive.PackWord64
+                val bswap = Word64.bswap)
+
+structure PackRealArg =
+   struct
+      type real = Real.real
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = int
+             val fReal32 = Real32.realSize
+             val fReal64 = Real64.realSize)
+      in
+         val realSize = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word array * SeqIndex.int -> 'a
+             val fReal32 = PackReal32Arg.subArr
+             val fReal64 = PackReal64Arg.subArr)
+      in
+         val subArr = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word vector * SeqIndex.int -> 'a
+             val fReal32 = PackReal32Arg.subVec
+             val fReal64 = PackReal64Arg.subVec)
+      in
+         val subVec = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word array * SeqIndex.int * 'a -> unit
+             val fReal32 = PackReal32Arg.update
+             val fReal64 = PackReal64Arg.update)
+      in
+         val update = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word array * SeqIndex.int -> 'a
+             val fReal32 = PackReal32Arg.subArrRev
+             val fReal64 = PackReal64Arg.subArrRev)
+      in
+         val subArrRev = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word vector * SeqIndex.int -> 'a
+             val fReal32 = PackReal32Arg.subVecRev
+             val fReal64 = PackReal64Arg.subVecRev)
+      in
+         val subVecRev = S.f
+      end
+      local
+         structure S =
+            Real_ChooseRealN
+            (type 'a t = Word8.word array * SeqIndex.int * 'a -> unit
+             val fReal32 = PackReal32Arg.updateRev
+             val fReal64 = PackReal64Arg.updateRev)
+      in
+         val updateRev = S.f
+      end
+   end
+
 (* This is here so that the code generated by Lex and Yacc will work. *)
 structure Unsafe: UNSAFE =
    struct
@@ -73,4 +279,69 @@
       structure Word32Vector = UnsafeMonoVector (Word32Vector)
       structure Word64Array = UnsafeMonoArray (Word64Array)
       structure Word64Vector = UnsafeMonoVector (Word64Vector)
+      
+      structure PackWord8Big: PACK_WORD =
+         PackWord (val isBigEndian = true
+                   open Primitive.PackWord8
+                   open Word8)
+      structure PackWord8Little: PACK_WORD =
+         PackWord (val isBigEndian = false
+                   open Primitive.PackWord8
+                   open Word8)
+      structure PackWord16Big: PACK_WORD =
+         PackWord (val isBigEndian = true
+                   open Primitive.PackWord16
+                   open Word16)
+      structure PackWord16Little: PACK_WORD =
+         PackWord (val isBigEndian = false
+                   open Primitive.PackWord16
+                   open Word16)
+      structure PackWord32Big: PACK_WORD =
+         PackWord (val isBigEndian = true
+                   open Primitive.PackWord32
+                   open Word32)
+      structure PackWord32Little: PACK_WORD =
+         PackWord (val isBigEndian = false
+                   open Primitive.PackWord32
+                   open Word32)
+      structure PackWord64Big: PACK_WORD =
+         PackWord (val isBigEndian = true
+                   open Primitive.PackWord64
+                   open Word64)
+      structure PackWord64Little: PACK_WORD =
+         PackWord (val isBigEndian = false
+                   open Primitive.PackWord64
+                   open Word64)
+      structure PackRealBig: PACK_REAL =
+         PackReal (open Real32
+                   open PackReal32Arg
+                   val isBigEndian = true)
+      structure PackRealLittle: PACK_REAL =
+         PackReal (open Real32
+                   open PackReal32Arg
+                   val isBigEndian = false)
+      structure PackReal32Big: PACK_REAL =
+         PackReal (open Real32
+                   open PackReal32Arg
+                   val isBigEndian = true)
+      structure PackReal32Little: PACK_REAL =
+         PackReal (open Real32
+                   open PackReal32Arg
+                   val isBigEndian = false)
+      structure PackReal64Big: PACK_REAL =
+         PackReal (open Real64
+                   open PackReal64Arg
+                   val isBigEndian = true)
+      structure PackReal64Little: PACK_REAL =
+         PackReal (open Real64
+                   open PackReal64Arg
+                   val isBigEndian = false)
+      structure PackRealBig: PACK_REAL =
+         PackReal (open Real
+                   open PackRealArg
+                   val isBigEndian = true)
+      structure PackRealLittle: PACK_REAL =
+         PackReal (open Real
+                   open PackRealArg
+                   val isBigEndian = false)
    end

---

_______________________________________________
MLton mailing list
MLton@...
http://mlton.org/mailman/listinfo/mlton

[Matthew Fluet-3]

On Thu, 20 Aug 2009, Wesley W. Terpstra wrote:
> Does anyone have an objection to this patch?

The concept is fine, but the implementation ends up duplicating
significant functionality from the PACK_{REAL,WORD} structures.  It might
be better to work similar to the way the UnsafeMono{Array,Vector} functors
work --- rebind elements of an _EXTRA structure:

   functor UnsafePackWord (PW: PACK_WORD_EXTRA) : PACK_WORD =
     structure
       open PW
       val subVec = unsafeSubVec
       val subVecX = unsafeSubVecX
       val subArr = unsafeSubArr
       val subArrX = unsafeSubArrX
       val update = unsafeUpdate
     end

Now, in the original PackWord functor bind the unsafe versions of the
functions to unsafe* and use them in the safe versions.

_______________________________________________
MLton mailing list
MLton@...
http://mlton.org/mailman/listinfo/mlton

[Wesley W. Terpstra]

On Fri, Aug 21, 2009 at 2:11 PM, Matthew Fluet <fluet@...> wrote:

The concept is fine, but... it might be better to ... rebind elements of an _EXTRA structure.

Revised and committed.


_______________________________________________
MLton mailing list
MLton@...
http://mlton.org/mailman/listinfo/mlton