Vector XOR Benchmark Game

.gitignore

.stack-work/

README.rst

Vector XOR Benchmark Game

Here's a little challenge: take a peak at Xorme.hs, and decide which of 2 implementations (calculateParity1 or calculateParity2), which (assuming the input vectors are of same length) calculate the very same result (according to QuickCheck) is the fastest.

Validate they're similar:

$ stack test
...
Properties
  equal: OK (0.03s)
    +++ OK, passed 100 tests.

All 1 tests passed (0.03s)
Completed all 2 actions.

Now run a benchmark (I left out the results, of course):

$ stack bench
...

benchmarking calculateParity1
time                 ----- --   ------ -- .. ----- ---
                     ----- --   ------ -- .. ----- ---
mean                 ----- --   ------ -- .. ----- ---
std dev              ----- --   ------ -- .. ----- ---

benchmarking calculateParity2
time                 ----- --   ------ -- .. ----- ---
                     ----- --   ------ -- .. ----- ---
mean                 ----- --   ------ -- .. ----- ---
std dev              ----- --   ------ -- .. ----- ---

Benchmark xorme-bench: FINISH
Completed all 2 actions.

Bench.hs

module Main (main) where

import Control.Monad.ST.Unsafe (unsafeIOToST)
import Data.Word (Word8)
import Foreign.C (CSize(..), CUChar(..))
import Foreign.ForeignPtr (castForeignPtr)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (pokeElemOff)
import Foreign.Marshal.Array (allocaArray)

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Storable.Mutable as MSV

import Criterion.Main

import Xorme (calculateParity1, calculateParity2)

foreign import ccall unsafe "xorme_xor" c_xorme_xor ::
    Ptr (Ptr CUChar) -> CUChar -> CSize -> Ptr CUChar -> IO ()

calculateParityC :: V.Vector (SV.Vector Word8) -> SV.Vector Word8
calculateParityC v = SV.create $ do
    vec <- MSV.new len
    let (fp, len') = MSV.unsafeToForeignPtr0 vec
    unsafeIOToST $ do
        let vec' = MSV.unsafeFromForeignPtr0 (castForeignPtr fp) len'
        allocaArray 3 $ \inputs ->
            SV.unsafeWith (V.unsafeIndex v 0) $ \ptr1 ->
                SV.unsafeWith (V.unsafeIndex v 1) $ \ptr2 ->
                    SV.unsafeWith (V.unsafeIndex v 2) $ \ptr3 -> do
                        pokeElemOff inputs 0 (castPtr ptr1)
                        pokeElemOff inputs 1 (castPtr ptr2)
                        pokeElemOff inputs 2 (castPtr ptr3)
                        MSV.unsafeWith vec' $ \output ->
                            c_xorme_xor inputs 3 (fromIntegral len) output
    return vec
  where
    len = SV.length (V.head v)

main :: IO ()
main = defaultMain [
      bench "calculateParity1" $ nf calculateParity1 vectors
    , bench "calculateParity2" $ nf calculateParity2 vectors
    , bench "calculateParityC" $ nf calculateParityC vectors'
    ]
  where
    _1M = 1024 * 1024
    vectors :: V.Vector (UV.Vector Word8)
    vectors = V.unfoldrN 3 (\rest ->
                let (h, t) = splitAt _1M rest in
                Just (UV.fromListN _1M h, t))
                (cycle [minBound..])
    vectors' :: V.Vector (SV.Vector Word8)
    vectors' = V.map UV.convert vectors

Setup.hs

import Distribution.Simple
main = defaultMain

stack.yaml

resolver: lts-3.5

Test.hs

module Main (main) where

import Data.Word (Word8)

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV

import Test.Tasty (defaultMain, testGroup)
import Test.Tasty.QuickCheck (testProperty)

import Test.QuickCheck (Arbitrary(..), Gen, getPositive, vector)

import Xorme (calculateParity1, calculateParity2)

newtype Input = Input (V.Vector (UV.Vector Word8))
  deriving (Show, Eq)

instance Arbitrary Input where
    arbitrary = do
        count <- getPositive <$> arbitrary
        len <- arbitrary
        Input <$> V.replicateM count (sizedVector len)
      where
        sizedVector :: Int -> Gen (UV.Vector Word8)
        sizedVector len = UV.fromListN len <$> vector len

prop_equal :: Input -> Bool
prop_equal (Input v) = calculateParity1 v == calculateParity2 v

main :: IO ()
main = defaultMain $
    testGroup "Properties" [
          testProperty "equal" prop_equal
        ]

xorme.c

#include <stdlib.h>
#include <stdint.h>

void __attribute__((nonnull)) xorme_xor(const uint8_t *restrict *restrict inputs, const uint8_t count, const size_t length, uint8_t *restrict output) {
        size_t i = 0;

        for(i = 0; i < length; i++) {
                uint8_t j = 0,
                        r = 0;

                for(j = 0; j < count; j++) {
                        r ^= inputs[j][i];
                }

                output[i] = r;
        }
}

xorme.cabal

name:                xorme
version:             0.0.0.0
synopsis:            XOR-based parity benchmark
license:             BSD3
author:              Nicolas Trangez
build-type:          Simple
cabal-version:       >=1.10

library
  exposed-modules:     Xorme
  ghc-options:         -fllvm -O2 -g
  build-depends:       base >= 4.8 && < 4.9
                     , vector >= 0.10 && < 0.11
  default-language:    Haskell2010

test-suite xorme-test
  type:                exitcode-stdio-1.0
  main-is:             Test.hs
  other-modules:       Xorme
  ghc-options:         -rtsopts -O2 -fllvm -g
  build-depends:       base >= 4.8 && < 4.9
                     , vector >= 0.10 && < 0.11
                     , tasty >= 0.10 && < 0.11
                     , tasty-quickcheck >= 0.8 && < 0.9
                     , QuickCheck >= 2.8 && < 2.9
                     , xorme
  default-language:    Haskell2010

benchmark xorme-bench
  type:                exitcode-stdio-1.0
  main-is:             Bench.hs
  other-modules:       Xorme
  c-sources:           xorme.c
  ghc-options:         -rtsopts -O2 -fllvm -g
  cc-options:          -O3 -Wall
  build-depends:       base >= 4.8 && < 4.9
                     , vector >= 0.10 && < 0.11
                     , criterion > 1.1 && < 1.2
                     , xorme
  default-language:    Haskell2010

Xorme.hs

module Xorme (
      calculateParity1
    , calculateParity2
    ) where

import Data.Bits (xor)
import Data.Word (Word8)

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV

calculateParity1 :: V.Vector (UV.Vector Word8) -> UV.Vector Word8
calculateParity1 = V.foldr1 (UV.zipWith xor)

calculateParity2 :: V.Vector (UV.Vector Word8) -> UV.Vector Word8
calculateParity2 v = UV.generate len (\idx -> V.foldr' (\r a -> UV.unsafeIndex r idx `xor` a) 0 v)
  where
    len = UV.length (V.head v)