1 -- !!! simple tests of primitive arrays
3 module Main ( main ) where
6 import PrelAddr(indexAddrOffAddr)
13 import Int( Num(fromInt) )
14 import CString (packString)
20 (test_chars ++ "\n" ++
23 test_floats ++ "\n" ++
24 test_doubles ++ "\n" ++
28 -- Arr# Char# -------------------------------------------
29 -- (main effort is in packString#)
31 foreign label "stdout" addrOfStdout :: Addr
34 stdout = indexAddrOffAddr addrOfStdout 0
38 = let str = reverse "Now is the time for all good men to come to...\n"
41 _ccall_ fprintf stdout (packString "%d %s\n") (93::Int) (packString str) >>
42 _ccall_ fflush stdout >>
46 -- Arr# Int# -------------------------------------------
52 shows (lookup_range arr# 42# 416#) "\n"
54 f :: Int -> ByteArray Int
58 -- allocate an array of the specified size
59 newIntArray (0, (size-1)) >>= \ arr# ->
61 -- fill in all elements; elem i has i^2 put in it
62 fill_in arr# 0# (size# -# 1#) >>
68 fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
70 fill_in arr_in# first# last#
71 = if (first# ># last#)
73 else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
74 fill_in arr_in# (first# +# 1#) last#
76 lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
77 lookup_range arr from# to#
80 else (indexIntArray arr (I# from#))
81 : (lookup_range arr (from# +# 1#) to#)
83 -- Arr# Addr# -------------------------------------------
89 shows (lookup_range arr# 42# 416#) "\n"
91 f :: Int -> ByteArray Int
95 -- allocate an array of the specified size
96 newAddrArray (0, (size-1)) >>= \ arr# ->
98 -- fill in all elements; elem i has i^2 put in it
99 fill_in arr# 0# (size# -# 1#) >>
105 fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
107 fill_in arr_in# first# last#
108 = if (first# ># last#)
110 else writeAddrArray arr_in# (I# first#)
111 (A# (int2Addr# (first# *# first#))) >>
112 fill_in arr_in# (first# +# 1#) last#
114 lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
115 lookup_range arr from# to#
117 a2i (A# a#) = I# (addr2Int# a#)
121 else (a2i (indexAddrArray arr (I# from#)))
122 : (lookup_range arr (from# +# 1#) to#)
124 -- Arr# Float# -------------------------------------------
126 test_floats :: String
130 shows (lookup_range arr# 42# 416#) "\n"
132 f :: Int -> ByteArray Int
136 -- allocate an array of the specified size
137 newFloatArray (0, (size-1)) >>= \ arr# ->
139 -- fill in all elements; elem i has "i * pi" put in it
140 fill_in arr# 0# (size# -# 1#) >>
146 fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
148 fill_in arr_in# first# last#
149 = if (first# ># last#)
151 {- else let e = ((fromInt (I# first#)) * pi)
152 in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
153 fill_in arr_in# (first# +# 1#) last#
155 else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
156 fill_in arr_in# (first# +# 1#) last#
158 lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
159 lookup_range arr from# to#
162 else (indexFloatArray arr (I# from#))
163 : (lookup_range arr (from# +# 1#) to#)
165 -- Arr# Double# -------------------------------------------
167 test_doubles :: String
171 shows (lookup_range arr# 42# 416#) "\n"
173 f :: Int -> ByteArray Int
177 -- allocate an array of the specified size
178 newDoubleArray (0, (size-1)) >>= \ arr# ->
180 -- fill in all elements; elem i has "i * pi" put in it
181 fill_in arr# 0# (size# -# 1#) >>
187 fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
189 fill_in arr_in# first# last#
190 = if (first# ># last#)
192 else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
193 fill_in arr_in# (first# +# 1#) last#
195 lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
196 lookup_range arr from# to#
199 else (indexDoubleArray arr (I# from#))
200 : (lookup_range arr (from# +# 1#) to#)
202 -- Arr# (Ratio Int) (ptrs) ---------------------------------
203 -- just like Int# test
209 shows (lookup_range arr# 42 416) "\n"
211 f :: Int -> Array Int (Ratio Int)
215 newSTArray (1, size) (3 % 5) >>= \ arr# ->
216 -- don't fill in the whole thing
217 fill_in arr# 1 400 >>
221 fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()
223 fill_in arr_in# first last
226 else writeSTArray arr_in# first (fromInt (first * first)) >>
227 fill_in arr_in# (first + 1) last
229 lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]
230 lookup_range array from too
233 else (array ! from) : (lookup_range array (from + 1) too)