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:
parent
1744bd6b48
commit
5c960601aa
3 changed files with 50 additions and 22 deletions
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue