Error message wibbles when adding overloaded lists
[ghc.git] / testsuite / tests / codeGen / should_run / cgrun064.hs
1 {-# LANGUAGE MagicHash, UnboxedTuples #-}
2
3 -- !!! simple tests of copying/cloning primitive arrays
4 --
5
6 module Main ( main ) where
7
8 import GHC.Exts hiding (IsList(..))
9 import GHC.Prim
10 import GHC.ST
11
12 main = putStr
13 (test_copyArray
14 ++ "\n" ++ test_copyMutableArray
15 ++ "\n" ++ test_copyMutableArrayOverlap
16 ++ "\n" ++ test_cloneArray
17 ++ "\n" ++ test_cloneMutableArray
18 ++ "\n" ++ test_cloneMutableArrayEmpty
19 ++ "\n" ++ test_freezeArray
20 ++ "\n" ++ test_thawArray
21 ++ "\n"
22 )
23
24 ------------------------------------------------------------------------
25 -- Constants
26
27 -- All allocated arrays are of this size
28 len :: Int
29 len = 130
30
31 -- We copy these many elements
32 copied :: Int
33 copied = len - 2
34
35 ------------------------------------------------------------------------
36 -- copyArray#
37
38 -- Copy a slice of the source array into a destination array and check
39 -- that the copy succeeded.
40 test_copyArray :: String
41 test_copyArray =
42 let dst = runST $ do
43 src <- newArray len 0
44 fill src 0 len
45 src <- unsafeFreezeArray src
46 dst <- newArray len (-1)
47 -- Leave the first and last element untouched
48 copyArray src 1 dst 1 copied
49 unsafeFreezeArray dst
50 in shows (toList dst len) "\n"
51
52 ------------------------------------------------------------------------
53 -- copyMutableArray#
54
55 -- Copy a slice of the source array into a destination array and check
56 -- that the copy succeeded.
57 test_copyMutableArray :: String
58 test_copyMutableArray =
59 let dst = runST $ do
60 src <- newArray len 0
61 fill src 0 len
62 dst <- newArray len (-1)
63 -- Leave the first and last element untouched
64 copyMutableArray src 1 dst 1 copied
65 unsafeFreezeArray dst
66 in shows (toList dst len) "\n"
67
68 -- Perform a copy where the source and destination part overlap.
69 test_copyMutableArrayOverlap :: String
70 test_copyMutableArrayOverlap =
71 let arr = runST $ do
72 marr <- fromList inp
73 -- Overlap of two elements
74 copyMutableArray marr 5 marr 7 8
75 unsafeFreezeArray marr
76 in shows (toList arr (length inp)) "\n"
77 where
78 -- This case was known to fail at some point.
79 inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
80
81 ------------------------------------------------------------------------
82 -- cloneArray#
83
84 -- Clone a slice of the source array into a destination array and
85 -- check that the clone succeeded.
86 test_cloneArray :: String
87 test_cloneArray =
88 let dst = runST $ do
89 src <- newArray len 0
90 fill src 0 len
91 src <- unsafeFreezeArray src
92 -- Don't include the first and last element.
93 return $ cloneArray src 1 copied
94 in shows (toList dst copied) "\n"
95
96 ------------------------------------------------------------------------
97 -- cloneMutableArray#
98
99 -- Clone a slice of the source array into a destination array and
100 -- check that the clone succeeded.
101 test_cloneMutableArray :: String
102 test_cloneMutableArray =
103 let dst = runST $ do
104 src <- newArray len 0
105 fill src 0 len
106 -- Don't include the first and last element.
107 dst <- cloneMutableArray src 1 copied
108 unsafeFreezeArray dst
109 in shows (toList dst copied) "\n"
110
111 -- Check that zero-length clones work.
112 test_cloneMutableArrayEmpty :: String
113 test_cloneMutableArrayEmpty =
114 let dst = runST $ do
115 src <- newArray len 0
116 dst <- cloneMutableArray src 0 0
117 unsafeFreezeArray dst
118 in shows (toList dst 0) "\n"
119
120 ------------------------------------------------------------------------
121 -- freezeArray#
122
123 -- Clone a slice of the source array into a destination array and
124 -- check that the clone succeeded.
125 test_freezeArray :: String
126 test_freezeArray =
127 let dst = runST $ do
128 src <- newArray len 0
129 fill src 0 len
130 -- Don't include the first and last element.
131 freezeArray src 1 copied
132 in shows (toList dst copied) "\n"
133
134 ------------------------------------------------------------------------
135 -- thawArray#
136
137 -- Clone a slice of the source array into a destination array and
138 -- check that the clone succeeded.
139 test_thawArray :: String
140 test_thawArray =
141 let dst = runST $ do
142 src <- newArray len 0
143 fill src 0 len
144 src <- unsafeFreezeArray src
145 -- Don't include the first and last element.
146 dst <- thawArray src 1 copied
147 unsafeFreezeArray dst
148 in shows (toList dst copied) "\n"
149
150 ------------------------------------------------------------------------
151 -- Test helpers
152
153 -- Initialize the elements of this array, starting at the given
154 -- offset. The last parameter specifies the number of elements to
155 -- initialize. Element at index @i@ takes the value @i*i@ (i.e. the
156 -- first actually modified element will take value @off*off@).
157 fill :: MArray s Int -> Int -> Int -> ST s ()
158 fill marr off count = go 0
159 where
160 go i
161 | i >= count = return ()
162 | otherwise = writeArray marr (off + i) (i*i) >> go (i + 1)
163
164 fromList :: [Int] -> ST s (MArray s Int)
165 fromList xs0 = do
166 marr <- newArray (length xs0) bottomElem
167 let go [] i = i `seq` return marr
168 go (x:xs) i = writeArray marr i x >> go xs (i + 1)
169 go xs0 0
170 where
171 bottomElem = error "undefined element"
172
173 ------------------------------------------------------------------------
174 -- Convenience wrappers for Array# and MutableArray#
175
176 data Array a = Array { unArray :: Array# a }
177 data MArray s a = MArray { unMArray :: MutableArray# s a }
178
179 newArray :: Int -> a -> ST s (MArray s a)
180 newArray (I# n#) a = ST $ \s# -> case newArray# n# a s# of
181 (# s2#, marr# #) -> (# s2#, MArray marr# #)
182
183 indexArray :: Array a -> Int -> a
184 indexArray arr (I# i#) = case indexArray# (unArray arr) i# of
185 (# a #) -> a
186
187 writeArray :: MArray s a -> Int -> a -> ST s ()
188 writeArray marr (I# i#) a = ST $ \ s# ->
189 case writeArray# (unMArray marr) i# a s# of
190 s2# -> (# s2#, () #)
191
192 unsafeFreezeArray :: MArray s a -> ST s (Array a)
193 unsafeFreezeArray marr = ST $ \ s# ->
194 case unsafeFreezeArray# (unMArray marr) s# of
195 (# s2#, arr# #) -> (# s2#, Array arr# #)
196
197 copyArray :: Array a -> Int -> MArray s a -> Int -> Int -> ST s ()
198 copyArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
199 case copyArray# (unArray src) six# (unMArray dst) dix# n# s# of
200 s2# -> (# s2#, () #)
201
202 copyMutableArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()
203 copyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
204 case copyMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of
205 s2# -> (# s2#, () #)
206
207 cloneArray :: Array a -> Int -> Int -> Array a
208 cloneArray src (I# six#) (I# n#) = Array (cloneArray# (unArray src) six# n#)
209
210 cloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)
211 cloneMutableArray src (I# six#) (I# n#) = ST $ \ s# ->
212 case cloneMutableArray# (unMArray src) six# n# s# of
213 (# s2#, marr# #) -> (# s2#, MArray marr# #)
214
215 freezeArray :: MArray s a -> Int -> Int -> ST s (Array a)
216 freezeArray src (I# six#) (I# n#) = ST $ \ s# ->
217 case freezeArray# (unMArray src) six# n# s# of
218 (# s2#, arr# #) -> (# s2#, Array arr# #)
219
220 thawArray :: Array a -> Int -> Int -> ST s (MArray s a)
221 thawArray src (I# six#) (I# n#) = ST $ \ s# ->
222 case thawArray# (unArray src) six# n# s# of
223 (# s2#, marr# #) -> (# s2#, MArray marr# #)
224
225 toList :: Array a -> Int -> [a]
226 toList arr n = go 0
227 where
228 go i | i >= n = []
229 | otherwise = indexArray arr i : go (i+1)