1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
%
% (c) The AQUA Project, Glasgow University, 1997
%
\section[MutableArray]{The @MutableArray@ interface}
Mutable (byte)arrays interface, re-exports type types and operations
over them from @ArrBase@. Have to be used in conjunction with
@ST@.
\begin{code}
module MutableArray
(
MutableArray(..), -- not abstract
MutableByteArray(..),
ST,
Ix,
-- Creators:
newArray, -- :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
newCharArray,
newAddrArray,
newIntArray,
newFloatArray,
newDoubleArray,
newStablePtrArray, -- :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
boundsOfArray, -- :: Ix ix => MutableArray s ix elt -> (ix, ix)
boundsOfByteArray, -- :: Ix ix => MutableByteArray s ix -> (ix, ix)
readArray, -- :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
readCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
readIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
readAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
readFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
readDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
readStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
writeArray, -- :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
writeCharArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
writeIntArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s ()
writeAddrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
writeFloatArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
writeDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
writeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
freezeArray, -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
freezeCharArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeIntArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeAddrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeFloatArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeDoubleArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeStablePtrArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
unsafeFreezeArray, -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
thawArray, -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-- the sizes are reported back are *in bytes*.
sizeofByteArray, -- :: Ix ix => ByteArray ix -> Int
sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
indexStablePtrArray, -- :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
{-
readWord8Array, -- :: Ix ix => MutableByteArray s ix -> Word8
readWord16Array, -- :: Ix ix => MutableByteArray s ix -> Word16
readWord32Array, -- :: Ix ix => MutableByteArray s ix -> Word32
-}
) where
import PrelArr
import PrelArrExtra
import PrelBase ( sizeofMutableByteArray#, sizeofByteArray#
, Int(..), Int#, (+#), (==#)
, StablePtr#, MutableByteArray#, State#
, unsafeFreezeByteArray#, ByteArray#
, newStablePtrArray#, readStablePtrArray#
, indexStablePtrArray#, writeStablePtrArray#
)
import PrelForeign
import PrelST
import ST
import Ix
\end{code}
Note: the absence of operations to read/write ForeignObjs to a mutable
array is not accidental; storing foreign objs in a mutable array is
not supported.
\begin{code}
sizeofByteArray :: Ix ix => ByteArray ix -> Int
sizeofByteArray (ByteArray _ arr#) =
case (sizeofByteArray# arr#) of
i# -> (I# i#)
sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
sizeofMutableByteArray (MutableByteArray _ arr#) =
case (sizeofMutableByteArray# arr#) of
i# -> (I# i#)
\end{code}
\begin{code}
newStablePtrArray :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
newStablePtrArray ixs = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
case (newStablePtrArray# n# s#) of { (# s2#, barr# #) ->
(# s2#, (MutableByteArray ixs barr#) #) }}
readStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s (StablePtr a)
readStablePtrArray (MutableByteArray ixs barr#) n = ST $ \ s# ->
case (index ixs n) of { I# n# ->
case readStablePtrArray# barr# n# s# of { (# s2#, r# #) ->
(# s2# , (StablePtr r#) #) }}
indexStablePtrArray :: Ix ix => ByteArray ix -> ix -> (StablePtr a)
indexStablePtrArray (ByteArray ixs barr#) n
= case (index ixs n) of { I# n# ->
case indexStablePtrArray# barr# n# of { r# ->
(StablePtr r#)}}
writeStablePtrArray :: Ix ix => MutableByteArray s ix -> ix -> StablePtr a -> ST s ()
writeStablePtrArray (MutableByteArray ixs barr#) n (StablePtr sp#) = ST $ \ s# ->
case (index ixs n) of { I# n# ->
case writeStablePtrArray# barr# n# sp# s# of { s2# ->
(# s2# , () #) }}
freezeStablePtrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeStablePtrArray (MutableByteArray ixs arr#) = ST $ \ s# ->
case rangeSize ixs of { I# n# ->
case freeze arr# n# s# of { (# s2# , frozen# #) ->
(# s2# , ByteArray ixs frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
freeze arr1# n# s#
= case (newStablePtrArray# n# s#) of { (# s2# , newarr1# #) ->
case copy 0# n# arr1# newarr1# s2# of { (# s3# , newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s , MutableByteArray# s #)
copy cur# end# from# to# st#
| cur# ==# end#
= (# st# , to# #)
| otherwise
= case (readStablePtrArray# from# cur# st#) of { (# s1# , ele #) ->
case (writeStablePtrArray# to# cur# ele s1#) of { s2# ->
copy (cur# +# 1#) end# from# to# s2#
}}
\end{code}
begin{code}
readWord8Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
readWord16Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word16
readWord32Array :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word32
{- NB!!: The index for an array is in units of the element type being read -}
readWord8Array (MutableByteArray ixs arr#) n@(I# n#) =
case sizeofMutableByteArray# arr# of
I# bytes#
| n# ># (bytes# -# 1#) -> fail (userError "readWord8Array: index out of bounds "++show n)
| otherwise -> IO $ \ s# ->
case readCharArray# barr# n# s# of
(# s2# , r# #) -> (# s2# , W8# (int2Word# (ord# r#)) #)
readWord16Array (MutableByteArray ixs arr#) n@(I# n#) =
case sizeofMutableByteArray# arr# of
I# bytes#
| (2# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord16Array: index out of bounds "++show n)
| otherwise -> IO $ \ s# ->
case readWordArray# barr# n# s# of
(# s2# , w# #) -> (# s2# , wordToWord16 (W# w#) #)
readWord32Array (MutableByteArray ixs arr#) n@(I# n#) =
case sizeofMutableByteArray# arr# of
I# bytes#
| (4# *# n#) ># (bytes# -# 1#) -> fail (userError "readWord32Array: index out of bounds "++show n)
| otherwise -> IO $ \ s# ->
case readWordArray# barr# n# s# of
(# s2# , w# #) -> (# s2# , wordToWord32 (W# w#) #)
end{code}
|
