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 Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe