cgrun026.hs 5.98 KB
Newer Older
1
{-# LANGUAGE MagicHash #-}
2

3 4 5 6
-- !!! simple tests of primitive arrays
--
module Main ( main ) where

7
import GHC.Exts
8
import Data.Char 	( chr )
9

10 11 12
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
Jan Stolarek's avatar
Jan Stolarek committed
13

14
import Data.Ratio
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33

main = putStr
	 (test_chars	++ "\n"  ++
	  test_ints	++ "\n"  ++
	  test_addrs	++ "\n"  ++
	  test_floats	++ "\n"  ++
	  test_doubles	++ "\n"  ++
	  test_ptrs	++ "\n")


-- Arr# Char# -------------------------------------------
-- (main effort is in packString#)

test_chars :: String
test_chars
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42# 416#) "\n"
  where
34
    f :: Int -> UArray Int Char
35 36 37 38

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
39
	  newArray_ (0, (size-1))	>>= \ arr# ->
40 41 42 43 44

	    -- fill in all elements; elem i has "i" put in it
	  fill_in arr# 0# (size# -# 1#) >>

	    -- freeze the puppy:
45
	  freeze arr#
46 47
	)

48
    fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s ()
49 50 51 52

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
53
	else writeArray arr_in# (I# first#) ((chr (I# first#))) >>
54 55
	     fill_in arr_in# (first# +# 1#) last#

56
    lookup_range :: UArray Int Char -> Int# -> Int# -> [Char]
57 58 59
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
60
	else (arr ! (I# from#))
61 62 63 64 65 66 67 68 69 70
	     : (lookup_range arr (from# +# 1#) to#)

-- Arr# Int# -------------------------------------------

test_ints :: String
test_ints
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42# 416#) "\n"
  where
71
    f :: Int -> UArray Int Int
72 73 74 75

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
76
	  newArray_ (0, (size-1))	>>= \ arr# ->
77 78 79 80 81

	    -- fill in all elements; elem i has i^2 put in it
	  fill_in arr# 0# (size# -# 1#) >>

	    -- freeze the puppy:
82
	  freeze arr#
83 84
	)

85
    fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s ()
86 87 88 89

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
90
	else writeArray arr_in# (I# first#) (I# (first# *# first#)) >>
91 92
	     fill_in arr_in# (first# +# 1#) last#

93
    lookup_range :: UArray Int Int -> Int# -> Int# -> [Int]
94 95 96
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
97
	else (arr ! (I# from#))
98 99 100 101 102 103 104 105 106 107
	     : (lookup_range arr (from# +# 1#) to#)

-- Arr# Addr# -------------------------------------------

test_addrs :: String
test_addrs
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42# 416#) "\n"
  where
108
    f :: Int -> UArray Int (Ptr ())
109 110 111 112

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
113
	  newArray_ (0, (size-1))	>>= \ arr# ->
114 115 116 117 118

	    -- fill in all elements; elem i has i^2 put in it
	  fill_in arr# 0# (size# -# 1#) >>

	    -- freeze the puppy:
119
	  freeze arr#
120 121
	)

122
    fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s ()
123 124 125 126

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
127 128
	else writeArray arr_in# (I# first#)
			    (Ptr (int2Addr# (first# *# first#))) >>
129 130
	     fill_in arr_in# (first# +# 1#) last#

131
    lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ]
132 133
    lookup_range arr from# to#
      = let
134
	    a2i (Ptr a#) = I# (addr2Int# a#)
135 136 137
	in
	if (from# ># to#)
	then []
138
	else (a2i (arr ! (I# from#)))
139 140 141 142 143 144 145 146 147 148
	     : (lookup_range arr (from# +# 1#) to#)

-- Arr# Float# -------------------------------------------

test_floats :: String
test_floats
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42# 416#) "\n"
  where
149
    f :: Int -> UArray Int Float
150 151 152 153

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
154
	  newArray_ (0, (size-1))	>>= \ arr# ->
155 156 157 158 159

	    -- fill in all elements; elem i has "i * pi" put in it
	  fill_in arr# 0# (size# -# 1#) >>

	    -- freeze the puppy:
160
	  freeze arr#
161 162
	)

163
    fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s ()
164 165 166 167

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
168
{-	else let e = ((fromIntegral (I# first#)) * pi)
169 170 171
	     in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
	     fill_in arr_in# (first# +# 1#) last#
-}
172
	else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
173 174
	     fill_in arr_in# (first# +# 1#) last#

175
    lookup_range :: UArray Int Float -> Int# -> Int# -> [Float]
176 177 178
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
179
	else (arr ! (I# from#))
180 181 182 183 184 185 186 187 188 189
	     : (lookup_range arr (from# +# 1#) to#)

-- Arr# Double# -------------------------------------------

test_doubles :: String
test_doubles
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42# 416#) "\n"
  where
190
    f :: Int -> UArray Int Double
191 192 193 194

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
195
	  newArray_ (0, (size-1))	>>= \ arr# ->
196 197 198 199 200

	    -- fill in all elements; elem i has "i * pi" put in it
	  fill_in arr# 0# (size# -# 1#) >>

	    -- freeze the puppy:
201
	  freeze arr#
202 203
	)

204
    fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s ()
205 206 207 208

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
209
	else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
210 211
	     fill_in arr_in# (first# +# 1#) last#

212
    lookup_range :: UArray Int Double -> Int# -> Int# -> [Double]
213 214 215
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
216
	else (arr ! (I# from#))
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
	     : (lookup_range arr (from# +# 1#) to#)

-- Arr# (Ratio Int) (ptrs) ---------------------------------
-- just like Int# test

test_ptrs :: String
test_ptrs
  = let arr# = f 1000
    in
	shows (lookup_range arr# 42 416) "\n"
  where
    f :: Int -> Array Int (Ratio Int)

    f size
      = runST (
232
	  newArray (1, size) (3 % 5)	>>= \ arr# ->
233 234
	  -- don't fill in the whole thing
	  fill_in arr# 1 400		>>
235
	  freeze arr#
236 237 238 239 240 241 242
	)

    fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()

    fill_in arr_in# first last
      = if (first > last)
	then return ()
243
	else writeArray arr_in# first (fromIntegral (first * first)) >>
244 245 246 247 248 249 250
	     fill_in  arr_in# (first + 1) last

    lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]
    lookup_range array from too
      = if (from > too)
	then []
	else (array ! from) : (lookup_range array (from + 1) too)