4 ns optimisation of repeated calls to hasDifference on the same Differences

I want this as fast as possible, so it can be added to code paths without
slowing them down.

Avoid the set lookup, and rely on laziness,
drops runtime from 14.37 ns to 11.03 ns according to this criterion benchmark:

import Criterion.Main
import qualified Types.Difference as New
import qualified Types.DifferenceOld as Old

main :: IO ()
main = defaultMain
	[ bgroup "hasDifference"
		[ bench "new" $ whnf (New.hasDifference New.OneLevelObjectHash) new
		, bench "old" $ whnf (Old.hasDifference Old.OneLevelObjectHash) old
		]
	]
  where
	s = "fromList [ObjectHashLower, OneLevelObjectHash, OneLevelBranchHash]"
	new = New.readDifferences s
	old = Old.readDifferences s

A little bit of added boilerplate, but I suppose it's worth it to not
need to worry about set lookup overhead. Note that adding more differences
would slow down the old implementation; the new implementation will run
the same speed.
This commit is contained in:
Joey Hess 2015-06-11 16:25:37 -04:00
parent 1744bd6b48
commit 5c960601aa
3 changed files with 50 additions and 22 deletions

View file

@ -23,10 +23,10 @@ import Logs.UUIDBased
import Logs.Difference.Pure
recordDifferences :: Differences -> UUID -> Annex ()
recordDifferences (Differences differences) uuid = do
recordDifferences ds@(Differences {}) uuid = do
ts <- liftIO getPOSIXTime
Annex.Branch.change differenceLog $
showLog id . changeLog ts uuid (show differences) . parseLog Just
showLog id . changeLog ts uuid (showDifferences ds) . parseLog Just
recordDifferences UnknownDifferences _ = return ()
-- Map of UUIDs that have Differences recorded.

View file

@ -9,6 +9,7 @@ module Types.Difference (
Difference(..),
Differences(..),
readDifferences,
showDifferences,
getDifferences,
differenceConfigKey,
differenceConfigVal,
@ -20,10 +21,10 @@ import Utility.PartialPrelude
import qualified Git
import qualified Git.Config
import qualified Data.Set as S
import Data.Maybe
import Data.Monoid
import Prelude
import qualified Data.Set as S
-- Describes differences from the v5 repository format.
--
@ -31,7 +32,7 @@ import Prelude
-- would break compatability.
--
-- Not breaking compatability is why a list of Differences is used, rather
-- than a sum type. With a sum type, adding a new field for some future
-- than a record type. With a record type, adding a new field for some future
-- difference would serialize to a value that an older version could not
-- parse, even if that new field was not used. With the Differences list,
-- old versions can still parse it, unless the new Difference constructor
@ -44,26 +45,45 @@ data Difference
= ObjectHashLower
| OneLevelObjectHash
| OneLevelBranchHash
deriving (Show, Read, Ord, Eq, Enum, Bounded)
deriving (Show, Read, Eq, Ord, Enum, Bounded)
-- This type is used internally for efficient checking for differences,
-- but converted to S.Set Difference for serialization.
data Differences
= Differences (S.Set Difference)
= Differences
{ objectHashLower :: Bool
, oneLevelObjectHash :: Bool
, oneLevelBranchHash :: Bool
}
| UnknownDifferences
-- UnknownDifferences cannot be equal
instance Eq Differences where
Differences a == Differences b = a == b
_ == _ = False -- UnknownDifferences cannot be equal
UnknownDifferences == _ = False
_ == UnknownDifferences = False
a == b = all (\f -> f a == f b)
[ objectHashLower
, oneLevelObjectHash
, oneLevelBranchHash
]
instance Monoid Differences where
mempty = Differences S.empty
mappend (Differences a) (Differences b) = Differences (S.union a b)
mempty = Differences False False False
mappend a@(Differences {}) b@(Differences {}) = a
{ objectHashLower = objectHashLower a || objectHashLower b
, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
}
mappend _ _ = UnknownDifferences
readDifferences :: String -> Differences
readDifferences = maybe UnknownDifferences Differences . readish
readDifferences = maybe UnknownDifferences mkDifferences . readish
showDifferences :: Differences -> String
showDifferences = show . S.fromList . listDifferences
getDifferences :: Git.Repo -> Differences
getDifferences r = Differences $ S.fromList $
getDifferences r = mkDifferences $ S.fromList $
mapMaybe getmaybe [minBound .. maxBound]
where
getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
@ -82,9 +102,25 @@ tunable :: String -> String
tunable k = "annex.tune." ++ k
hasDifference :: Difference -> Differences -> Bool
hasDifference d (Differences s) = S.member d s
hasDifference _ UnknownDifferences = False
hasDifference ObjectHashLower ds = objectHashLower ds
hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds
hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds
listDifferences :: Differences -> [Difference]
listDifferences (Differences s) = S.toList s
listDifferences d@(Differences {}) = map snd $
filter (\(f, _) -> f d)
[ (objectHashLower, ObjectHashLower)
, (oneLevelObjectHash, OneLevelObjectHash)
, (oneLevelBranchHash, OneLevelBranchHash)
]
listDifferences UnknownDifferences = []
mkDifferences :: S.Set Difference -> Differences
mkDifferences s = Differences
{ objectHashLower = check ObjectHashLower
, oneLevelObjectHash = check OneLevelObjectHash
, oneLevelBranchHash = check OneLevelBranchHash
}
where
check f = f `S.member` s

View file

@ -8,11 +8,3 @@
{-# LANGUAGE CPP #-}
module Utility.URI where
-- Old versions of network lacked an Ord for URI
#if ! MIN_VERSION_network(2,4,0)
import Network.URI
instance Ord URI where
a `compare` b = show a `compare` show b
#endif