1 (* Copyright (C
) 2017 Matthew Fluet
.
2 * Copyright (C
) 1999-2007 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
4 * Copyright (C
) 1997-2000 NEC Research Institute
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 functor PackRealArg (S
: sig
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 castFromWord
: word -> real
18 val castToWord
: real -> word
24 val subArrRev
= castFromWord
o bswap
o subArr
25 val subVecRev
= castFromWord
o bswap
o subVec
26 fun updateRev (a
, i
, r
) = update (a
, i
, bswap (castToWord r
))
28 val subArr
= castFromWord
o subArr
29 val subVec
= castFromWord
o subVec
30 val update
= fn (a
, i
, r
) => update (a
, i
, castToWord r
)
34 structure PackReal32Arg
=
35 PackRealArg (open Primitive
.PackReal32
36 open Primitive
.PackWord32
37 val bswap
= Word32
.bswap
)
38 structure PackReal64Arg
=
39 PackRealArg (open Primitive
.PackReal64
40 open Primitive
.PackWord64
41 val bswap
= Word64
.bswap
)
42 structure PackRealArg
=
49 val fReal32
= Real32
.realSize
50 val fReal64
= Real64
.realSize
)
57 (type 'a t
= Word8.word array
* SeqIndex
.int -> 'a
58 val fReal32
= PackReal32Arg
.subArr
59 val fReal64
= PackReal64Arg
.subArr
)
66 (type 'a t
= Word8.word vector
* SeqIndex
.int -> 'a
67 val fReal32
= PackReal32Arg
.subVec
68 val fReal64
= PackReal64Arg
.subVec
)
75 (type 'a t
= Word8.word array
* SeqIndex
.int * 'a
-> unit
76 val fReal32
= PackReal32Arg
.update
77 val fReal64
= PackReal64Arg
.update
)
84 (type 'a t
= Word8.word array
* SeqIndex
.int -> 'a
85 val fReal32
= PackReal32Arg
.subArrRev
86 val fReal64
= PackReal64Arg
.subArrRev
)
93 (type 'a t
= Word8.word vector
* SeqIndex
.int -> 'a
94 val fReal32
= PackReal32Arg
.subVecRev
95 val fReal64
= PackReal64Arg
.subVecRev
)
102 (type 'a t
= Word8.word array
* SeqIndex
.int * 'a
-> unit
103 val fReal32
= PackReal32Arg
.updateRev
104 val fReal64
= PackReal64Arg
.updateRev
)
109 structure PackLargeRealArg
=
111 type real = LargeReal
.real
114 LargeReal_ChooseRealN
116 val fReal32
= Real32
.realSize
117 val fReal64
= Real64
.realSize
)
123 LargeReal_ChooseRealN
124 (type 'a t
= Word8.word array
* SeqIndex
.int -> 'a
125 val fReal32
= PackReal32Arg
.subArr
126 val fReal64
= PackReal64Arg
.subArr
)
132 LargeReal_ChooseRealN
133 (type 'a t
= Word8.word vector
* SeqIndex
.int -> 'a
134 val fReal32
= PackReal32Arg
.subVec
135 val fReal64
= PackReal64Arg
.subVec
)
141 LargeReal_ChooseRealN
142 (type 'a t
= Word8.word array
* SeqIndex
.int * 'a
-> unit
143 val fReal32
= PackReal32Arg
.update
144 val fReal64
= PackReal64Arg
.update
)
150 LargeReal_ChooseRealN
151 (type 'a t
= Word8.word array
* SeqIndex
.int -> 'a
152 val fReal32
= PackReal32Arg
.subArrRev
153 val fReal64
= PackReal64Arg
.subArrRev
)
159 LargeReal_ChooseRealN
160 (type 'a t
= Word8.word vector
* SeqIndex
.int -> 'a
161 val fReal32
= PackReal32Arg
.subVecRev
162 val fReal64
= PackReal64Arg
.subVecRev
)
168 LargeReal_ChooseRealN
169 (type 'a t
= Word8.word array
* SeqIndex
.int * 'a
-> unit
170 val fReal32
= PackReal32Arg
.updateRev
171 val fReal64
= PackReal64Arg
.updateRev
)
177 functor PackReal (S
: sig
180 val isBigEndian
: bool
181 val subArr
: Word8.word array
* SeqIndex
.int -> real
182 val subVec
: Word8.word vector
* SeqIndex
.int -> real
183 val update
: Word8.word array
* SeqIndex
.int * real -> unit
184 val subArrRev
: Word8.word array
* SeqIndex
.int -> real
185 val subVecRev
: Word8.word vector
* SeqIndex
.int -> real
186 val updateRev
: Word8.word array
* SeqIndex
.int * real -> unit
187 end): PACK_REAL_EXTRA
=
192 val bytesPerElem
= Int.div (realSize
, 8)
196 val i
' = Int.* (bytesPerElem
, i
)
198 if Primitive
.Controls
.safe
199 andalso (Int.geu (Int.+ (i
', Int.- (bytesPerElem
, 1)), n
))
205 handle Overflow
=> raise Subscript
208 val (subA
, subV
, updA
) =
209 if isBigEndian
= Primitive
.MLton
.Platform
.Arch
.hostIsBigEndian
210 then (subArr
, subVec
, update
)
211 else (subArrRev
, subVecRev
, updateRev
)
213 fun update (a
, i
, r
) =
215 val i
= offset (i
, Word8Array
.length a
)
216 val a
= Word8Array
.toPoly a
221 fun unsafeUpdate (a
, i
, r
) =
223 val i
= SeqIndex
.fromInt i
224 val a
= Word8Array
.toPoly a
230 fun make (sub
, length
, toPoly
) (av
, i
) =
232 val i
= offset (i
, length av
)
237 val subArr
= make (subA
, Word8Array
.length
, Word8Array
.toPoly
)
238 val subVec
= make (subV
, Word8Vector
.length
, Word8Vector
.toPoly
)
242 fun make (sub
, length
, toPoly
) (av
, i
) =
244 val i
= SeqIndex
.fromInt i
249 val unsafeSubArr
= make (subA
, Word8Array
.length
, Word8Array
.toPoly
)
250 val unsafeSubVec
= make (subV
, Word8Vector
.length
, Word8Vector
.toPoly
)
253 fun toBytes (r
: real): Word8Vector
.vector
=
255 val a
= Array
.alloc bytesPerElem
258 ; Word8Vector
.fromPoly (Array
.vector a
))
261 fun fromBytes v
= subVec (v
, 0)
265 structure PackReal32Big
: PACK_REAL_EXTRA
=
266 PackReal (open Real32
268 val isBigEndian
= true)
269 structure PackReal32Little
: PACK_REAL_EXTRA
=
270 PackReal (open Real32
272 val isBigEndian
= false)
273 structure PackReal32Host
: PACK_REAL_EXTRA
=
274 PackReal (open Real32
276 val isBigEndian
= Primitive
.MLton
.Platform
.Arch
.hostIsBigEndian
)
277 structure PackReal64Big
: PACK_REAL_EXTRA
=
278 PackReal (open Real64
280 val isBigEndian
= true)
281 structure PackReal64Little
: PACK_REAL_EXTRA
=
282 PackReal (open Real64
284 val isBigEndian
= false)
285 structure PackReal64Host
: PACK_REAL_EXTRA
=
286 PackReal (open Real64
288 val isBigEndian
= Primitive
.MLton
.Platform
.Arch
.hostIsBigEndian
)
289 structure PackRealBig
: PACK_REAL_EXTRA
=
292 val isBigEndian
= true)
293 structure PackRealLittle
: PACK_REAL_EXTRA
=
296 val isBigEndian
= false)
297 structure PackRealHost
: PACK_REAL_EXTRA
=
300 val isBigEndian
= Primitive
.MLton
.Platform
.Arch
.hostIsBigEndian
)
301 structure PackLargeRealBig
: PACK_REAL_EXTRA
=
302 PackReal (open LargeReal
303 open PackLargeRealArg
304 val isBigEndian
= true)
305 structure PackLargeRealLittle
: PACK_REAL_EXTRA
=
306 PackReal (open LargeReal
307 open PackLargeRealArg
308 val isBigEndian
= false)
309 structure PackLargeRealHost
: PACK_REAL_EXTRA
=
310 PackReal (open LargeReal
311 open PackLargeRealArg
312 val isBigEndian
= Primitive
.MLton
.Platform
.Arch
.hostIsBigEndian
)