git.iko.soy/distributed-process
on master help sign in
Fix a bug in CQueue

When multiple matches matched, we were removing multiple messages from the queue.

commita3aced66f125781c98b71624e11206f6e740638e authorSimon Marlow <marlowsd@gmail.com> dateFri 14 Dec 2012, 16:56 (14 years ago) parent38c9011
1 file changed+11−6
distributed-process/src/Control/Distributed/Process/Internal/CQueue.hs+11−6
distributed-process/src/Control/Distributed/Process/Internal/CQueue.hs+11−6
@@ -33,8 +33,8 @@ import Control.Distributed.Process.Internal.StrictMVar
3333 )
3434import Control.Distributed.Process.Internal.StrictList
3535 ( StrictList(..)
36+ , append
3637 )
37−import qualified Control.Distributed.Process.Internal.StrictList as S
3838import Data.Maybe (fromJust)
3939import GHC.MVar (MVar(MVar))
4040import GHC.IO (IO(IO))
@@ -146,8 +146,8 @@ dequeue (CQueue arrived incoming) blockSpec matchons =
146146 -- of passing around restore and setting up exception handlers is
147147 -- high. So just don't use expensive matchIfs!
148148 case checkArrived matches old of
149− (old', Just r) -> returnOld old' (Just r)
150− (old', Nothing) -> goCheck rest old'
149+ (old', Just r) -> returnOld old' (Just r)
150+ (old', Nothing) -> goCheck rest old'
151151 -- use the result list, which is now left-biased
152152
153153 --
@@ -222,11 +222,16 @@ dequeue (CQueue arrived incoming) blockSpec matchons =
222222
223223 -- as a side-effect, this left-biases the list
224224 checkArrived :: [m -> Maybe a] -> StrictList m -> (StrictList m, Maybe a)
225− checkArrived matches list = S.foldr f (Nil, Nothing) list
225+ checkArrived matches list = go list Nil
226226 where
227− f x (rest,r)
228− | Just y <- checkMatches matches x = (rest, Just y)
227+ go Nil Nil = (Nil, Nothing)
228+ go Nil r = go r Nil
229+ go (Append xs ys) tl = go xs (append ys tl)
230+ go (Snoc xs x) tl = go xs (Cons x tl)
231+ go (Cons x xs) tl
232+ | Just y <- checkMatches matches x = (Append xs tl, Just y)
229233 | otherwise = (Cons x rest, r)
234+ where !(rest,r) = go xs tl
230235
231236 checkMatches :: [m -> Maybe a] -> m -> Maybe a
232237 checkMatches [] _ = Nothing