ghc/tests/codeGen/cg026.hs

   1 --!!! simple tests of primitive arrays
   2 --
   3 module Main ( main ) where
   4
   5 import PrelBase --ghc1.3
   6 import GlaExts
   7 import ST
   8
   9 import Ratio   -- 1.3
  10 import Array   -- 1.3
  11
  12 main = putStr
  13          (test_chars    ++ "\n"  ++
  14           test_ints     ++ "\n"  ++
  15           test_addrs    ++ "\n"  ++
  16           test_floats   ++ "\n"  ++
  17           test_doubles  ++ "\n"  ++
  18           test_ptrs     ++ "\n")
  19
  20
  21 -- Arr# Char# -------------------------------------------
  22 -- (main effort is in packString#)
  23
  24 test_chars :: String
  25 test_chars
  26   = let str = reverse "Now is the time for all good men to come to...\n"
  27     in
  28     unsafePerformPrimIO (
  29         _ccall_ fprintf (``stdout''::Addr) "%d %s\n" 93 str >>
  30         returnPrimIO ""
  31         )
  32
  33 -- Arr# Int# -------------------------------------------
  34
  35 test_ints :: String
  36 test_ints
  37   = let arr# = f 1000
  38     in
  39         shows (lookup_range arr# 42# 416#) "\n"
  40   where
  41     f :: Int -> ByteArray Int
  42
  43     f size@(I# size#)
  44       = runST (
  45             -- allocate an array of the specified size
  46           newIntArray (0, (size-1))     >>= \ arr# ->
  47
  48             -- fill in all elements; elem i has i^2 put in it
  49           fill_in arr# 0# (size# -# 1#) >>
  50
  51             -- freeze the puppy:
  52           freezeIntArray arr#
  53         )
  54
  55     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
  56
  57     fill_in arr_in# first# last#
  58       = if (first# ># last#)
  59         then returnST ()
  60         else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
  61              fill_in arr_in# (first# +# 1#) last#
  62
  63     lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
  64     lookup_range arr from# to#
  65       = if (from# ># to#)
  66         then []
  67         else (indexIntArray arr (I# from#))
  68              : (lookup_range arr (from# +# 1#) to#)
  69
  70 -- Arr# Addr# -------------------------------------------
  71
  72 test_addrs :: String
  73 test_addrs
  74   = let arr# = f 1000
  75     in
  76         shows (lookup_range arr# 42# 416#) "\n"
  77   where
  78     f :: Int -> ByteArray Int
  79
  80     f size@(I# size#)
  81       = runST (
  82             -- allocate an array of the specified size
  83           newAddrArray (0, (size-1))    >>= \ arr# ->
  84
  85             -- fill in all elements; elem i has i^2 put in it
  86           fill_in arr# 0# (size# -# 1#) >>
  87
  88             -- freeze the puppy:
  89           freezeAddrArray arr#
  90         )
  91
  92     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
  93
  94     fill_in arr_in# first# last#
  95       = if (first# ># last#)
  96         then returnST ()
  97         else writeAddrArray arr_in# (I# first#)
  98                             (A# (int2Addr# (first# *# first#))) >>
  99              fill_in arr_in# (first# +# 1#) last#
 100
 101     lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
 102     lookup_range arr from# to#
 103       = let
 104             a2i (A# a#) = I# (addr2Int# a#)
 105         in
 106         if (from# ># to#)
 107         then []
 108         else (a2i (indexAddrArray arr (I# from#)))
 109              : (lookup_range arr (from# +# 1#) to#)
 110
 111 -- Arr# Float# -------------------------------------------
 112
 113 test_floats :: String
 114 test_floats
 115   = let arr# = f 1000
 116     in
 117         shows (lookup_range arr# 42# 416#) "\n"
 118   where
 119     f :: Int -> ByteArray Int
 120
 121     f size@(I# size#)
 122       = runST (
 123             -- allocate an array of the specified size
 124           newFloatArray (0, (size-1))   >>= \ arr# ->
 125
 126             -- fill in all elements; elem i has "i * pi" put in it
 127           fill_in arr# 0# (size# -# 1#) >>
 128
 129             -- freeze the puppy:
 130           freezeFloatArray arr#
 131         )
 132
 133     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
 134
 135     fill_in arr_in# first# last#
 136       = if (first# ># last#)
 137         then returnST ()
 138         else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
 139              fill_in arr_in# (first# +# 1#) last#
 140
 141     lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
 142     lookup_range arr from# to#
 143       = if (from# ># to#)
 144         then []
 145         else (indexFloatArray arr (I# from#))
 146              : (lookup_range arr (from# +# 1#) to#)
 147
 148 -- Arr# Double# -------------------------------------------
 149
 150 test_doubles :: String
 151 test_doubles
 152   = let arr# = f 1000
 153     in
 154         shows (lookup_range arr# 42# 416#) "\n"
 155   where
 156     f :: Int -> ByteArray Int
 157
 158     f size@(I# size#)
 159       = runST (
 160             -- allocate an array of the specified size
 161           newDoubleArray (0, (size-1))  >>= \ arr# ->
 162
 163             -- fill in all elements; elem i has "i * pi" put in it
 164           fill_in arr# 0# (size# -# 1#) >>
 165
 166             -- freeze the puppy:
 167           freezeDoubleArray arr#
 168         )
 169
 170     fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
 171
 172     fill_in arr_in# first# last#
 173       = if (first# ># last#)
 174         then returnST ()
 175         else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
 176              fill_in arr_in# (first# +# 1#) last#
 177
 178     lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
 179     lookup_range arr from# to#
 180       = if (from# ># to#)
 181         then []
 182         else (indexDoubleArray arr (I# from#))
 183              : (lookup_range arr (from# +# 1#) to#)
 184
 185 -- Arr# (Ratio Int) (ptrs) ---------------------------------
 186 -- just like Int# test
 187
 188 test_ptrs :: String
 189 test_ptrs
 190   = let arr# = f 1000
 191     in
 192         shows (lookup_range arr# 42 416) "\n"
 193   where
 194     f :: Int -> Array Int (Ratio Int)
 195
 196     f size
 197       = runST (
 198           newArray (1, size) (3 % 5)    >>= \ arr# ->
 199           -- don't fill in the whole thing
 200           fill_in arr# 1 400            >>
 201           freezeArray arr#
 202         )
 203
 204     fill_in :: MutableArray s Int (Ratio Int) -> Int -> Int -> ST s ()
 205
 206     fill_in arr_in# first last
 207       = if (first > last)
 208         then returnST ()
 209         else writeArray arr_in# first (fromInt (first * first)) >>
 210              fill_in  arr_in# (first + 1) last
 211
 212     lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]
 213     lookup_range array from too
 214       = if (from > too)
 215         then []
 216         else (array ! from) : (lookup_range array (from + 1) too)