use DList for the transfer queue

Some nice efficiency gains here for list appending, although mostly
the small size of the transfer queue makes them irrelivant.
This commit is contained in:
Joey Hess 2013-04-25 01:33:44 -04:00
parent c6da464051
commit 362ed9f0e3
4 changed files with 21 additions and 16 deletions

View file

@ -32,7 +32,7 @@ getChanges = (atomically . getTList) <<~ changePool
{- Gets all unhandled changes, without blocking. -}
getAnyChanges :: Assistant [Change]
getAnyChanges = (atomically . readTList) <<~ changePool
getAnyChanges = (atomically . takeTList) <<~ changePool
{- Puts unhandled changes back into the pool.
- Note: Original order is not preserved. -}

View file

@ -39,7 +39,7 @@ type Reason = String
{- Reads the queue's content without blocking or changing it. -}
getTransferQueue :: Assistant [(Transfer, TransferInfo)]
getTransferQueue = (atomically . readTVar . queuelist) <<~ transferQueue
getTransferQueue = (atomically . readTList . queuelist) <<~ transferQueue
stubInfo :: AssociatedFile -> Remote -> TransferInfo
stubInfo f r = stubTransferInfo
@ -126,10 +126,9 @@ queueDeferredDownloads reason schedule = do
enqueue :: Reason -> Schedule -> Transfer -> TransferInfo -> Assistant ()
enqueue reason schedule t info
| schedule == Next = go (new:)
| otherwise = go (\l -> l++[new])
| schedule == Next = go consTList
| otherwise = go snocTList
where
new = (t, info)
go modlist = whenM (add modlist) $ do
debug [ "queued", describeTransfer t info, ": " ++ reason ]
notifyTransfer
@ -139,11 +138,11 @@ enqueue reason schedule t info
liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
( return False
, do
l <- readTVar (queuelist q)
l <- readTList (queuelist q)
if (t `notElem` map fst l)
then do
void $ modifyTVar' (queuesize q) succ
void $ modifyTVar' (queuelist q) modlist
void $ modlist (queuelist q) (t, info)
return True
else return False
)
@ -184,9 +183,9 @@ getNextTransfer acceptable = do
if sz < 1
then retry -- blocks until queuesize changes
else do
(r@(t,info):rest) <- readTVar (queuelist q)
writeTVar (queuelist q) rest
(r@(t,info):rest) <- readTList (queuelist q)
void $ modifyTVar' (queuesize q) pred
setTList (queuelist q) rest
if acceptable info
then do
adjustTransfersSTM dstatus $
@ -218,8 +217,7 @@ dequeueTransfers c = do
dequeueTransfersSTM :: TransferQueue -> (Transfer -> Bool) -> STM [(Transfer, TransferInfo)]
dequeueTransfersSTM q c = do
(removed, ts) <- partition (c . fst)
<$> readTVar (queuelist q)
(removed, ts) <- partition (c . fst) <$> readTList (queuelist q)
void $ writeTVar (queuesize q) (length ts)
void $ writeTVar (queuelist q) ts
setTList (queuelist q) ts
return removed

View file

@ -16,7 +16,7 @@ import Utility.TList
data TransferQueue = TransferQueue
{ queuesize :: TVar Int
, queuelist :: TVar [(Transfer, TransferInfo)]
, queuelist :: TList (Transfer, TransferInfo)
, deferreddownloads :: TList (Key, AssociatedFile)
}
@ -26,5 +26,5 @@ data Schedule = Next | Later
newTransferQueue :: IO TransferQueue
newTransferQueue = atomically $ TransferQueue
<$> newTVar 0
<*> newTVar []
<*> newTList
<*> newTList

View file

@ -25,10 +25,14 @@ newTList = newEmptyTMVar
getTList :: TList a -> STM [a]
getTList tlist = D.toList <$> takeTMVar tlist
{- Gets anything currently in the TList, without blocking.
{- Takes anything currently in the TList, without blocking.
- TList is left empty. -}
takeTList :: TList a -> STM [a]
takeTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
{- Reads anything in the list, without modifying it, or blocking. -}
readTList :: TList a -> STM [a]
readTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
readTList tlist = maybe [] D.toList <$> tryReadTMVar tlist
{- Mutates a TList. -}
modifyTList :: TList a -> (D.DList a -> D.DList a) -> STM ()
@ -50,3 +54,6 @@ snocTList tlist v = modifyTList tlist $ \dl -> D.snoc dl v
appendTList :: TList a -> [a] -> STM ()
appendTList tlist l = modifyTList tlist $ \dl -> D.append dl (D.fromList l)
setTList :: TList a -> [a] -> STM ()
setTList tlist l = modifyTList tlist $ const $ D.fromList l