The Computer Language
Benchmarks Game

thread-ring Haskell GHC program

source code

-- 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, command-line, and program output

NOTES:
32-bit Ubuntu one core
The Glorious Glasgow Haskell Compilation System, version 8.0.1


Sun, 22 May 2016 18:36:12 GMT

MAKE:
mv threadring.ghc threadring.hs
/usr/local/src/ghc-8.0.1/bin/ghc --make -fllvm -O2 -XBangPatterns -rtsopts -threaded threadring.hs -o threadring.ghc_run
[1 of 1] Compiling Main             ( threadring.hs, threadring.o )
Linking threadring.ghc_run ...
rm threadring.hs
1.51s to complete and log all make actions

COMMAND LINE:
./threadring.ghc_run  50000000

PROGRAM OUTPUT:
292