content: {-# LANGUAGE MagicHash #-}
  
  -- !!! simple tests of primitive arrays
  --
  module Main ( main ) where
  
  import GHC.Exts
  import Data.Char        ( chr )
  
  import Control.Monad.ST
  import Data.Array.ST
  import Data.Array.Unboxed
  
  import Data.Ratio
  
  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
      f :: Int -> UArray Int Char
  
      f size@(I# size#)
        = runST (
              -- allocate an array of the specified size
            newArray_ (0, (size-1))       >>= \ arr# ->
  
              -- fill in all elements; elem i has "i" put in it
            fill_in arr# 0# (size# -# 1#) >>
  
              -- freeze the puppy:
            freeze arr#
          )
  
      fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s ()
  
      fill_in arr_in# first# last#
        = if isTrue# (first# ># last#)
          then return ()
          else writeArray arr_in# (I# first#) ((chr (I# first#))) >>
               fill_in arr_in# (first# +# 1#) last#
  
      lookup_range :: UArray Int Char -> Int# -> Int# -> [Char]
      lookup_range arr from# to#
        = if isTrue# (from# ># to#)
          then []
          else (arr ! (I# from#))
               : (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
      f :: Int -> UArray Int Int
  
      f size@(I# size#)
        = runST (
              -- allocate an array of the specified size
            newArray_ (0, (size-1))       >>= \ arr# ->
  
              -- fill in all elements; elem i has i^2 put in it
            fill_in arr# 0# (size# -# 1#) >>
  
              -- freeze the puppy:
            freeze arr#
          )
  
      fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s ()
  
      fill_in arr_in# first# last#
        = if isTrue# (first# ># last#)
          then return ()
          else writeArray arr_in# (I# first#) (I# (first# *# first#)) >>
               fill_in arr_in# (first# +# 1#) last#
  
      lookup_range :: UArray Int Int -> Int# -> Int# -> [Int]
      lookup_range arr from# to#
        = if isTrue# (from# ># to#)
          then []
          else (arr ! (I# from#))
               : (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
      f :: Int -> UArray Int (Ptr ())
  
      f size@(I# size#)
        = runST (
              -- allocate an array of the specified size
            newArray_ (0, (size-1))       >>= \ arr# ->
  
              -- fill in all elements; elem i has i^2 put in it
            fill_in arr# 0# (size# -# 1#) >>
  
              -- freeze the puppy:
            freeze arr#
          )
  
      fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s ()
  
      fill_in arr_in# first# last#
        = if isTrue# (first# ># last#)
          then return ()
          else writeArray arr_in# (I# first#)
                              (Ptr (int2Addr# (first# *# first#))) >>
               fill_in arr_in# (first# +# 1#) last#
  
      lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ]
      lookup_range arr from# to#
        = let
              a2i (Ptr a#) = I# (addr2Int# a#)
          in
          if isTrue# (from# ># to#)
          then []
          else (a2i (arr ! (I# from#)))
               : (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
      f :: Int -> UArray Int Float
  
      f size@(I# size#)
        = runST (
              -- allocate an array of the specified size
            newArray_ (0, (size-1))       >>= \ arr# ->
  
              -- fill in all elements; elem i has "i * pi" put in it
            fill_in arr# 0# (size# -# 1#) >>
  
              -- freeze the puppy:
            freeze arr#
          )
  
      fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s ()
  
      fill_in arr_in# first# last#
        = if isTrue# (first# ># last#)
          then return ()
  {-      else let e = ((fromIntegral (I# first#)) * pi)
               in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
               fill_in arr_in# (first# +# 1#) last#
  -}
          else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
               fill_in arr_in# (first# +# 1#) last#
  
      lookup_range :: UArray Int Float -> Int# -> Int# -> [Float]
      lookup_range arr from# to#
        = if isTrue# (from# ># to#)
          then []
          else (arr ! (I# from#))
               : (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
      f :: Int -> UArray Int Double
  
      f size@(I# size#)
        = runST (
              -- allocate an array of the specified size
            newArray_ (0, (size-1))       >>= \ arr# ->
  
              -- fill in all elements; elem i has "i * pi" put in it
            fill_in arr# 0# (size# -# 1#) >>
  
              -- freeze the puppy:
            freeze arr#
          )
  
      fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s ()
  
      fill_in arr_in# first# last#
        = if isTrue# (first# ># last#)
          then return ()
          else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
               fill_in arr_in# (first# +# 1#) last#
  
      lookup_range :: UArray Int Double -> Int# -> Int# -> [Double]
      lookup_range arr from# to#
        = if isTrue# (from# ># to#)
          then []
          else (arr ! (I# from#))
               : (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 (
            newArray (1, size) (3 % 5)    >>= \ arr# ->
            -- don't fill in the whole thing
            fill_in arr# 1 400            >>
            freeze arr#
          )
  
      fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()
  
      fill_in arr_in# first last
        = if (first > last)
          then return ()
          else writeArray arr_in# first (fromIntegral (first * first)) >>
               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)
  