Ticket #8138: Role.hs

File Role.hs, 1.1 KB (added by gmainland, 23 months ago)
Line 
1{-# LANGUAGE ScopedTypeVariables #-}
2
3module Main where
4
5import Control.Monad.ST
6import Data.Primitive
7
8main :: IO ()
9main = do
10    let xs :: [Float] = runST $ do
11        barr <- mutableByteArrayFromList [1..fromIntegral n::Float]
12        peekByteArray n barr
13    print xs
14  where
15    n = 13
16
17mutableByteArrayFromList :: forall s a . (Prim a)
18                         => [a]
19                         -> ST s (MutableByteArray s)
20mutableByteArrayFromList xs = do
21    arr <- newByteArray (length xs*sizeOf (undefined :: a))
22    loop arr 0 xs
23    return arr
24  where
25    loop :: (Prim a) => MutableByteArray s -> Int -> [a] -> ST s ()
26    loop _ _ [] = return ()
27
28    loop arr i (x : xs) = do
29        writeByteArray arr i x
30        loop arr (i+1) xs
31
32peekByteArray :: (Prim a)
33              => Int
34              -> MutableByteArray s
35              -> ST s [a]
36peekByteArray n arr =
37    loop 0 arr
38  where
39    loop :: (Prim a)
40         => Int
41         -> MutableByteArray s
42         -> ST s [a]
43    loop i _ | i >= n = return []
44
45    loop i arr = do
46        x  <- readByteArray arr i
47        xs <- loop (i+1) arr
48        return (x : xs)