On Tue, Jan 05, 2010 at 04:06:09PM -0800, Mark Lentczner wrote:
> In preparing the speed ups in uuid-0.1.2, I investigated
> various ways to store 16 bytes of data in a Haskell object.
> Surprisingly, storing as 4 Word32 values in a standard data
> type worked best for that application.
However, on an Core 2 Duo in x86-64 mode with GHC 6.10, 2 Word64
values wins over 4 Word32 values. Attached is the modified
source code. Here is the summary between them
equal-itself/words 76.41 ns
equal-itself/words64 64.52 ns
equal-same/words 79.64 ns
equal-same/words64 67.85 ns
equal-differ/words 66.11 ns
equal-differ/words64 62.79 ns
compare-same/words 80.59 ns
compare-same/words64 68.68 ns
compare-differ/words 67.14 ns
compare-differ/words64 64.22 ns
toList-and-sum/words 991.32 ns
toList-and-sum/words64 839.45 ns
map-and-sum/words 1.04 us
map-and-sum/words64 1.12 us
fold-and-sum/words 882.88 ns
fold-and-sum/words64 755.98 ns
fromList-and-eq/words 740.41 ns
fromList-and-eq/words64 749.07 ns
build-and-eq/words 484.54 ns
build-and-eq/words64 447.81 ns
unfold-and-eq/words 577.12 ns
unfold-and-eq/words64 541.46 ns
Cheers,
--
Felipe.
{-# LANGUAGE RankNTypes #-}
{-
This program benchmarks several different ways to store 16 bytes in type.
-}
import Criterion.Main
import Data.Bits
import Data.List
import Data.Maybe
import Data.Word
import qualified Data.Array as A
import qualified Data.Array.Unboxed as U
import qualified Data.Array.Vector as V
import qualified Data.ByteString as B
data InBytes = BY !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
!Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
deriving (Eq, Ord)
data InWords = WO !Word32 !Word32 !Word32 !Word32
deriving (Eq, Ord)
data InWords64 = WO64 !Word64 !Word64
deriving (Eq, Ord)
data InList = LI [Word8] deriving (Eq, Ord)
data InByteString = BS B.ByteString deriving (Eq, Ord)
data InArray = AR (A.Array Int Word8) deriving (Eq, Ord)
data InUArray = UA (U.UArray Int Word8) deriving (Eq, Ord)
data InVector = VE (V.UArr Word8) deriving (Eq)
instance Ord InVector where
compare (VE va) (VE vb) = V.foldlU lexo EQ $ V.zipU va vb
where lexo EQ (a V.:*: b) = compare a b
lexo r _ = r
class TestSubject d where
toList :: d -> [Word8]
fromList :: [Word8] -> Maybe d
mapBytes :: (Word8 -> a) -> d -> [a]
foldBytes :: (a -> Word8 -> a) -> a -> d -> a
unfoldBytes :: (a -> Maybe (Word8, a)) -> a -> Maybe d
build :: Word8 -> Word8 -> Word8 -> Word8
-> Word8 -> Word8 -> Word8 -> Word8
-> Word8 -> Word8 -> Word8 -> Word8
-> Word8 -> Word8 -> Word8 -> Word8 -> d
build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
d [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]
where d = fromJust . fromList
instance TestSubject InBytes where
toList (BY b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf) =
[b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]
fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
Just $ BY b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
fromList _ = Nothing
mapBytes f (BY b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf) =
[f b0, f b1, f b2, f b3, f b4, f b5, f b6, f b7,
f b8, f b9, f ba, f bb, f bc, f bd, f be, f bf]
foldBytes f z (BY b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf) =
f' bf $ f' be $ f' bd $ f' bc $ f' bb $ f' ba $ f' b9 $ f' b8 $
f' b7 $ f' b6 $ f' b5 $ f' b4 $ f' b3 $ f' b2 $ f' b1 $ f' b0 $ z
where f' = flip f
unfoldBytes f z = do
(b0, a0) <- f z
(b1, a1) <- f a0
(b2, a2) <- f a1
(b3, a3) <- f a2
(b4, a4) <- f a3
(b5, a5) <- f a4
(b6, a6) <- f a5
(b7, a7) <- f a6
(b8, a8) <- f a7
(b9, a9) <- f a8
(ba, aa) <- f a9
(bb, ab) <- f aa
(bc, ac) <- f ab
(bd, ad) <- f ac
(be, ae) <- f ad
(bf,_af) <- f ae
return (BY b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf)
build = BY
instance TestSubject InWords where
toList (WO w0 w1 w2 w3) =
[byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
Just $ build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
fromList _ = Nothing
mapBytes f (WO w0 w1 w2 w3) =
[f $ byte 3 w0, f $ byte 2 w0, f $ byte 1 w0, f $ byte 0 w0,
f $ byte 3 w1, f $ byte 2 w1, f $ byte 1 w1, f $ byte 0 w1,
f $ byte 3 w2, f $ byte 2 w2, f $ byte 1 w2, f $ byte 0 w2,
f $ byte 3 w3, f $ byte 2 w3, f $ byte 1 w3, f $ byte 0 w3]
foldBytes f z (WO w0 w1 w2 w3) =
f' (byte 3 w0) $ f' (byte 2 w0) $ f' (byte 1 w0) $ f' (byte 0 w0) $
f' (byte 3 w1) $ f' (byte 2 w1) $ f' (byte 1 w1) $ f' (byte 0 w1) $
f' (byte 3 w2) $ f' (byte 2 w2) $ f' (byte 1 w2) $ f' (byte 0 w2) $
f' (byte 3 w3) $ f' (byte 2 w3) $ f' (byte 1 w3) $ f' (byte 0 w3) $ z
where f' = flip f
unfoldBytes f z = do
(b0, a0) <- f z
(b1, a1) <- f a0
(b2, a2) <- f a1
(b3, a3) <- f a2
(b4, a4) <- f a3
(b5, a5) <- f a4
(b6, a6) <- f a5
(b7, a7) <- f a6
(b8, a8) <- f a7
(b9, a9) <- f a8
(ba, aa) <- f a9
(bb, ab) <- f aa
(bc, ac) <- f ab
(bd, ad) <- f ac
(be, ae) <- f ad
(bf,_af) <- f ae
return (build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf)
build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = WO w0 w1 w2 w3
where w0 = word b0 b1 b2 b3
w1 = word b4 b5 b6 b7
w2 = word b8 b9 ba bb
w3 = word bc bd be bf
-- |Build a Word32 from four Word8 values, presented in big-endian order
word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
word a b c d = (fromIntegral a `shiftL` 24)
.|. (fromIntegral b `shiftL` 16)
.|. (fromIntegral c `shiftL` 8)
.|. (fromIntegral d )
-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
byte :: Int -> Word32 -> Word8
byte i w = fromIntegral (w `shiftR` (i * 8))
instance TestSubject InWords64 where
toList (WO64 w0 w1) =
[byte64 7 w0, byte64 6 w0, byte64 5 w0, byte64 4 w0,
byte64 3 w0, byte64 2 w0, byte64 1 w0, byte64 0 w0,
byte64 7 w1, byte64 6 w1, byte64 5 w1, byte64 4 w1,
byte64 3 w1, byte64 2 w1, byte64 1 w1, byte64 0 w1]
fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
Just $ build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
fromList _ = Nothing
mapBytes f (WO64 w0 w1) =
[f $ byte64 7 w0, f $ byte64 6 w0, f $ byte64 5 w0, f $ byte64 4 w0,
f $ byte64 3 w0, f $ byte64 2 w0, f $ byte64 1 w0, f $ byte64 0 w0,
f $ byte64 7 w1, f $ byte64 6 w1, f $ byte64 5 w1, f $ byte64 4 w1,
f $ byte64 3 w1, f $ byte64 2 w1, f $ byte64 1 w1, f $ byte64 0 w1]
foldBytes f z (WO64 w0 w1) =
f' (byte64 7 w0) $ f' (byte64 6 w0) $ f' (byte64 5 w0) $ f' (byte64 4 w0) $
f' (byte64 3 w0) $ f' (byte64 2 w0) $ f' (byte64 1 w0) $ f' (byte64 0 w0) $
f' (byte64 7 w1) $ f' (byte64 6 w1) $ f' (byte64 5 w1) $ f' (byte64 4 w1) $
f' (byte64 3 w1) $ f' (byte64 2 w1) $ f' (byte64 1 w1) $ f' (byte64 0 w1) $ z
where f' = flip f
unfoldBytes f z = do
(b0, a0) <- f z
(b1, a1) <- f a0
(b2, a2) <- f a1
(b3, a3) <- f a2
(b4, a4) <- f a3
(b5, a5) <- f a4
(b6, a6) <- f a5
(b7, a7) <- f a6
(b8, a8) <- f a7
(b9, a9) <- f a8
(ba, aa) <- f a9
(bb, ab) <- f aa
(bc, ac) <- f ab
(bd, ad) <- f ac
(be, ae) <- f ad
(bf,_af) <- f ae
return (build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf)
build b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = WO64 w0 w1
where w0 = word64 b0 b1 b2 b3 b4 b5 b6 b7
w1 = word64 b8 b9 ba bb bc bd be bf
-- |Build a Word64 from eight Word8 values, presented in big-endian order
word64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64
word64 a b c d e f g h = (fromIntegral a `shiftL` 56)
.|. (fromIntegral b `shiftL` 48)
.|. (fromIntegral c `shiftL` 40)
.|. (fromIntegral d `shiftL` 32)
.|. (fromIntegral e `shiftL` 24)
.|. (fromIntegral f `shiftL` 16)
.|. (fromIntegral g `shiftL` 8)
.|. (fromIntegral h )
-- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0,
byte64 :: Int -> Word64 -> Word8
byte64 i w = fromIntegral (w `shiftR` (i * 8))
instance TestSubject InList where
toList (LI bs) = bs
fromList = Just . LI
mapBytes f (LI bs) = map f bs
foldBytes f z (LI bs) = foldl' f z bs
unfoldBytes f z = Just $ LI $ take 16 $ unfoldr f z
instance TestSubject InByteString where
toList (BS bs) = B.unpack bs
fromList = Just . BS . B.pack
mapBytes f (BS bs) = B.foldr (\b r -> f b : r) [] bs
foldBytes f z (BS bs) = B.foldl' f z bs
unfoldBytes f z = Just $ BS $ fst $ B.unfoldrN 16 f z
instance TestSubject InArray where
toList (AR ar) = A.elems ar
fromList = Just . AR . A.listArray (0,15)
mapBytes f (AR ar) = map f $ A.elems ar
foldBytes f z (AR ar) = foldl' f z $ A.elems ar
unfoldBytes f z = Just $ AR $ A.listArray (0,15) $ unfoldr f z
instance TestSubject InUArray where
toList (UA ua) = U.elems ua
fromList = Just . UA . U.listArray (0,15)
mapBytes f (UA ua) = map f $ U.elems ua
foldBytes f z (UA ua) = foldl' f z $ U.elems ua
unfoldBytes f z = Just $ UA $ U.listArray (0,15) $ unfoldr f z
instance TestSubject InVector where
toList (VE ve) = V.fromU ve
fromList = Just . VE . V.toU
mapBytes f (VE ve) = V.foldrU (\b r -> f b : r) [] ve
foldBytes f z (VE ve) = V.foldlU f z ve
unfoldBytes f z = Just $ VE $ V.unfoldU 16 (sm .f) z
where sm (Just (a, b)) = V.JustS (a V.:*: b)
sm Nothing = V.NothingS
data TestContext d = Ctx { v1a, v1b, v2 :: d, v2b0 :: Word8 }
buildContext :: (TestSubject d) => TestContext d
buildContext = Ctx {
v1a = build 0x10 0x11 0x12 0x13 0x14 0x15 0x16 0x17
0x18 0x19 0x1a 0x1b 0x1c 0x1d 0x1e 0x1f,
v1b = fromJust $ fromList [16..31],
v2 = fromJust $ fromList [200..215],
v2b0 = 200
}
byteContext :: TestContext InBytes; byteContext = buildContext
wordContext :: TestContext InWords; wordContext = buildContext
word64Context :: TestContext InWords64; word64Context = buildContext
listContext :: TestContext InList; listContext = buildContext
byteStringContext :: TestContext InByteString; byteStringContext = buildContext
arrayContext :: TestContext InArray; arrayContext = buildContext
uArrayContext :: TestContext InUArray; uArrayContext = buildContext
vectorContext :: TestContext InVector; vectorContext = buildContext
type TestComputation a =
forall d. (TestSubject d, Eq d, Ord d) => TestContext d -> a
bEach :: String -> TestComputation a -> Benchmark
bEach name f = bgroup name [
bench "bytes" $ B f byteContext,
bench "words" $ B f wordContext,
bench "words64" $ B f word64Context,
bench "list" $ B f listContext,
bench "byteString" $ B f byteStringContext,
bench "array" $ B f arrayContext,
bench "uArray" $ B f uArrayContext,
bench "vector" $ B f vectorContext
]
main :: IO ()
main = defaultMain [
bEach "equal-itself" (\ctx -> v1a ctx == v1a ctx),
bEach "equal-same" (\ctx -> v1a ctx == v1b ctx),
bEach "equal-differ" (\ctx -> v1a ctx == v2 ctx),
bEach "compare-same" (\ctx -> compare (v1a ctx) (v1b ctx)),
bEach "compare-differ" (\ctx -> compare (v1a ctx) (v2 ctx)),
bEach "toList-and-sum" (sum . toList . v1a),
bEach "map-and-sum" (sum . mapBytes toInt . v2),
bEach "fold-and-sum" (foldBytes (flip $ (+) . toInt) 0 . v2),
bEach "fromList-and-eq"
(\ctx -> let n = v2b0 ctx in
(fromJust . fromList) [n..n+15] == v2 ctx),
bEach "build-and-eq"
(\ctx -> let n = v2b0 ctx in
build n (n+1) (n+2) (n+3) (n+4) (n+5) (n+6) (n+7)
(n+8) (n+9) (n+10) (n+11) (n+12) (n+13) (n+14) (n+15)
== v2 ctx),
bEach "unfold-and-eq"
(\ctx -> fromJust (unfoldBytes counter (v2b0 ctx)) == v2 ctx)
]
where toInt :: Word8 -> Int
toInt = fromIntegral
counter a = Just (a, a+1)
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
