Ticket #2387: Unboxed.hs

File Unboxed.hs, 1020 bytes (added by dolio, 6 years ago)

Manually unboxed version of the benchmark

Line 
1{-# LANGUAGE MagicHash, UnboxedTuples #-}
2
3module Main (main) where
4
5import Control.Monad.ST
6
7import GHC.ST
8import GHC.Prim
9import GHC.Base
10
11import System.Environment
12
13whileLoop :: Int# -> State# s -> (# State# s, Int# #)
14whileLoop = go 0#
15 where
16 go :: Int# -> Int# -> State# s -> (# State# s, Int# #)
17 go n k s
18   | k ==# 0#  = (# s, n #)
19   | otherwise = go (n +# 1#) (k -# 1#) s
20{-# INLINE whileLoop #-}
21
22mainLoop :: Int# -> Int# -> State# s -> (# State# s, Int #)
23mainLoop k n s = case whileLoop 40# s of { (# s', k' #) ->
24                 case k <=# k' of
25                   False ->
26                     case n of
27                       0# -> (# s', I# k #)
28                       _ -> mainLoop k (n -# 1#) s'
29                   True ->
30                     case n of
31                       0# -> (# s', I# k' #)
32                       _ -> mainLoop k' (n -# 1#) s' }
33
34mlWrapper :: Int -> Int -> ST s Int
35mlWrapper (I# k) (I# n) = ST (mainLoop k n)
36
37main = print =<< stToIO . mlWrapper 0 . read . head =<< getArgs