Choose Anything: adding an Alternative instance

The alt function in CHP allows you to make a choice between performing several actions. You can choose, for example, between reading on one channel and writing on another. Agents can choose to move left or right, buffers can choose between reading or writing, servers can choose between reading from several clients. The alt function takes blocks of code and chooses between the leading actions — some people find this slightly surprising, but I think it simplifies code, and it is also entirely in line with the original CSP calculus.

The Problem with alt

The alt function has always had a slight ugliness though. Some leading actions do not support choice, for example: parallel compositions, lifted IO actions, or channel creation. That is, what should something like this code do:

alt [newChannel, liftIO (putStrLn 6), writeChannel c 6 <||> writeChannel d 7]

My solution to dealing with the items that didn’t support choice was to issue a run-time error if you tried to include them in a choice (as above). I don’t like run-time errors caused by bad code — but in this instance I couldn’t use the type system to pick up the error at compile-time without making all CHP code a lot more verbose. It’s always irked me to have this possibility of a run-time error.

One related feature is that the skip process is somewhat magic. The skip process has type CHP () and does nothing. It’s very tempting to define skip = return (). But SKIP has another property in CHP: it’s always ready in a choice. Choosing between a return statement (on its own), e.g. alt [return (), writeChannel c 0], would trigger a run-time error, so skip had to be defined differently. (Note that choosing alt [skip, return 0 >>= writeChannel c] is fine; CHP obeys the monad laws, so the leading action of the second item is actually writeChannel — the return melts away when it has an action following it.)

There is one easy solution to getting rid of the run-time error in alt: make choosing between any CHP action valid. All the existing choice-supporting actions work as before. But all of the others: creating channels, enrolling, parallel compositions, poisoning, claiming shared channels, lifted IO actions and solitary return statements (and probably more I’ve forgotten) are now valid in a choice, and are considered always-ready. In CSP terms, they are all prefixed by the process SKIP. This change has been included in CHP 2.2.0.

This doesn’t break any existing CHP code, it just makes more code technically valid (and simplifies some of the implementation a little). Now skip is simply defined as return (), and is not at all special. A little while back I explained the poll function, which I wrote at the time as:

poll :: CHP a -> CHP (Maybe a)
poll c = (Just <$> c) </> (skip >> return Nothing)

This can now be written even more straightforwardly:

poll :: CHP a -> CHP (Maybe a)
poll c = (Just <$> c) </> (return Nothing)

Alternative

Since I wrote the first version of CHP I’ve come into contact with a lot more Haskell — including type-classes such as Applicative and Alternative. Alternative defines a choice operator, <|> and some associated items: empty, the unit of choice, and the functions some and many that optionally produce 0+ or 1+ items respectively. The default definition of many is revealing:

many v = some v <|> pure []

This suggests several things. Firstly, a right-biased choice operator is going to be pretty useless here. It’s not clear whether Alternative instances should display left-bias or no bias (the documentation only states that it should be associative, which all biases would satisfy), but left-bias looks most useful, and is probably most expected. Secondly, it is expected than an item constructed with pure should be a valid choice: this wasn’t the case previously (pure = return, of course), but it is with the changes described above.

Our instance is trivially constructed (and is included in CHP 2.2.0 onwards):

instance Alternative CHP where
  empty = stop
  (<|>) = (</>)

It seems silly not to provide it. This does leave me with three choice operators in CHP: “<->“, “</>” and “<|>“, which all do exactly the same thing — my original intention in providing the first two was that the first wasn’t guaranteed to have bias, but the middle one was guaranteed to have some bias — they actually share the same definition, though. If I was designing CHP all over again I might dump both my choice operators and just use Alternative. That would break pretty much all existing CHP code, though, so it’s too big a change to do suddenly. I may deprecate my choice operators in favour of Alternative though, and maybe remove them in the future.

Our earlier poll operation is actually already featured in the Control.Applicative module, based on the Alternative type-class, and is called optional. As a final note, I went looking for an equivalent to CHP’s alt/priAlt for Alternative. It turns out to be the asum function from Data.Foldable (thanks, Hoogle!):

asum = foldr (<|>) empty

I might stick with the alt/priAlt synonyms for that one though, for clarity (and stop for empty, too, due to its CSP origin). Besides which, asum is defined in terms of <|> — in fact, in CHP the operator </> is defined in terms of priAlt rather than the other way around, because priAlt is more efficient when you have lots of guards.

Choice over Events using STM

I’m currently writing a paper on CHP’s performance for conjunction, which I have been optimising recently. The problem with a new feature like conjunction is that there is nothing else to benchmark it against! But I can benchmark the effect that supporting conjunction has on performance for simple channel communications and other things that don’t feature conjunction.

Two of my comparisons are simple synchronous channels based on MVars and STM. These don’t support choice between events — you can’t choose between writing to two synchronous channels built on MVars or STM without more machinery on top. But they are fast. Another comparison is the CML package, which does support such choice between events — the performance of CML merits its own post some time (in short: fine normally, but terrible if you use its choice operator a lot — unless I have made a mistake in the benchmark).

I also wanted to benchmark an implementation that supported choice but not conjunction, based on STM. Version 1.0.0 of CHP fulfils this criteria, but was badly designed and totally unoptimised — and I know from my recent optimisations how bad the performance might be. So I constructed an optimised version of channels with choice but no conjunction. I was surprised at how short the algorithm was, and realised that it could be explained in a blog post. So here it is.

Implementing Event Choice with STM

Let’s be clear on the problem, first. I want an Event type such that I can say “wait for event A or event B, whichever happens first, but only engage in one of them”. Then I want someone else to be able to concurrently say “wait for event B or event C or event D, whichever happens first, but only engage in one of them” and have the algorithm resolve it all. STM doesn’t achieve this by itself; you can use orElse to choose between writing to two variables, but that doesn’t suffice for multiple people engaging in events with each other.

We begin with a helper function — one of those functions that is general enough that it might almost feature in a standard library. Here it is:

-- | Executes the actions until it finds one that returns True (at which point
-- it will execute no further actions).  Returns True if an action did, False
-- if none of them did.
anyM :: Monad m => [m Bool] -> m Bool
anyM = foldM orM False
  where
    orM True _ = return True
    orM False m = m

Next we’ll declare our data-types. Our Event contains a constant enrollment count (the number of processes required to synchronise together), and a transactional variable holding a list of current offers, each with an associated STM action. An offer is in turn a list of events which uses a ThreadId as a unique identifier; think of an offer as saying: I offer to engage in exactly one of the events in the list, and I’m waiting until I do:

data Offer = Offer { offerThreadId :: ThreadId, offerEvents :: [Event] }
instance Eq Offer where (==) = (==) `on` offerThreadId

data Event = Event { enrollCount :: Int, offersTV :: TVar [(STM (), Offer)] }

Adding an offer to an event is as simple as adding it to the list of offers. My modifyTVar' function has type (a -> a) -> TVar a -> STM () and applies the modification function to the contents of the TVar, but it adds a little strictness that helps performance:

recordOffer :: Offer -> (STM (), Event) -> STM ()
recordOffer o (act, e) = modifyTVar' ((act, o):) (offersTV e)

We also define a function for checking if an event is able to complete (when we are making an offer on it). This takes an event, and an action to perform if the event can complete. It then reads the current offers from the event’s transactional variable. If the enrollment count is equal to the number of current offers plus one (the offer now being made), it can complete. Completion involves performing all the associated STM actions, and then using a revoke function to remove the offers (which have now chosen this event, say: A) from all the events that they had offered on (e.g. event A, event B, event C):

checkComplete :: (STM (), Event) -> STM Bool
checkComplete (act, e)
  = do offers <- readTVar (offersTV e)
       if enrollCount e /= length offers + 1
         then return False
         else do sequence_ (act : map fst offers)
                 mapM_ (revoke . snd) offers
                 return True

revoke :: Offer -> STM ()
revoke off = mapM_ (modifyTVar' removeUs . offersTV) (offerEvents off)
  where
    removeUs = filter ((/= off) . snd)

We only require one further function. This function, offerAll, handles the creation of an offer, checks if any of the events in the offer can complete immediately, and otherwise records the offers in the event then waits for one of them to be completed by a later participants. It must use two transactions for this; one to make the offers (this transaction needs to finish for it to be visible to the other participants) and one to wait for an event to be completed. A crucial part of the function is not just knowing that an offer completed, but also knowing which one. For this we construct a TVar of our own into which a result can be written. This starts off as Nothing, and we later wait for it to become a Just value. We augment the user-supplied action-on-completion to also write into this TVar. The design of the algorithm as a whole ensures that this variable will only ever be written to once. Here is offerAll:

offerAll :: [(STM (), Event, a)] -> IO a
offerAll off
  = do tid <- myThreadId
       rtv <- atomically $ checkAll tid
       atomically $ readTVar rtv >>= maybe retry return    
  where
    checkAll tid
      = do rtv <- newTVar Nothing
           let offer = [(act >> writeTVar rtv (Just x), e) | (act, e, x) <- off]
           complete <- anyM (map checkComplete offer)
           unless complete $
              mapM_ (recordOffer (Offer tid [e | (_, e, _) <- off])) offer
           return rtv

This is all that is needed for events with choice at both ends. You call offerAll with a list of offers and it gives you back the value you associated with that offer.

The Public API

To wrap this into a communication channel with a CML-like API, we wrap it up as follows. First we declare an SEvent type (named after CML, hence the re-use of the term event for another meaning) that represents a synchronisation action; this is a list (of choices), each containing an internal event, an action to perform during the completion of the offer, and one to perform afterwards that will yield a return value (which we can use for a Functor instance):

data SEvent a = SEvent { sEvent :: [((STM (), STM a), Event)] }

instance Functor SEvent where
  fmap f (SEvent es) = SEvent [((dur, fmap f aft), e) | ((dur, aft), e) <- es]

choose :: [SEvent a] -> SEvent a
choose = SEvent . concatMap sEvent

You can see that the choose function simply joins lists of choices together. We define our synchronisation function using offerAll, which will return the corresponding afterwards-STM-action for the chosen event, which we then execute using atomically:

sync :: SEvent a -> IO a
sync (SEvent es) = offerAll [(dur,e,aft) | ((dur,aft),e) <- es] >>= atomically

Finally we can define a type for a synchronous communication channel, SChannel that joins together an event (the internal kind) and a transactional variable for passing the value:

data SChannel a = SChannel Event (TVar a)

send :: SChannel a -> a -> SEvent ()
send (SChannel e ctv) x = SEvent [((writeTVar ctv x, return ()), e)]

recv :: SChannel a -> SEvent a
recv (SChannel e ctv) = SEvent [((return (), readTVar ctv), e)]

The send function puts the value to send into the variable during the original event completion, and then afterwards the reader takes the value out of the variable at its leisure. (The implementation assumes that the same participants will use the channel each time; an extra level of indirection could be added to make the implementation more flexible in this regard.)

The code in this post provides nearly the same functionality as the CML library, but my tests indicate it is faster. I have now uploaded this code (with some documentation) as the sync package on Hackage. This provides a useful “lite” alternative to CHP that runs in the IO monad, and an alternative implementation of most of the features of the CML package.

The Problem with Parallel Participants Professing Priority

Priority

There are two kinds of priority in the CHP style of concurrent programming: priority on processes and priority on events. Priority on processes is about specifying that a high-priority process P should run whenever possible, at the expense of a low-priority process Q. This is difficult to co-ordinate across multiple cores (especially if lightweight threads are used, as in Haskell) and isn’t offered by all run-times. The priority I am interested in discussing in this post is that of events: specifying that if two events A and B are ready to complete, A should happen in preference to B.

There is an immediate problem with local priorities over events, where each process separately specifies its priorities to the events it is offering. Imagine that you offer to either go to the cinema, or go bowling, and you prefer (i.e. give priority to) the cinema. Your friend also offers to go to the cinema or to go bowling, but they prefer (give priority to) bowling. For a one-off choice of doing one thing, there is no amount of algorithmic cleverness that can resolve such situations to the satisfaction of both parties. So local priorities,where both sides can specify their own priorities, are fairly meaningless because in general they cannot be resolved correctly.

One way to solve this is to only allow one side to specify a priority. The occam language did this; only processes reading from channels were allowed to specify priority, not the writers. (In fact, only processes reading from channels were allowed to offer a choice!) This means that the priorities can always be satisfied because you only have one set of priorities to resolve in each choice. This falls down with barriers — it becomes difficult to specify which synchronising process of many is allowed to offer priorities.

Another solution is to have global priorities instead. If we specify up-front that the cinema is always better than bowling, there can be no dispute when we make our offers for activities for the evening. This could be implemented, for example, by assigning a global integer priority to all events (perhaps with 0 as the default). I gather that global priorities make things difficult for formal reasoning in CSP, but that does not mean we cannot use it.

CHP and Prioritised Choice

So what does CHP do? Events do not currently have global priority (although I would like to implement it at some point). There is an unprioritised choice operator, <-> (with a list form: alt), which is commutative and associative. But there is also a prioritised choice operator, </> (with a list form: priAlt), which is associative but not, of course, commutative. Its existence is partly a historical hangover from the first version of CHP (which was a more direct conversion from occam), and it has some slightly intricate semantics, which I’ll describe here in terms of the list form.

The relative positions in the list of any guards involving reading from channels, writing to channels, or synchronising on barriers are discounted. So priAlt [readChannel c, syncBarrier b] is the same as priAlt [syncBarrier b, readChannel c]. The position of any stop guards is irrelevant because they will never trigger. The position of any skip guards is important in relation to all the other guards. priAlt (skip : others) is guaranteed to choose the first guard, regardless of what comes after. Similarly, priAlt (initialGuards ++ [skip] ++ otherGuards) will never choose any of the otherGuards, but if any of the initialGuards are ready, they will be chosen in preference to the skip. Effectively, skip is like an early terminator for the list of guards passed to priAlt (but don’t go overboard — I don’t think passing an infinite list of guards will work, even if skip is early on). In contrast, the presence of skip guards in an unprioritised choice is generally wrong; the outcome of alt [readChannel c, skip] is non-deterministic, even if c is ready.

Polling

Generally in my examples on the blog, I have always avoided the use of priAlt and </> in favour of alt and <-> because the former is only really different to the latter when skip guards are present, and thus the latter form, being more clearly an unprioritised choice, is better. There is one, slightly inelegant, use for prioritised choice though: polling. Imagine that you want to poll to see if a channel is ready. If it is, you are happy to read from it, but if it’s not ready yet, you want to continue on and do something else. That is easy to capture: readChannel c </> skip. In fact, it is possible to capture this as a helper function:

poll :: CHP a -> CHP (Maybe a)
poll c = (Just <$> c) </> (skip >> return Nothing)

You can even nest these things; this code will check channels c and d for readiness (if both are ready, either might be taken), and return Nothing only if neither is ready:

poll (alt [readChannel c, readChannel d])

It is also important to be aware that this polling is only a snapshot of the current state. If you poll channel c, you have no guarantee that the result of the poll will still hold by the time you get the result. So if you poll channel c, and find it is not ready, it may have turned ready by the time you examine the result and make a subsequent decision. A particularly bad use would be to have both ends polling: if one process continually polls to read from c, and the other process continually polls to write to c, depending on timing, it is quite possible that no communication will ever take place. It is only really a good idea to use polling if you know the other end will stay committed to the action once offered (i.e. that it is not offering a choice of events).

Emulating Priority

This pattern can also be used to give one event a form of priority over another. This code:

readChannel c </> (skip >> alt [readChannel c, readChannel d])

First checks to see if c was ready. If so, it takes it, otherwise it waits for the next event of c and d. So it gives a form of priority to c. This is not foolproof priority; if another process later offers c and d there is no guarantee that c will be chosen, so it only provides real priority if different processes are offering the events involved.