ghc/tests/codeGen/should_run/cg026.hs

   1 -- !!! simple tests of primitive arrays
   2 --
   3 module Main ( main ) where
   4
   5 import PrelBase
   6 import Addr
   7 import ST
   8 import ST
   9 import MutableArray
  10 import ByteArray
  11 import Int( fromInt )
  12
  13 import Ratio
  14 import Array
  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 -> ByteArray Int
  35
  36     f size@(I# size#)
  37       = runST (
  38             -- allocate an array of the specified size
  39           newCharArray (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           freezeByteArray arr#
  46         )
  47
  48     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
  49
  50     fill_in arr_in# first# last#
  51       = if (first# ># last#)
  52         then return ()
  53         else writeCharArray arr_in# (I# first#) ((chr (I# first#))) >>
  54              fill_in arr_in# (first# +# 1#) last#
  55
  56     lookup_range :: ByteArray Int -> Int# -> Int# -> [Char]
  57     lookup_range arr from# to#
  58       = if (from# ># to#)
  59         then []
  60         else (indexCharArray 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 -> ByteArray Int
  72
  73     f size@(I# size#)
  74       = runST (
  75             -- allocate an array of the specified size
  76           newIntArray (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           freezeByteArray arr#
  83         )
  84
  85     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
  86
  87     fill_in arr_in# first# last#
  88       = if (first# ># last#)
  89         then return ()
  90         else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
  91              fill_in arr_in# (first# +# 1#) last#
  92
  93     lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
  94     lookup_range arr from# to#
  95       = if (from# ># to#)
  96         then []
  97         else (indexIntArray 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 -> ByteArray Int
 109
 110     f size@(I# size#)
 111       = runST (
 112             -- allocate an array of the specified size
 113           newAddrArray (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           freezeByteArray arr#
 120         )
 121
 122     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
 123
 124     fill_in arr_in# first# last#
 125       = if (first# ># last#)
 126         then return ()
 127         else writeAddrArray arr_in# (I# first#)
 128                             (A# (int2Addr# (first# *# first#))) >>
 129              fill_in arr_in# (first# +# 1#) last#
 130
 131     lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
 132     lookup_range arr from# to#
 133       = let
 134             a2i (A# a#) = I# (addr2Int# a#)
 135         in
 136         if (from# ># to#)
 137         then []
 138         else (a2i (indexAddrArray 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 -> ByteArray Int
 150
 151     f size@(I# size#)
 152       = runST (
 153             -- allocate an array of the specified size
 154           newFloatArray (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           freezeByteArray arr#
 161         )
 162
 163     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
 164
 165     fill_in arr_in# first# last#
 166       = if (first# ># last#)
 167         then return ()
 168 {-      else let e = ((fromInt (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 writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
 173              fill_in arr_in# (first# +# 1#) last#
 174
 175     lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
 176     lookup_range arr from# to#
 177       = if (from# ># to#)
 178         then []
 179         else (indexFloatArray 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 -> ByteArray Int
 191
 192     f size@(I# size#)
 193       = runST (
 194             -- allocate an array of the specified size
 195           newDoubleArray (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           freezeByteArray arr#
 202         )
 203
 204     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
 205
 206     fill_in arr_in# first# last#
 207       = if (first# ># last#)
 208         then return ()
 209         else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
 210              fill_in arr_in# (first# +# 1#) last#
 211
 212     lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
 213     lookup_range arr from# to#
 214       = if (from# ># to#)
 215         then []
 216         else (indexDoubleArray 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           newSTArray (1, size) (3 % 5)  >>= \ arr# ->
 233           -- don't fill in the whole thing
 234           fill_in arr# 1 400            >>
 235           freezeSTArray 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 writeSTArray arr_in# first (fromInt (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)