Ticket #4004: Benchmark.hs

{-# LANGUAGE ForeignFunctionInterface, MagicHash, UnboxedTuples, BangPatterns #-}

module Main (
  main
) where

import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Data.Time.Clock.POSIX
import Control.Monad
import Control.Concurrent.MVar
import qualified Data.ByteString.Char8 as BS

benchmarkIt (name, task) = do
  t1 <- getPOSIXTime
  sequence_ $ replicate 1000000000 task
  t2 <- getPOSIXTime
  putStrLn $ name ++ ": " ++  show ((fromIntegral $ round ((t2 - t1)*1000))*1e-3) ++ " ns"

main =
  mapM_ benchmarkIt [
    ("withCString", withCString "abracadabra" $ ((\ptr -> return ()) :: CString -> IO () )),
    ("alloca", alloca $ ((\ptr -> return ()) :: Ptr Int -> IO ())),
    ("allocaBytes", allocaBytes 40 $ ((\ptr -> return ()) :: Ptr Int -> IO ())),
    ("mallocForeignPointer", (mallocForeignPtr :: IO (ForeignPtr Int)) >> return () ),
    ("bytestring", (BS.useAsCStringLen (BS.pack "abracadabra")) (\cstr -> BS.packCStringLen cstr >> return ()) ),
    ("mvar", do
      mv <- newEmptyMVar
      putMVar mv 12345
      modifyMVar_ mv $! (\v -> return $! v+1)
      takeMVar mv
      return ()
      ),
    ("alloca+advancePtr", alloca $ \ptr -> let ptr' = advancePtr ptr 3 in if ptr' == (nullPtr::Ptr Int) then fail "miserably" else return ()),
    ("new/finalizerFree", new (12345::CLong) >>= free),
    ("with", with 'c' $ \ptr -> return ())
  ]