Beautiful Code [273]
data Gate = MkGate Int (TVar Int)
newGate :: Int -> STM Gate
newGate n = do { tv <- newTVar 0; return (MkGate n tv) }
passGate :: Gate -> IO ( )
passGate (MkGate n tv)
= atomically (do { n_left <- readTVar tv
; check (n_left > 0)
; writeTVar tv (n_left-1) })
operateGate :: Gate -> IO ( )
operateGate (MkGate n tv)
= do { atomically (writeTVar tv n)
; atomically (do { n_left <- readTVar tv
; check (n_left == 0) }) }
The first line declares Gate to be a new data type, with a single data constructor MkGate.[] The constructor has two fields: an Int giving the gate capacity, and a TVar whose contents says how many helpers can go through the gate before it closes. If the TVar contains zero, the gate is closed.
[] A data type declaration is not unlike a C struct declaration, with MkGate being the structure tag.
The function newGate makes a new Gate by allocating a TVar and building a Gate value by calling the MkGate constructor. Dually, passGate uses pattern-matching to take apart the MkGate constructor; then, it decrements the contents of the TVar, using check to ensure there is still capacity in the gate, as we did with withdraw in the section "Blocking and Choice." Finally, operateGate first opens the Gate by writing its full capacity into the TVar, and then waits for the TVar to be decremented to zero.
A Group has the following interface:
newGroup :: Int -> IO Group
joinGroup :: Group -> IO (Gate,Gate)
awaitGroup :: Group -> STM (Gate,Gate)
Again, a Group is created empty, with a specified capacity. An elf may join a group by calling joinGroup, a call that blocks if the group is full. Santa calls awaitGroup to wait for the group to be full; when it is full, he gets the Group's gates, and the Group is immediately reinitialized with fresh Gates, so that another group of eager elves can start assembling.
Here is a possible implementation:
data Group = MkGroup Int (TVar (Int, Gate, Gate))
newGroup n = atomically (do { g1 <- newGate n; g2 <- newGate n
; tv <- newTVar (n, g1, g2)
; return (MkGroup n tv) })
Again, Group is declared as a fresh data type, with constructor MkGroup and two fields: the Group's full capacity, and a TVar containing its number of empty slots and its two Gates. Creating a new Group is a matter of creating new Gates, initializing a new TVar, and returning a structure built with MkGroup.
The implementations of joinGroup and awaitGroup are now more or less determined by these data structures:
joinGroup (MkGroup n tv)
= atomically (do { (n_left, g1, g2) <- readTVar tv
; check (n_left > 0)
; writeTVar tv (n_left-1, g1, g2)
; return (g1,g2) })
awaitGroup (MkGroup n tv)
= do { (n_left, g1, g2) <- readTVar tv
; check (n_left == 0)
; new_g1 <- newGate n; new_g2 <- newGate n
; writeTVar tv (n,new_g1,new_g2)
; return (g1,g2) }
Notice that awaitGroup makes new gates when it reinitializes the Group. This ensures that a new group can assemble while the old one is still talking to Santa in the study, with no danger of an elf from the new group overtaking a sleepy elf from the old one.
Reviewing this section, you may notice that I have given some of the Group and Gate operations IO types (e.g., newGroup, joinGroup), and some STM types (e.g., newGate, awaitGroup). How did I make these choices? For example, newGroup has an IO type, which means that I can never call it from within an STM action. But this is merely a matter of convenience: I could instead have given newGroup an STM type, by omitting the atomically in its definition. In exchange, I would have had to write atomically(newGroupn) at each call site, rather than merely newGroup n. The merit of giving newGate an STM type is that it is more compos-able, a generality that newGroup did not need in this program. In contrast, I wanted to call newGate inside newGroup, and so I gave newGate an STM type.
In general, when designing a library, you should give the functions STM types wherever possible. You can think of STM actions as Lego