Ticket #2374: Ptr.hs

File Ptr.hs, 1.1 KB (added by dolio, 7 years ago)

Slightly faster version of the Ptr benchmark for low array sizes (same on larger arrays).

Line 
1{-# OPTIONS_GHC -fglasgow-exts #-}
2
3module Main (main) where
4
5import Prelude hiding (reverse)
6
7import Control.Monad
8
9import GHC.Base
10import GHC.IOBase
11import GHC.Ptr
12
13import Foreign
14
15import System.Environment
16
17reverse :: Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
18reverse a i j s
19  | i <# j = case readIntOffAddr# a i s    of { (# s, x #) ->
20             case readIntOffAddr# a j s    of { (# s, y #) ->
21             case writeIntOffAddr# a j x s of { s ->
22             case writeIntOffAddr# a i y s of { s ->
23             reverse a (i +# 1#) (j -# 1#) s }}}}
24  | otherwise = s
25
26bench :: Int# -> Int# -> IO ()
27bench k n = do p@(Ptr a) <- mallocArray (I# n) :: IO (Ptr Int)
28               fill a n
29               IO (go a k)
30               free p
31 where
32 go a 0# s = (# s, () #)
33 go a i  s = case reverse a 0# (n -# 1#) s of s -> go a (i -# 1#) s
34
35fill :: Addr# -> Int# -> IO ()
36fill a n = IO (go 0#)
37 where
38 go i s
39   | i <# n    = case writeIntOffAddr# a i i s of s -> go (i +# 1#) s
40   | otherwise = (# s, () #)
41
42main = do (I# k:I# n:_) <- map read `fmap` getArgs
43          bench k n
44          putStrLn "Done."