summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/simplCore/should_compile/T4945.hs
blob: fba6e61ad6a18581fc8f77e8ba53e4d3c2693a10 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
module Main where

import Data.Int
import Data.Array.Base
import Data.Array.ST
import Control.Monad.ST
import System.Environment

main :: IO ()
main = do
  [_nr, _len] <- getArgs
  let nRounds = read _nr :: Int
      len = read _len :: Int
  stToIO $ do
    arr <- newArray (1, len) 0
   
    let spin :: STUArray s Int Int -> Int -> Int -> Int -> ST s ()
        spin _   r i n | i > n = return ()
        spin arr r i n = do x <- unsafeRead arr i
                            unsafeWrite arr i $ x + r
                            spin arr r (i + 1) n
       
        loop :: STUArray s Int Int -> Int -> ST s ()
        loop _   r | r > nRounds = return ()
        loop arr r = do
            k <- getNumElements arr
            spin arr r 0 (k - 1)
            loop arr (r + 1)
   
    loop arr 1