basis-library/integer/pack-word.sml

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor PackWord (S: sig
  10                         type word
  11                         val wordSize: int
  12                         val isBigEndian: bool
  13                         val subArr: Word8.word array * SeqIndex.int -> word
  14                         val subVec: Word8.word vector * SeqIndex.int -> word
  15                         val update: Word8.word array * SeqIndex.int * word -> unit
  16                         val bswap: word -> word
  17                         val toLarge: word -> LargeWord.word
  18                         val toLargeX: word -> LargeWord.word
  19                         val fromLarge: LargeWord.word -> word
  20                      end): PACK_WORD_EXTRA =
  21 struct
  22
  23 open S
  24
  25 val bytesPerElem = Int.div (wordSize, 8)
  26
  27 fun offset (i, n) =
  28    let
  29       val () =
  30          if Primitive.Controls.safe
  31             andalso (Int.geu (Int.+ (Int.* (bytesPerElem, i),
  32                                      Int.- (bytesPerElem, 1)), n))
  33             then raise Subscript
  34             else ()
  35    in
  36       SeqIndex.fromInt i
  37    end
  38    handle Overflow => raise Subscript
  39
  40 val subArrRev = bswap o subArr
  41 val subVecRev = bswap o subVec
  42 fun updateRev (a, i, w) = update (a, i, bswap w)
  43
  44 val (subA, subV, updA) =
  45    if isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
  46       then (subArr, subVec, update)
  47    else (subArrRev, subVecRev, updateRev)
  48
  49 fun unsafeUpdate (a, i, w) =
  50    let
  51       val i = SeqIndex.fromInt i
  52       val a = Word8Array.toPoly a
  53    in
  54       updA (a, i, fromLarge w)
  55    end
  56
  57 fun update (a, i, w) =
  58    let
  59       val i = offset (i, Word8Array.length a)
  60       val a = Word8Array.toPoly a
  61    in
  62       updA (a, i, fromLarge w)
  63    end
  64
  65 local
  66    fun make (sub, length, toPoly) (av, i) =
  67       let
  68          val i = offset (i, length av)
  69       in
  70          sub (toPoly av, i)
  71       end
  72 in
  73    val subArr = toLarge o (make (subA, Word8Array.length, Word8Array.toPoly))
  74    val subArrX = toLargeX o (make (subA, Word8Array.length, Word8Array.toPoly))
  75    val subVec = toLarge o (make (subV, Word8Vector.length, Word8Vector.toPoly))
  76    val subVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
  77 end
  78
  79 local
  80    fun make (sub, length, toPoly) (av, i) =
  81       let
  82          val i = SeqIndex.fromInt i
  83       in
  84          sub (toPoly av, i)
  85       end
  86 in
  87    val unsafeSubArr = toLarge o (make (subA, Word8Array.length, Word8Array.toPoly))
  88    val unsafeSubArrX = toLargeX o (make (subA, Word8Array.length, Word8Array.toPoly))
  89    val unsafeSubVec = toLarge o (make (subV, Word8Vector.length, Word8Vector.toPoly))
  90    val unsafeSubVecX = toLargeX o (make (subV, Word8Vector.length, Word8Vector.toPoly))
  91 end
  92
  93 end
  94
  95 structure PackWord8Big: PACK_WORD_EXTRA =
  96    PackWord (val isBigEndian = true
  97              open Primitive.PackWord8
  98              open Word8)
  99 structure PackWord8Little: PACK_WORD_EXTRA =
 100    PackWord (val isBigEndian = false
 101              open Primitive.PackWord8
 102              open Word8)
 103 structure PackWord8Host: PACK_WORD_EXTRA =
 104    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 105              open Primitive.PackWord8
 106              open Word8)
 107 structure PackWord16Big: PACK_WORD_EXTRA =
 108    PackWord (val isBigEndian = true
 109              open Primitive.PackWord16
 110              open Word16)
 111 structure PackWord16Little: PACK_WORD_EXTRA =
 112    PackWord (val isBigEndian = false
 113              open Primitive.PackWord16
 114              open Word16)
 115 structure PackWord16Host: PACK_WORD_EXTRA =
 116    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 117              open Primitive.PackWord16
 118              open Word16)
 119 structure PackWord32Big: PACK_WORD_EXTRA =
 120    PackWord (val isBigEndian = true
 121              open Primitive.PackWord32
 122              open Word32)
 123 structure PackWord32Little: PACK_WORD_EXTRA =
 124    PackWord (val isBigEndian = false
 125              open Primitive.PackWord32
 126              open Word32)
 127 structure PackWord32Host: PACK_WORD_EXTRA =
 128    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 129              open Primitive.PackWord32
 130              open Word32)
 131 structure PackWord64Big: PACK_WORD_EXTRA =
 132    PackWord (val isBigEndian = true
 133              open Primitive.PackWord64
 134              open Word64)
 135 structure PackWord64Little: PACK_WORD_EXTRA =
 136    PackWord (val isBigEndian = false
 137              open Primitive.PackWord64
 138              open Word64)
 139 structure PackWord64Host: PACK_WORD_EXTRA =
 140    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 141              open Primitive.PackWord64
 142              open Word64)
 143 local
 144    structure PackWord =
 145       struct
 146          local
 147             structure S =
 148                Word_ChooseWordN
 149                (type 'a t = Word8.word array * SeqIndex.t -> 'a
 150                 val fWord8 = Primitive.PackWord8.subArr
 151                 val fWord16 = Primitive.PackWord16.subArr
 152                 val fWord32 = Primitive.PackWord32.subArr
 153                 val fWord64 = Primitive.PackWord64.subArr)
 154          in
 155             val subArr = S.f
 156          end
 157          local
 158             structure S =
 159                Word_ChooseWordN
 160                (type 'a t = Word8.word vector * SeqIndex.t -> 'a
 161                 val fWord8 = Primitive.PackWord8.subVec
 162                 val fWord16 = Primitive.PackWord16.subVec
 163                 val fWord32 = Primitive.PackWord32.subVec
 164                 val fWord64 = Primitive.PackWord64.subVec)
 165          in
 166             val subVec = S.f
 167          end
 168          local
 169             structure S =
 170                Word_ChooseWordN
 171                (type 'a t = Word8.word array * SeqIndex.t * 'a -> unit
 172                 val fWord8 = Primitive.PackWord8.update
 173                 val fWord16 = Primitive.PackWord16.update
 174                 val fWord32 = Primitive.PackWord32.update
 175                 val fWord64 = Primitive.PackWord64.update)
 176          in
 177             val update = S.f
 178          end
 179       end
 180 in
 181 structure PackWordBig: PACK_WORD_EXTRA =
 182    PackWord (val isBigEndian = true
 183              open PackWord
 184              open Word)
 185 structure PackWordLittle: PACK_WORD_EXTRA =
 186    PackWord (val isBigEndian = false
 187              open PackWord
 188              open Word)
 189 structure PackWordHost: PACK_WORD_EXTRA =
 190    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 191              open PackWord
 192              open Word)
 193 end
 194 local
 195    structure PackLargeWord =
 196       struct
 197          local
 198             structure S =
 199                LargeWord_ChooseWordN
 200                (type 'a t = Word8.word array * SeqIndex.t -> 'a
 201                 val fWord8 = Primitive.PackWord8.subArr
 202                 val fWord16 = Primitive.PackWord16.subArr
 203                 val fWord32 = Primitive.PackWord32.subArr
 204                 val fWord64 = Primitive.PackWord64.subArr)
 205          in
 206             val subArr = S.f
 207          end
 208          local
 209             structure S =
 210                LargeWord_ChooseWordN
 211                (type 'a t = Word8.word vector * SeqIndex.t -> 'a
 212                 val fWord8 = Primitive.PackWord8.subVec
 213                 val fWord16 = Primitive.PackWord16.subVec
 214                 val fWord32 = Primitive.PackWord32.subVec
 215                 val fWord64 = Primitive.PackWord64.subVec)
 216          in
 217             val subVec = S.f
 218          end
 219          local
 220             structure S =
 221                LargeWord_ChooseWordN
 222                (type 'a t = Word8.word array * SeqIndex.t * 'a -> unit
 223                 val fWord8 = Primitive.PackWord8.update
 224                 val fWord16 = Primitive.PackWord16.update
 225                 val fWord32 = Primitive.PackWord32.update
 226                 val fWord64 = Primitive.PackWord64.update)
 227          in
 228             val update = S.f
 229          end
 230       end
 231 in
 232 structure PackLargeWordBig: PACK_WORD_EXTRA =
 233    PackWord (val isBigEndian = true
 234              open PackLargeWord
 235              open LargeWord)
 236 structure PackLargeWordLittle: PACK_WORD_EXTRA =
 237    PackWord (val isBigEndian = false
 238              open PackLargeWord
 239              open LargeWord)
 240 structure PackLargeWordHost: PACK_WORD_EXTRA =
 241    PackWord (val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
 242              open PackLargeWord
 243              open LargeWord)
 244 end