<commit_before>-- !!! simple tests of primitive arrays
--
module Main ( main ) where

import PrelBase
import PrelAddr(indexAddrOffAddr)
import ST
import IOExts
import ST
import MutableArray
import ByteArray
import PrelAddr
import Int( Num(fromInt) )
import CString (packString)
	
import Ratio
import Array

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#)

foreign label "stdout" addrOfStdout :: Addr

stdout :: Addr
stdout = indexAddrOffAddr addrOfStdout 0

test_chars :: String
test_chars
  = let str = reverse "Now is the time for all good men to come to...\n"
    in
    unsafePerformIO (
	_ccall_ fprintf stdout (packString "%d %s\n") (93::Int) (packString str) >>
	_ccall_ fflush  stdout >>
	return ""
	)

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

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

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newIntArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexIntArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newAddrArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeAddrArray arr_in# (I# first#)
			    (A# (int2Addr# (first# *# first#))) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
    lookup_range arr from# to#
      = let
	    a2i (A# a#) = I# (addr2Int# a#)
	in
	if (from# ># to#)
	then []
	else (a2i (indexAddrArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newFloatArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
{-	else let e = ((fromInt (I# first#)) * pi)
	     in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
	     fill_in arr_in# (first# +# 1#) last#
-}
	else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexFloatArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newDoubleArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexDoubleArray 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 (
	  newSTArray (1, size) (3 % 5)	>>= \ arr# ->
	  -- don't fill in the whole thing
	  fill_in arr# 1 400		>>
	  freezeSTArray arr#
	)

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

    fill_in arr_in# first last
      = if (first > last)
	then return ()
	else writeSTArray arr_in# first (fromInt (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)
<commit_msg>[project @ 2001-01-11 17:33:32 by simonmar] s/PrelAddr/Addr<commit_after>-- !!! simple tests of primitive arrays
--
module Main ( main ) where

import PrelBase
import Addr
import ST
import IOExts
import ST
import MutableArray
import ByteArray
import Int( Num(fromInt) )
import CString (packString)
	
import Ratio
import Array

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#)

foreign label "stdout" addrOfStdout :: Addr

stdout :: Addr
stdout = indexAddrOffAddr addrOfStdout 0

test_chars :: String
test_chars
  = let str = reverse "Now is the time for all good men to come to...\n"
    in
    unsafePerformIO (
	_ccall_ fprintf stdout (packString "%d %s\n") (93::Int) (packString str) >>
	_ccall_ fflush  stdout >>
	return ""
	)

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

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

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newIntArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexIntArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newAddrArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeAddrArray arr_in# (I# first#)
			    (A# (int2Addr# (first# *# first#))) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
    lookup_range arr from# to#
      = let
	    a2i (A# a#) = I# (addr2Int# a#)
	in
	if (from# ># to#)
	then []
	else (a2i (indexAddrArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newFloatArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
{-	else let e = ((fromInt (I# first#)) * pi)
	     in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
	     fill_in arr_in# (first# +# 1#) last#
-}
	else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexFloatArray 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 -> ByteArray Int

    f size@(I# size#)
      = runST (
	    -- allocate an array of the specified size
	  newDoubleArray (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:
	  freezeByteArray arr#
	)

    fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()

    fill_in arr_in# first# last#
      = if (first# ># last#)
	then return ()
	else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >>
	     fill_in arr_in# (first# +# 1#) last#

    lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
    lookup_range arr from# to#
      = if (from# ># to#)
	then []
	else (indexDoubleArray 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 (
	  newSTArray (1, size) (3 % 5)	>>= \ arr# ->
	  -- don't fill in the whole thing
	  fill_in arr# 1 400		>>
	  freezeSTArray arr#
	)

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

    fill_in arr_in# first last
      = if (first > last)
	then return ()
	else writeSTArray arr_in# first (fromInt (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)

{'fraction_non_alphanumeric': 0.1922679524711555, 'fraction_numerical': 0.016359566040985016, 'mean_word_length': 2.1536790659788214, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 175, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1441433', 'n_tokens_mistral': 4493, 'n_tokens_neox': 4167, 'n_words': 1373}