/mobile Handheld Friendly website

 performance measurements

Each table row shows performance measurements for this Haskell GHC program with a particular command-line input value N.

 N  CPU secs Elapsed secs Memory KB Code B ≈ CPU Load
60,0000.030.03?989  0% 25% 0% 100%
600,0000.400.41284989  5% 7% 0% 100%
6,000,0005.815.821,996989  1% 3% 1% 100%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read chameneos-redux benchmark to see what this program should do.

 notes

The Glorious Glasgow Haskell Compilation System, version 7.8.1

 chameneos-redux Haskell GHC #4 program source code

{- The Computer Language Benchmarks Game
   http://benchmarksgame.alioth.debian.org/
   Written by Tom Pledger, 13 Nov 2006. modified by Don Stewart
   Updated for chameneos-redux by Spencer Janssen, 27 Nov 2007
   Modified by Péter Diviánszky, 19 May 2010
   Modified by Louis Wasserman, 14 June 2010

   Should be compiled with -O2 -threaded -fvia-c -optc-O3 and run with +RTS -N<number of cores>.
   -}

import Control.Concurrent
import Control.Monad
import Data.Char
import Data.IORef
import System.Environment
import System.IO
import GHC.Conc
import Foreign hiding (complement)

newtype Color = C Int deriving (Storable,Enum)

#define Y (C 2)
#define R (C 1)
#define B (C 0)

instance Show Color where
	show Y = "yellow"
	show R = "red"
	show B = "blue"

complement :: Color -> Color -> Color
complement !a !b = case a of
    B -> case b of R -> Y; B -> B; _ -> R
    R -> case b of B -> Y; R -> R; _ -> B
    Y -> case b of B -> R; Y -> Y; _ -> B

type Chameneous = Ptr Color
data MP = Nobody !Int | Somebody !Int !Chameneous !(MVar Chameneous)

arrive :: MVar MP -> MVar (Int, Int) -> Chameneous -> IO ()
arrive !mpv !finish !ch = do
    waker <- newEmptyMVar
    let inc x = (fromEnum (ch == x) +)
        go !t !b = do
            w <- takeMVar mpv
            case w of
                Nobody 0
                 -> do
                    putMVar mpv w
                    putMVar finish (t, b)
  		Nobody q -> do
                    putMVar mpv $ Somebody q ch waker
                    ch' <- takeMVar waker
                    go (t+1) $ inc ch' b

                Somebody q ch' waker' -> do
                    c  <- peek ch
                    c' <- peek ch'
                    let !c'' = complement c c'
                    poke ch  c''
                    poke ch' c''
                    putMVar waker' ch
                    let !q' = q-1
                    putMVar mpv $ Nobody q'
                    go (t+1) $ inc ch' b
    go 0 0

showN = unwords . map ((digits !!) . digitToInt) . show

digits = words "zero one two three four five six seven eight nine"

run :: Int -> Int -> [Color] -> IO (IO ())
run n cpu cs = do
    fs    <- replicateM (length cs) newEmptyMVar
    mpv   <- newMVar (Nobody n)
    withArrayLen cs $ \ n cols -> do
    	zipWithM_ ((forkOn cpu .) . arrive mpv) fs (take n (iterate (`advancePtr` 1) cols))

    	return $ do
	  putStrLn . map toLower . unwords . ([]:) . map show $ cs
	  ns    <- mapM takeMVar fs
	  putStr . map toLower . unlines $ [unwords [show n, showN b] | (n, b) <- ns]
	  putStrLn . (" "++) . showN . sum . map fst $ ns
	  putStrLn ""

main = do
    putStrLn . map toLower . unlines $
        [unwords [show a, "+", show b, "->", show $ complement a b]
            | a <- [B..Y], b <- [B..Y]]

    n <- readIO . head =<< getArgs
    actions <- zipWithM (run n) [0..] [[B..Y],[B,R,Y,R,Y,B,R,Y,R,B]]
    sequence_ actions

 make, command-line, and program output logs

Mon, 14 Apr 2014 19:37:10 GMT

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

COMMAND LINE:
./chameneosredux.ghc-4.ghc_run  6000000

PROGRAM OUTPUT:
blue + blue -> blue
blue + red -> yellow
blue + yellow -> red
red + blue -> yellow
red + red -> red
red + yellow -> blue
yellow + blue -> red
yellow + red -> blue
yellow + yellow -> yellow

 blue red yellow
3853037 zero
4107323 zero
4039640 zero
 one two zero zero zero zero zero zero

 blue red yellow red yellow blue red yellow red blue
1200000 zero
1200001 zero
1200001 zero
1200001 zero
1200000 zero
1200000 zero
1200000 zero
1199999 zero
1199999 zero
1199999 zero
 one two zero zero zero zero zero zero

Revised BSD license

  Home   Conclusions   License   Play