Commit 46cc1b32 authored by sof's avatar sof
Browse files

[project @ 1997-06-05 23:06:55 by sof]

new test
parent 14720572
--!!! mutable Double array test (ncg test)
--
module Main ( main ) where
import PrelBase --ghc1.3
import GlaExts
import ST
import Ratio -- 1.3
import Array -- 1.3
main = --primIOToIO (newDoubleArray (0,1) >>= \ arr -> readDoubleArray arr 0) >>= print
putStr test_doubles
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:
freezeDoubleArray arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then returnST ()
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#)
--!!! Tickled a bug in core2stg
--!!! (CoreSyn.Coerce constructors were not peeled off
--!!! when converting CoreSyn.App)
module Main where
import GlaExts
getData :: String -> PrimIO ()
getData filename = case leng filename of {0 -> return ()}
leng :: String -> Int
leng [] = 0 --case ls of {[] -> 0 ; (_:xs) -> 1 + leng xs }
leng ls = leng ls
f [] [] = []
f xs ys = f xs ys
main =
primIOToIO (
(return ()) >>= \ _ ->
case f [] [] of { [] -> getData [] })
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment