The Computer Language
Benchmarks Game

thread-ring Haskell GHC program

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
-- Contributed by Jed Brown with improvements by Spencer Janssen, Don Stewart and Alex Mason
--
-- Compile with: <ghc> --make -O2 -threaded threadring.ghc-4.hs -o threadring.ghc-4.ghc_run

import Control.Monad
import Control.Concurrent
import System.Environment
import GHC.Conc

ring = 503

new ret l i = do
  r <- newEmptyMVar
  forkOn numCapabilities (thread ret i l r)
  return r


thread :: MVar () -> Int -> MVar Int -> MVar Int -> IO ()
thread ret i l r = go
  where go = do
          m <- takeMVar l
          if m > 1
              then (putMVar r $! m - 1) >> go
              else print i >> putMVar ret ()

main = do
  a <- newMVar . read . head =<< getArgs
  ret <- newEmptyMVar
  z <- foldM (new ret) a [2..ring]
  forkOn numCapabilities (thread ret 1 z a)
  takeMVar ret
    

NOTES:
64-bit Ubuntu quad core
The Glorious Glasgow Haskell Compilation System, version 8.4.1


Fri, 23 Mar 2018 19:36:51 GMT

MAKE:
mv threadring.ghc threadring.hs
/opt/src/ghc-8.4.1/bin/ghc --make -fllvm -O2 -XBangPatterns -threaded -rtsopts  threadring.hs -o threadring.ghc_run
[1 of 1] Compiling Main             ( threadring.hs, threadring.o )
Linking threadring.ghc_run ...
rm threadring.hs

1.43s to complete and log all make actions

COMMAND LINE:
./threadring.ghc_run +RTS -N4 -RTS 50000000

PROGRAM OUTPUT:
292