Beautiful Code [275]
santa elf_gp rein_gp
= do { putStr "----------\n"
; (task, (in_gate, out_gate))
<- atomically (orElse
(chooseGroup rein_gp "deliver toys")
(chooseGroup elf_gp "meet in my study"))
; putStr ("Ho! Ho! Ho! let's " ++ task ++ "\n")
; operateGate in_gate
-- Now the helpers do their task
; operateGate out_gate }
where
chooseGroup :: Group -> String -> STM (String, (Gate,Gate))
chooseGroup gp task = do { gates <- awaitGroup gp
; return (task, gates) }
The choice is made by the orElse, which first attempts to choose the reindeer (thereby giving them priority), and otherwise chooses the elves. The chooseGroup function does an awaitGroup call on the appropriate group, and returns a pair consisting of a string that indicates the task (delivering toys or meeting in the study) and the two gates that Santa must operate to take the group through the task. Once the choice is made, Santa prints out a message and operates the two gates in sequence.
This implementation works fine, but we will also explore an alternative, more general version, because santa demonstrates a very common programming pattern. The pattern is this: a thread (Santa in this case) makes a choice in one atomic transaction, followed by one or more further consequential transactions. Another typical example might be: take a message from one of several message queues, act on the message, and repeat. In the Santa scenario, the consequential action was very similar for both elves and reindeer—in both cases, Santa had to print a message and operate two gates. But that would not work if Santa had to do very different things for elves and reindeer. One approach would be to return a Boolean indicating which was chosen, and dispatch on that Boolean after the choice, but that becomes inconvenient as more alternatives are added. Here is another approach that works better:
santa :: Group -> Group -> IO ()
santa elf_gp rein_gp
= do { putStr "----------\n"
; choose [(awaitGroup rein_gp, run "deliver toys"),
(awaitGroup elf_gp, run "meet in my study")] }
where
run :: String -> (Gate,Gate) -> IO ()
run task (in_gate,out_gate)
= do { putStr ("Ho! Ho! Ho! let's " ++ task ++ "\n")
; operateGate in_gate
; operateGate out_gate }
The function choose is like a guarded command: it takes a list of pairs, waits until the first component of a pair is ready to "fire," and then executes the second component. So choose has this type:[§§§§]
[§§§§] In Haskell, the type [ty] means a list whose elements have type ty. In this case, choose's argument is a list of pairs, written (ty1, ty2); the first component of the pair has type STM a, while the second is a function with type a->IO ( ).
choose :: [(STM a, a -> IO ())] -> IO ( )
The guard is an STM action delivering a value of type a; when the STM action is ready (that is, does not retry), choose can pass the value to the second component, which must therefore be a function expecting a value of type a. With this in mind, santa should be easy reading. He uses awaitGroup to wait for a ready Group; the choose function gets the pair of Gates returned by awaitGroup and passes it to the run function. The latter operates the two gates in succession—recall that operateGate blocks until all the elves (or reindeer) have gone through the gate.
The code for choose is brief, but a little mind-bending:
choose :: [(STM a, a -> IO ( ))] -> IO ( )
choose choices = do { act <- atomically (foldr1 orElse actions)
; act }
where
actions :: [STM (IO ( ))]
actions = [ do { val <- guard; return (rhs val) }
| (guard, rhs) <- choices ]
First, it forms a list, actions, of STM actions, which it then combines with orElse. (The call foldr1 [x1,…,xn] returns x1x2 … xn.) Each of these STM actions itself returns an IO action, namely the thing to be done when the choice is made. That is why each action in the list has the cool type STM(IO( )). The code first makes an atomic choice among the list of alternatives, getting the action act, with type