Follow changes in comparison primops (see #6135)
[ghc.git] / testsuite / tests / codeGen / should_run / cgrun026.hs
1 {-# LANGUAGE MagicHash #-}
2
3 -- !!! simple tests of primitive arrays
4 --
5 module Main ( main ) where
6
7 import GHC.Exts
8 import Data.Char ( chr )
9
10 import Control.Monad.ST
11 import Data.Array.ST
12 import Data.Array.Unboxed
13
14 import Data.Ratio
15
16 main = putStr
17 (test_chars ++ "\n" ++
18 test_ints ++ "\n" ++
19 test_addrs ++ "\n" ++
20 test_floats ++ "\n" ++
21 test_doubles ++ "\n" ++
22 test_ptrs ++ "\n")
23
24
25 -- Arr# Char# -------------------------------------------
26 -- (main effort is in packString#)
27
28 test_chars :: String
29 test_chars
30 = let arr# = f 1000
31 in
32 shows (lookup_range arr# 42# 416#) "\n"
33 where
34 f :: Int -> UArray Int Char
35
36 f size@(I# size#)
37 = runST (
38 -- allocate an array of the specified size
39 newArray_ (0, (size-1)) >>= \ arr# ->
40
41 -- fill in all elements; elem i has "i" put in it
42 fill_in arr# 0# (size# -# 1#) >>
43
44 -- freeze the puppy:
45 freeze arr#
46 )
47
48 fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s ()
49
50 fill_in arr_in# first# last#
51 = if isTrue# (first# ># last#)
52 then return ()
53 else writeArray arr_in# (I# first#) ((chr (I# first#))) >>
54 fill_in arr_in# (first# +# 1#) last#
55
56 lookup_range :: UArray Int Char -> Int# -> Int# -> [Char]
57 lookup_range arr from# to#
58 = if isTrue# (from# ># to#)
59 then []
60 else (arr ! (I# from#))
61 : (lookup_range arr (from# +# 1#) to#)
62
63 -- Arr# Int# -------------------------------------------
64
65 test_ints :: String
66 test_ints
67 = let arr# = f 1000
68 in
69 shows (lookup_range arr# 42# 416#) "\n"
70 where
71 f :: Int -> UArray Int Int
72
73 f size@(I# size#)
74 = runST (
75 -- allocate an array of the specified size
76 newArray_ (0, (size-1)) >>= \ arr# ->
77
78 -- fill in all elements; elem i has i^2 put in it
79 fill_in arr# 0# (size# -# 1#) >>
80
81 -- freeze the puppy:
82 freeze arr#
83 )
84
85 fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s ()
86
87 fill_in arr_in# first# last#
88 = if isTrue# (first# ># last#)
89 then return ()
90 else writeArray arr_in# (I# first#) (I# (first# *# first#)) >>
91 fill_in arr_in# (first# +# 1#) last#
92
93 lookup_range :: UArray Int Int -> Int# -> Int# -> [Int]
94 lookup_range arr from# to#
95 = if isTrue# (from# ># to#)
96 then []
97 else (arr ! (I# from#))
98 : (lookup_range arr (from# +# 1#) to#)
99
100 -- Arr# Addr# -------------------------------------------
101
102 test_addrs :: String
103 test_addrs
104 = let arr# = f 1000
105 in
106 shows (lookup_range arr# 42# 416#) "\n"
107 where
108 f :: Int -> UArray Int (Ptr ())
109
110 f size@(I# size#)
111 = runST (
112 -- allocate an array of the specified size
113 newArray_ (0, (size-1)) >>= \ arr# ->
114
115 -- fill in all elements; elem i has i^2 put in it
116 fill_in arr# 0# (size# -# 1#) >>
117
118 -- freeze the puppy:
119 freeze arr#
120 )
121
122 fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s ()
123
124 fill_in arr_in# first# last#
125 = if isTrue# (first# ># last#)
126 then return ()
127 else writeArray arr_in# (I# first#)
128 (Ptr (int2Addr# (first# *# first#))) >>
129 fill_in arr_in# (first# +# 1#) last#
130
131 lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ]
132 lookup_range arr from# to#
133 = let
134 a2i (Ptr a#) = I# (addr2Int# a#)
135 in
136 if isTrue# (from# ># to#)
137 then []
138 else (a2i (arr ! (I# from#)))
139 : (lookup_range arr (from# +# 1#) to#)
140
141 -- Arr# Float# -------------------------------------------
142
143 test_floats :: String
144 test_floats
145 = let arr# = f 1000
146 in
147 shows (lookup_range arr# 42# 416#) "\n"
148 where
149 f :: Int -> UArray Int Float
150
151 f size@(I# size#)
152 = runST (
153 -- allocate an array of the specified size
154 newArray_ (0, (size-1)) >>= \ arr# ->
155
156 -- fill in all elements; elem i has "i * pi" put in it
157 fill_in arr# 0# (size# -# 1#) >>
158
159 -- freeze the puppy:
160 freeze arr#
161 )
162
163 fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s ()
164
165 fill_in arr_in# first# last#
166 = if isTrue# (first# ># last#)
167 then return ()
168 {- else let e = ((fromIntegral (I# first#)) * pi)
169 in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
170 fill_in arr_in# (first# +# 1#) last#
171 -}
172 else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
173 fill_in arr_in# (first# +# 1#) last#
174
175 lookup_range :: UArray Int Float -> Int# -> Int# -> [Float]
176 lookup_range arr from# to#
177 = if isTrue# (from# ># to#)
178 then []
179 else (arr ! (I# from#))
180 : (lookup_range arr (from# +# 1#) to#)
181
182 -- Arr# Double# -------------------------------------------
183
184 test_doubles :: String
185 test_doubles
186 = let arr# = f 1000
187 in
188 shows (lookup_range arr# 42# 416#) "\n"
189 where
190 f :: Int -> UArray Int Double
191
192 f size@(I# size#)
193 = runST (
194 -- allocate an array of the specified size
195 newArray_ (0, (size-1)) >>= \ arr# ->
196
197 -- fill in all elements; elem i has "i * pi" put in it
198 fill_in arr# 0# (size# -# 1#) >>
199
200 -- freeze the puppy:
201 freeze arr#
202 )
203
204 fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s ()
205
206 fill_in arr_in# first# last#
207 = if isTrue# (first# ># last#)
208 then return ()
209 else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
210 fill_in arr_in# (first# +# 1#) last#
211
212 lookup_range :: UArray Int Double -> Int# -> Int# -> [Double]
213 lookup_range arr from# to#
214 = if isTrue# (from# ># to#)
215 then []
216 else (arr ! (I# from#))
217 : (lookup_range arr (from# +# 1#) to#)
218
219 -- Arr# (Ratio Int) (ptrs) ---------------------------------
220 -- just like Int# test
221
222 test_ptrs :: String
223 test_ptrs
224 = let arr# = f 1000
225 in
226 shows (lookup_range arr# 42 416) "\n"
227 where
228 f :: Int -> Array Int (Ratio Int)
229
230 f size
231 = runST (
232 newArray (1, size) (3 % 5) >>= \ arr# ->
233 -- don't fill in the whole thing
234 fill_in arr# 1 400 >>
235 freeze arr#
236 )
237
238 fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()
239
240 fill_in arr_in# first last
241 = if (first > last)
242 then return ()
243 else writeArray arr_in# first (fromIntegral (first * first)) >>
244 fill_in arr_in# (first + 1) last
245
246 lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]
247 lookup_range array from too
248 = if (from > too)
249 then []
250 else (array ! from) : (lookup_range array (from + 1) too)