[commit: packages/binary] master: Optimize roll by using foldl' instead of foldr (1f643cb)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/1f643cbc973751605ec6a3ed0d93a6dab0bd0774

>---------------------------------------------------------------

commit 1f643cbc973751605ec6a3ed0d93a6dab0bd0774
Author: Bas van Dijk <v.dijk.bas at gmail.com>
Date:   Mon Sep 28 22:39:28 2015 +0200

    Optimize roll by using foldl' instead of foldr
    
    The "roll" benchmarks in the get executable show the difference:
    
      get roll
      benchmarking roll/foldr
      time                 547.4 ms   (537.8 ms .. 553.5 ms)
                           1.000 R²   (1.000 R² .. 1.000 R²)
      mean                 549.4 ms   (547.2 ms .. 550.4 ms)
      std dev              1.857 ms   (0.0 s .. 1.896 ms)
      variance introduced by outliers: 19% (moderately inflated)
    
      benchmarking roll/foldl'
      time                 434.7 ms   (426.4 ms .. 443.1 ms)
                           1.000 R²   (1.000 R² .. 1.000 R²)
      mean                 433.7 ms   (432.3 ms .. 434.7 ms)
      std dev              1.472 ms   (0.0 s .. 1.696 ms)
      variance introduced by outliers: 19% (moderately inflated)
    
    The "Integer/decode" benchmark shows the actual decoding speed.
    First the old implementation based on foldr:
    
      get Integer/decode
      benchmarking Integer/decode
      time                 552.9 ms   (540.2 ms .. 569.3 ms)
                           1.000 R²   (1.000 R² .. 1.000 R²)
      mean                 558.2 ms   (556.1 ms .. 559.3 ms)
      std dev              1.824 ms   (0.0 s .. 1.906 ms)
      variance introduced by outliers: 19% (moderately inflated)
    
    The new implementation based on foldl':
    
      get Integer/decode
      benchmarking Integer/decode
      time                 457.5 ms   (406.2 ms .. 505.6 ms)
                           0.998 R²   (0.994 R² .. 1.000 R²)
      mean                 455.9 ms   (448.3 ms .. 462.3 ms)
      std dev              10.11 ms   (0.0 s .. 11.02 ms)
      variance introduced by outliers: 19% (moderately inflated)


>---------------------------------------------------------------

1f643cbc973751605ec6a3ed0d93a6dab0bd0774
 benchmarks/Get.hs        | 34 ++++++++++++++++++++++++++++++++--
 src/Data/Binary/Class.hs |  6 +++---
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/benchmarks/Get.hs b/benchmarks/Get.hs
index 26c2f98..191f585 100644
--- a/benchmarks/Get.hs
+++ b/benchmarks/Get.hs
@@ -12,10 +12,12 @@ import Criterion.Main
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Lazy as L
+import Data.Bits
 import Data.Char (ord)
-import Data.Word (Word8)
+import Data.List (foldl')
 
 import Control.Applicative
+import Data.Binary
 import Data.Binary.Get
 
 import qualified Data.Serialize.Get as Cereal
@@ -36,7 +38,9 @@ main = do
     rnf bracketsInChunks,
     rnf bracketCount,
     rnf oneMegabyte,
-    rnf oneMegabyteLBS
+    rnf oneMegabyteLBS,
+    rnf manyBytes,
+    rnf encodedBigInteger
      ]
   defaultMain
     [ bgroup "brackets"
@@ -89,6 +93,13 @@ main = do
         , bench "chunk size 16 bytes" $
             whnf (runTest (getWord8N16A mega)) oneMegabyteLBS
         ]
+    , bgroup "roll"
+        [ bench "foldr"  $ nf (roll_foldr  :: [Word8] -> Integer) manyBytes
+        , bench "foldl'" $ nf (roll_foldl' :: [Word8] -> Integer) manyBytes
+        ]
+    , bgroup "Integer"
+        [ bench "decode" $ nf (decode :: L.ByteString -> Integer) encodedBigInteger
+        ]
     ]
 
 checkBracket :: Int -> Int
@@ -349,3 +360,22 @@ getWord8N16A = loop []
                     <*> getWord8
                     <*> getWord8
           loop (v:s) (n-16)
+
+manyBytes :: [Word8]
+manyBytes = concat $ replicate 256 [0..255]
+
+bigInteger :: Integer
+bigInteger = roll_foldl' manyBytes
+
+encodedBigInteger :: L.ByteString
+encodedBigInteger = encode bigInteger
+
+roll_foldr :: (Integral a, Num a, Bits a) => [Word8] -> a
+roll_foldr   = foldr unstep 0
+  where
+    unstep b a = a `shiftL` 8 .|. fromIntegral b
+
+roll_foldl' :: (Integral a, Num a, Bits a) => [Word8] -> a
+roll_foldl'   = foldl' unstep 0 . reverse
+  where
+    unstep a b = a `shiftL` 8 .|. fromIntegral b
diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index 37117f7..b0f7529 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -53,7 +53,7 @@ import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as L
 
 import Data.Char    (ord)
-import Data.List    (unfoldr)
+import Data.List    (unfoldr, foldl')
 
 -- And needed for the instances:
 import qualified Data.ByteString as B
@@ -249,9 +249,9 @@ unroll = unfoldr step
     step i = Just (fromIntegral i, i `shiftR` 8)
 
 roll :: (Integral a, Num a, Bits a) => [Word8] -> a
-roll   = foldr unstep 0
+roll   = foldl' unstep 0 . reverse
   where
-    unstep b a = a `shiftL` 8 .|. fromIntegral b
+    unstep a b = a `shiftL` 8 .|. fromIntegral b
 
 #ifdef HAS_NATURAL
 -- Fixed-size type for a subset of Natural