Merge pull request #53 from haskellari/benchmark

Benchmark

Author: phadej

.gitignore

@@ -1,3 +1,6 @@
 dist/
 dist-newstyle/
 .ghc.environment.*
+cabal.project.local
+
+bench.html

bench/tree-diff-bench.hs

@@ -0,0 +1,62 @@
+{-# OPTIONS -fno-warn-orphans #-}
+module Main (main) where
+
+import Control.DeepSeq   (NFData (..))
+import Control.Exception (evaluate)
+import Criterion.Main    (bench, bgroup, defaultMain, nf)
+
+import qualified Data.Algorithm.Diff as Diff
+
+import Data.TreeDiff.List (diffBy)
+
+smallA :: [Int]
+smallB :: [Int]
+
+smallA = [0, 5 .. 100]
+smallB = [0, 3 .. 72]
+
+bigA :: [Int]
+bigA = [0, 5 .. 10000]
+
+bigB :: [Int]
+bigB = [0, 3 .. 7200]
+
+main :: IO ()
+main = do
+  evaluate (rnf smallA)
+  evaluate (rnf smallB)
+
+  evaluate (rnf bigA)
+  evaluate (rnf bigB)
+
+  defaultMain
+    [ bgroup "same"
+      [ bgroup "small"
+        [ bench "lib" $ nf (uncurry (diffBy (==))) (smallA, smallA)
+        , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (smallA, smallA)
+        ]
+      , bgroup "big"
+        [ bench "lib" $ nf (uncurry (diffBy (==))) (bigA, bigA)
+        , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (bigA, bigA)
+        ]
+      ]
+    , bgroup "different"
+      [ bgroup "small"
+        [ bench "lib" $ nf (uncurry (diffBy (==))) (smallA, smallB)
+        , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (smallA, smallB)
+        ]
+      , bgroup "big"
+        [ bench "lib" $ nf (uncurry (diffBy (==))) (bigA, bigB)
+        , bench "Diff" $ nf (uncurry (Diff.getDiffBy (==))) (bigA, bigB)
+        ]
+      ]
+    ]
+
+-------------------------------------------------------------------------------
+-- Orphans
+-------------------------------------------------------------------------------
+
+instance (NFData a, NFData b) => NFData (Diff.PolyDiff a b) where
+    rnf (Diff.First x)  = rnf x
+    rnf (Diff.Second y) = rnf y
+    rnf (Diff.Both x y) = rnf x `seq` rnf y

src/Data/TreeDiff/Expr.hs

@@ -12,8 +12,9 @@ module Data.TreeDiff.Expr (
 import Prelude ()
 import Prelude.Compat
 
-import Data.Semialign     (alignWith)
-import Data.These         (These (..))
+import Control.DeepSeq (NFData (..))
+import Data.Semialign  (alignWith)
+import Data.These      (These (..))
 
 import Data.TreeDiff.List
 import Data.TreeDiff.OMap (OMap)
@@ -36,6 +37,11 @@ data Expr
     | Lst [Expr]                                 -- ^ list constructor
   deriving (Eq, Show)
 
+instance NFData Expr where
+    rnf (App n es) = rnf n `seq` rnf es
+    rnf (Rec n fs) = rnf n `seq` rnf fs
+    rnf (Lst es)   = rnf es
+
 instance QC.Arbitrary Expr where
     arbitrary = QC.scale (min 25) $ QC.sized arb where
         arb n | n <= 0 = QC.oneof
@@ -109,3 +115,9 @@ data EditExpr
     | EditLst [Edit EditExpr]
     | EditExp Expr  -- ^ unchanged tree
   deriving Show
+
+instance NFData EditExpr where
+    rnf (EditApp n es) = rnf n `seq` rnf es
+    rnf (EditRec n fs) = rnf n `seq` rnf fs
+    rnf (EditLst es)   = rnf es
+    rnf (EditExp e)    = rnf e

src/Data/TreeDiff/List.hs

@@ -2,8 +2,10 @@
 -- | A list diff.
 module Data.TreeDiff.List (diffBy, Edit (..)) where
 
-import           Data.List.Compat (sortOn)
-import qualified Data.Vector      as V
+import Control.DeepSeq  (NFData (..))
+import Data.List.Compat (sortOn)
+
+import qualified Data.Vector as V
 
 -- | List edit operations
 --
@@ -16,6 +18,12 @@ data Edit a
     | Swp a a  -- ^ swap, i.e. delete + insert
   deriving Show
 
+instance NFData a => NFData (Edit a) where
+    rnf (Ins x)   = rnf x
+    rnf (Del x)   = rnf x
+    rnf (Cpy x)   = rnf x
+    rnf (Swp x y) = rnf x `seq` rnf y
+
 -- | List difference.
 --
 -- >>> diffBy (==) "hello" "world"

src/Data/TreeDiff/OMap.hs

@@ -19,6 +19,7 @@ import Data.List      (sortBy)
 import Data.Ord       (comparing)
 import Data.Semialign (Semialign (..))
 import Data.These     (These (..))
+import Control.DeepSeq  (NFData (..))
 
 #if MIN_VERSION_containers(0,5,0)
 import qualified Data.Map.Strict as Map
@@ -67,6 +68,16 @@ instance (Eq k, Eq v) => Eq (OMap k v) where
         go ((k1, v1) : kvs1) ((k2, v2) : kvs2) =
             k1 == k2 && v1 == v2 && go kvs1 kvs2
 
+-------------------------------------------------------------------------------
+-- deepseq
+-------------------------------------------------------------------------------
+
+instance NFData v => NFData (Val v) where
+    rnf (Val _ v) = rnf v
+
+instance (NFData k, NFData v) => NFData (OMap k v) where
+    rnf (OMap m) = rnf m
+
 -------------------------------------------------------------------------------
 -- QuickCheck
 -------------------------------------------------------------------------------

tree-diff.cabal

@@ -86,6 +86,7 @@ library
     , base        >=4.5      && <4.16
     , bytestring  ^>=0.9.2.1 || ^>=0.10.0.2 || ^>=0.11.0.0
     , containers  ^>=0.4.2.1 || ^>=0.5.0.0 || ^>=0.6.0.1
+    , deepseq     ^>=1.3.0.0 || ^>=1.4.0.0
     , parsec      ^>=3.1.13.0
     , pretty      ^>=1.1.1.0
     , text        ^>=1.2.3.0
@@ -137,12 +138,14 @@ library
   hs-source-dirs:   src
   default-language: Haskell2010
 
-test-suite test
+test-suite tree-diff-test
   default-language: Haskell2010
   type:             exitcode-stdio-1.0
   main-is:          Tests.hs
   hs-source-dirs:   tests
   ghc-options:      -Wall -threaded
+
+  -- dependencies from library
   build-depends:
     , ansi-terminal
     , ansi-wl-pprint
@@ -151,11 +154,30 @@ test-suite test
     , parsec
     , QuickCheck
     , tagged
+    , tree-diff
+
+  if impl(ghc <7.5)
+    build-depends: ghc-prim
+
+  -- extra dependencies
+  build-depends:
     , tasty             ^>=1.2 || ^>=1.3.1
     , tasty-golden      ^>=2.3.1.1
     , tasty-quickcheck  ^>=0.10.1
-    , tree-diff
     , trifecta          >=2       && <2.2
 
-  if impl(ghc <7.5)
-    build-depends: ghc-prim
+benchmark tree-diff-bench
+  default-language: Haskell2010
+  type:             exitcode-stdio-1.0
+  main-is:          tree-diff-bench.hs
+  hs-source-dirs:   bench
+  ghc-options:      -Wall -threaded
+
+  -- dependencies from library
+  build-depends:
+    , base
+    , deepseq
+    , tree-diff
+
+  -- extra dependencies
+  build-depends:    criterion ^>=1.5.9.0, Diff ^>=0.4.0