[MLton-commit] r7221
Wesley Terpstra
wesley at mlton.org
Fri Aug 21 05:47:56 PDT 2009
Add support for Unsafe subscripting using Pack{Word,Real} to unsafe.mlb.
These are available as Unsafe.Pack{Word,Real}{16,32,64}{Big,Little}.
The implementation adds unsafe* operations to a new PACK_WORD_EXTRA signature.
These are then rebound to a normal PACK_WORD signature in sml-nj/unsafe.sml.
----------------------------------------------------------------------
U mlton/trunk/basis-library/integer/pack-word.sig
U mlton/trunk/basis-library/integer/pack-word.sml
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/trunk/basis-library/real/pack-real.sig
U mlton/trunk/basis-library/real/pack-real.sml
U mlton/trunk/basis-library/sml-nj/unsafe.sig
U mlton/trunk/basis-library/sml-nj/unsafe.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/integer/pack-word.sig
===================================================================
--- mlton/trunk/basis-library/integer/pack-word.sig 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/integer/pack-word.sig 2009-08-21 12:47:54 UTC (rev 7221)
@@ -8,3 +8,13 @@
val subVecX: Word8Vector.vector * int -> LargeWord.word
val update: Word8Array.array * int * LargeWord.word -> unit
end
+
+signature PACK_WORD_EXTRA =
+ sig
+ include PACK_WORD
+ val unsafeSubArr: Word8Array.array * int -> LargeWord.word
+ val unsafeSubArrX: Word8Array.array * int -> LargeWord.word
+ val unsafeSubVec: Word8Vector.vector * int -> LargeWord.word
+ val unsafeSubVecX: Word8Vector.vector * int -> LargeWord.word
+ val unsafeUpdate: Word8Array.array * int * LargeWord.word -> unit
+ end
Modified: mlton/trunk/basis-library/integer/pack-word.sml
===================================================================
--- mlton/trunk/basis-library/integer/pack-word.sml 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/integer/pack-word.sml 2009-08-21 12:47:54 UTC (rev 7221)
@@ -17,7 +17,7 @@
val toLarge: word -> LargeWord.word
val toLargeX: word -> LargeWord.word
val fromLarge: LargeWord.word -> word
- end): PACK_WORD =
+ end): PACK_WORD_EXTRA =
struct
open S
@@ -46,6 +46,14 @@
then (subArr, subVec, update)
else (subArrRev, subVecRev, updateRev)
+fun unsafeUpdate (a, i, w) =
+ let
+ val i = SeqIndex.fromInt i
+ val a = Word8Array.toPoly a
+ in
+ updA (a, i, fromLarge w)
+ end
+
fun update (a, i, w) =
let
val i = offset (i, Word8Array.length a)
@@ -68,53 +76,67 @@
val subVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
end
+local
+ fun make (sub, length, toPoly) (av, i) =
+ let
+ val i = SeqIndex.fromInt i
+ in
+ sub (toPoly av, i)
+ end
+in
+ val unsafeSubArr = toLarge o (make (subA, Word8Array.length, Word8Array.toPoly))
+ val unsafeSubArrX = toLargeX o (make (subA, Word8Array.length, Word8Array.toPoly))
+ val unsafeSubVec = toLarge o (make (subV, Word8Vector.length, Word8Vector.toPoly))
+ val unsafeSubVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
end
-structure PackWord8Big: PACK_WORD =
+end
+
+structure PackWord8Big: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open Primitive.PackWord8
open Word8)
-structure PackWord8Little: PACK_WORD =
+structure PackWord8Little: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open Primitive.PackWord8
open Word8)
-structure PackWord8Host: PACK_WORD =
+structure PackWord8Host: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord8
open Word8)
-structure PackWord16Big: PACK_WORD =
+structure PackWord16Big: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open Primitive.PackWord16
open Word16)
-structure PackWord16Little: PACK_WORD =
+structure PackWord16Little: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open Primitive.PackWord16
open Word16)
-structure PackWord16Host: PACK_WORD =
+structure PackWord16Host: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord16
open Word16)
-structure PackWord32Big: PACK_WORD =
+structure PackWord32Big: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open Primitive.PackWord32
open Word32)
-structure PackWord32Little: PACK_WORD =
+structure PackWord32Little: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open Primitive.PackWord32
open Word32)
-structure PackWord32Host: PACK_WORD =
+structure PackWord32Host: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord32
open Word32)
-structure PackWord64Big: PACK_WORD =
+structure PackWord64Big: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open Primitive.PackWord64
open Word64)
-structure PackWord64Little: PACK_WORD =
+structure PackWord64Little: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open Primitive.PackWord64
open Word64)
-structure PackWord64Host: PACK_WORD =
+structure PackWord64Host: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open Primitive.PackWord64
open Word64)
@@ -156,15 +178,15 @@
end
end
in
-structure PackWordBig: PACK_WORD =
+structure PackWordBig: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open PackWord
open Word)
-structure PackWordLittle: PACK_WORD =
+structure PackWordLittle: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open PackWord
open Word)
-structure PackWordHost: PACK_WORD =
+structure PackWordHost: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open PackWord
open Word)
@@ -207,15 +229,15 @@
end
end
in
-structure PackLargeWordBig: PACK_WORD =
+structure PackLargeWordBig: PACK_WORD_EXTRA =
PackWord (val isBigEndian = true
open PackLargeWord
open LargeWord)
-structure PackLargeWordLittle: PACK_WORD =
+structure PackLargeWordLittle: PACK_WORD_EXTRA =
PackWord (val isBigEndian = false
open PackLargeWord
open LargeWord)
-structure PackLargeWordHost: PACK_WORD =
+structure PackLargeWordHost: PACK_WORD_EXTRA =
PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
open PackLargeWord
open LargeWord)
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2009-08-21 12:47:54 UTC (rev 7221)
@@ -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
(* ************************************************** *)
(* ************************************************** *)
Modified: mlton/trunk/basis-library/real/pack-real.sig
===================================================================
--- mlton/trunk/basis-library/real/pack-real.sig 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/real/pack-real.sig 2009-08-21 12:47:54 UTC (rev 7221)
@@ -10,3 +10,11 @@
val subArr: Word8Array.array * int -> real
val update: Word8Array.array * int * real -> unit
end
+
+signature PACK_REAL_EXTRA =
+ sig
+ include PACK_REAL
+ val unsafeSubVec: Word8Vector.vector * int -> real
+ val unsafeSubArr: Word8Array.array * int -> real
+ val unsafeUpdate: Word8Array.array * int * real -> unit
+ end
Modified: mlton/trunk/basis-library/real/pack-real.sml
===================================================================
--- mlton/trunk/basis-library/real/pack-real.sml 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/real/pack-real.sml 2009-08-21 12:47:54 UTC (rev 7221)
@@ -183,7 +183,7 @@
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 =
+ end): PACK_REAL_EXTRA =
struct
open S
@@ -217,6 +217,14 @@
updA (a, i, r)
end
+fun unsafeUpdate (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
@@ -229,6 +237,18 @@
val subVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
end
+local
+ fun make (sub, length, toPoly) (av, i) =
+ let
+ val i = SeqIndex.fromInt i
+ in
+ sub (toPoly av, i)
+ end
+in
+ val unsafeSubArr = make (subA, Word8Array.length, Word8Array.toPoly)
+ val unsafeSubVec = make (subV, Word8Vector.length, Word8Vector.toPoly)
+end
+
fun toBytes (r: real): Word8Vector.vector =
let
val a = Array.arrayUninit bytesPerElem
@@ -241,51 +261,51 @@
end
-structure PackReal32Big: PACK_REAL =
+structure PackReal32Big: PACK_REAL_EXTRA =
PackReal (open Real32
open PackReal32Arg
val isBigEndian = true)
-structure PackReal32Little: PACK_REAL =
+structure PackReal32Little: PACK_REAL_EXTRA =
PackReal (open Real32
open PackReal32Arg
val isBigEndian = false)
-structure PackReal32Host: PACK_REAL =
+structure PackReal32Host: PACK_REAL_EXTRA =
PackReal (open Real32
open PackReal32Arg
val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)
-structure PackReal64Big: PACK_REAL =
+structure PackReal64Big: PACK_REAL_EXTRA =
PackReal (open Real64
open PackReal64Arg
val isBigEndian = true)
-structure PackReal64Little: PACK_REAL =
+structure PackReal64Little: PACK_REAL_EXTRA =
PackReal (open Real64
open PackReal64Arg
val isBigEndian = false)
-structure PackReal64Host: PACK_REAL =
+structure PackReal64Host: PACK_REAL_EXTRA =
PackReal (open Real64
open PackReal64Arg
val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)
-structure PackRealBig: PACK_REAL =
+structure PackRealBig: PACK_REAL_EXTRA =
PackReal (open Real
open PackRealArg
val isBigEndian = true)
-structure PackRealLittle: PACK_REAL =
+structure PackRealLittle: PACK_REAL_EXTRA =
PackReal (open Real
open PackRealArg
val isBigEndian = false)
-structure PackRealHost: PACK_REAL =
+structure PackRealHost: PACK_REAL_EXTRA =
PackReal (open Real
open PackRealArg
val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)
-structure PackLargeRealBig: PACK_REAL =
+structure PackLargeRealBig: PACK_REAL_EXTRA =
PackReal (open LargeReal
open PackLargeRealArg
val isBigEndian = true)
-structure PackLargeRealLittle: PACK_REAL =
+structure PackLargeRealLittle: PACK_REAL_EXTRA =
PackReal (open LargeReal
open PackLargeRealArg
val isBigEndian = false)
-structure PackLargeRealHost: PACK_REAL =
+structure PackLargeRealHost: PACK_REAL_EXTRA =
PackReal (open LargeReal
open PackLargeRealArg
val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian)
Modified: mlton/trunk/basis-library/sml-nj/unsafe.sig
===================================================================
--- mlton/trunk/basis-library/sml-nj/unsafe.sig 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/sml-nj/unsafe.sig 2009-08-21 12:47:54 UTC (rev 7221)
@@ -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
Modified: mlton/trunk/basis-library/sml-nj/unsafe.sml
===================================================================
--- mlton/trunk/basis-library/sml-nj/unsafe.sml 2009-08-20 13:40:52 UTC (rev 7220)
+++ mlton/trunk/basis-library/sml-nj/unsafe.sml 2009-08-21 12:47:54 UTC (rev 7221)
@@ -22,6 +22,24 @@
val sub = unsafeSub
end
+functor UnsafePackWord(PW : PACK_WORD_EXTRA) : PACK_WORD =
+ struct
+ open PW
+ val subVec = unsafeSubVec
+ val subVecX = unsafeSubVecX
+ val subArr = unsafeSubArr
+ val subArrX = unsafeSubArrX
+ val update = unsafeUpdate
+ end
+
+functor UnsafePackReal(PW : PACK_REAL_EXTRA) : PACK_REAL =
+ struct
+ open PW
+ val subVec = unsafeSubVec
+ val subArr = unsafeSubArr
+ val update = unsafeUpdate
+ end
+
(* This is here so that the code generated by Lex and Yacc will work. *)
structure Unsafe: UNSAFE =
struct
@@ -73,4 +91,16 @@
structure Word32Vector = UnsafeMonoVector (Word32Vector)
structure Word64Array = UnsafeMonoArray (Word64Array)
structure Word64Vector = UnsafeMonoVector (Word64Vector)
+ structure PackReal32Big = UnsafePackReal(PackReal32Big)
+ structure PackReal32Little = UnsafePackReal(PackReal32Little)
+ structure PackReal64Big = UnsafePackReal(PackReal64Big)
+ structure PackReal64Little = UnsafePackReal(PackReal64Little)
+ structure PackRealBig = UnsafePackReal(PackRealBig)
+ structure PackRealLittle = UnsafePackReal(PackRealLittle)
+ structure PackWord16Big = UnsafePackWord(PackWord16Big)
+ structure PackWord16Little = UnsafePackWord(PackWord16Little)
+ structure PackWord32Big = UnsafePackWord(PackWord32Big)
+ structure PackWord32Little = UnsafePackWord(PackWord32Little)
+ structure PackWord64Big = UnsafePackWord(PackWord64Big)
+ structure PackWord64Little = UnsafePackWord(PackWord64Little)
end
More information about the MLton-commit
mailing list