@@ -76,13 +76,25 @@ data BlockSpec =
7676 | Blocking
7777 | Timeout Int
7878
79+-- Match operations
80+--
81+-- They can be either a message match or a channel match.
7982data MatchOn m a
8083 = MatchMsg (m -> Maybe a)
8184 | MatchChan (STM a)
8285 deriving (Functor)
8386
87+-- Lists of chunks of matches
88+--
89+-- Two consecutive chunks never have the same kind of matches. i.e. if one chunk
90+-- contains message matches then the next one must contain channel matches and
91+-- viceversa.
8492type MatchChunks m a = [Either [m -> Maybe a] [STM a]]
8593
94+-- Splits a list of matches into chunks.
95+--
96+-- > concatMap (either (map MatchMsg) (map MatchChan)) . chunkMatches == id
97+--
8698chunkMatches :: [MatchOn m a] -> MatchChunks m a
8799chunkMatches [] = []
88100chunkMatches (MatchMsg m : ms) = Left (m : chk) : chunkMatches rest
@@ -90,6 +102,7 @@ chunkMatches (MatchMsg m : ms) = Left (m : chk) : chunkMatches rest
90102chunkMatches (MatchChan r : ms) = Right (r : chk) : chunkMatches rest
91103 where (chk, rest) = spanMatchChan ms
92104
105+-- | @spanMatchMsg = first (map (\(MatchMsg x) -> x)) . span isMatchMsg@
93106spanMatchMsg :: [MatchOn m a] -> ([m -> Maybe a], [MatchOn m a])
94107spanMatchMsg [] = ([],[])
95108spanMatchMsg (m : ms)
@@ -97,6 +110,7 @@ spanMatchMsg (m : ms)
97110 | otherwise = ([], m:ms)
98111 where !(msgs,rest) = spanMatchMsg ms
99112
113+-- | @spanMatchMsg = first (map (\(MatchChan x) -> x)) . span isMatchChan@
100114spanMatchChan :: [MatchOn m a] -> ([STM a], [MatchOn m a])
101115spanMatchChan [] = ([],[])
102116spanMatchChan (m : ms)
@@ -128,6 +142,7 @@ dequeue (CQueue arrived incoming size) blockSpec matchons = mask_ $ decrementJus
128142 -- Decrement counter is smth is returned from the queue,
129143 -- this is safe to use as method is called under a mask
130144 -- and there is no 'unmasked' operation inside
145+ decrementJust :: IO (Maybe (Either a a)) -> IO (Maybe a)
131146 decrementJust f =
132147 traverse (either return (\x -> decrement >> return x)) =<< f
133148 decrement = atomically $ modifyTVar' size pred
@@ -144,6 +159,10 @@ dequeue (CQueue arrived incoming size) blockSpec matchons = mask_ $ decrementJus
144159 arr' <- grabNew arr
145160 goCheck chunks arr'
146161
162+ -- Yields the value of the first succesful STM transaction as
163+ -- @Just (Left v)@. If all transactions fail, yields the value of the second
164+ -- argument.
165+ waitChans :: [STM a] -> STM (Maybe (Either a a)) -> STM (Maybe (Either a a))
147166 waitChans ports on_block =
148167 foldr orElse on_block (map (fmap (Just . Left)) ports)
149168
@@ -152,6 +171,10 @@ dequeue (CQueue arrived incoming size) blockSpec matchons = mask_ $ decrementJus
152171 -- mailbox. For channel matches, we do a non-blocking check at
153172 -- this point.
154173 --
174+ -- Yields @Just (Left a)@ when a channel is matched, @Just (Right a)@
175+ -- when a message is matched and @Nothing@ when there are no messages and we
176+ -- aren't blocking.
177+ --
155178 goCheck :: MatchChunks m a
156179 -> StrictList m -- messages to check, in this order
157180 -> IO (Maybe (Either a a))
@@ -250,6 +273,7 @@ dequeue (CQueue arrived incoming size) blockSpec matchons = mask_ $ decrementJus
250273 checkArrived :: [m -> Maybe a] -> StrictList m -> (StrictList m, Maybe a)
251274 checkArrived matches list = go list Nil
252275 where
276+ -- @go xs ys@ searches for a message match in @append xs ys@
253277 go Nil Nil = (Nil, Nothing)
254278 go Nil r = go r Nil
255279 go (Append xs ys) tl = go xs (append ys tl)