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
|
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- !!! simple tests of copying/cloning byte arrays
--
module Main ( main ) where
import GHC.Word
import GHC.Exts
import GHC.Prim
import GHC.ST
main = putStr
(test_copyByteArray
++ "\n" ++ test_copyMutableByteArray
++ "\n" ++ test_copyMutableByteArrayOverlap
++ "\n"
)
------------------------------------------------------------------------
-- Constants
-- All allocated arrays are of this size
len :: Int
len = 130
-- We copy these many elements
copied :: Int
copied = len - 2
------------------------------------------------------------------------
-- copyByteArray#
-- Copy a slice of the source array into a destination array and check
-- that the copy succeeded.
test_copyByteArray :: String
test_copyByteArray =
let dst = runST $ do
src <- newByteArray len
fill src 0 len
src <- unsafeFreezeByteArray src
dst <- newByteArray len
-- Markers to detect errors
writeWord8Array dst 0 255
writeWord8Array dst (len-1) 255
-- Leave the first and last element untouched
copyByteArray src 1 dst 1 copied
unsafeFreezeByteArray dst
in shows (toList dst len) "\n"
------------------------------------------------------------------------
-- copyMutableByteArray#
-- Copy a slice of the source array into a destination array and check
-- that the copy succeeded.
test_copyMutableByteArray :: String
test_copyMutableByteArray =
let dst = runST $ do
src <- newByteArray len
fill src 0 len
dst <- newByteArray len
-- Markers to detect errors
writeWord8Array dst 0 255
writeWord8Array dst (len-1) 255
-- Leave the first and last element untouched
copyMutableByteArray src 1 dst 1 copied
unsafeFreezeByteArray dst
in shows (toList dst len) "\n"
-- Perform a copy where the source and destination part overlap.
test_copyMutableByteArrayOverlap :: String
test_copyMutableByteArrayOverlap =
let arr = runST $ do
marr <- fromList inp
-- Overlap of two elements
copyMutableByteArray marr 5 marr 7 8
unsafeFreezeByteArray marr
in shows (toList arr (length inp)) "\n"
where
-- This case was known to fail at some point.
inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
------------------------------------------------------------------------
-- Test helpers
-- Initialize the elements of this array, starting at the given
-- offset. The last parameter specifies the number of elements to
-- initialize. Element at index @i@ takes the value @i@ (i.e. the
-- first actually modified element will take value @off@).
fill :: MByteArray s -> Int -> Int -> ST s ()
fill marr off count = go 0
where
go i
| i >= fromIntegral count = return ()
| otherwise = do writeWord8Array marr (off + i) (fromIntegral i)
go (i + 1)
fromList :: [Word8] -> ST s (MByteArray s)
fromList xs0 = do
marr <- newByteArray (length xs0)
let go [] i = i `seq` return marr
go (x:xs) i = writeWord8Array marr i x >> go xs (i + 1)
go xs0 0
------------------------------------------------------------------------
-- Convenience wrappers for ByteArray# and MutableByteArray#
data ByteArray = ByteArray { unBA :: ByteArray# }
data MByteArray s = MByteArray { unMBA :: MutableByteArray# s }
newByteArray :: Int -> ST s (MByteArray s)
newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of
(# s2#, marr# #) -> (# s2#, MByteArray marr# #)
indexWord8Array :: ByteArray -> Int -> Word8
indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of
a -> W8# a
writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s ()
writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# ->
case writeWord8Array# (unMBA marr) i# a s# of
s2# -> (# s2#, () #)
unsafeFreezeByteArray :: MByteArray s -> ST s (ByteArray)
unsafeFreezeByteArray marr = ST $ \ s# ->
case unsafeFreezeByteArray# (unMBA marr) s# of
(# s2#, arr# #) -> (# s2#, ByteArray arr# #)
copyByteArray :: ByteArray -> Int -> MByteArray s -> Int -> Int -> ST s ()
copyByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
case copyByteArray# (unBA src) six# (unMBA dst) dix# n# s# of
s2# -> (# s2#, () #)
copyMutableByteArray :: MByteArray s -> Int -> MByteArray s -> Int -> Int
-> ST s ()
copyMutableByteArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
case copyMutableByteArray# (unMBA src) six# (unMBA dst) dix# n# s# of
s2# -> (# s2#, () #)
toList :: ByteArray -> Int -> [Word8]
toList arr n = go 0
where
go i | i >= n = []
| otherwise = indexWord8Array arr i : go (i+1)
|
