A quick critique:
- "push should never block" is not something you are going to actually achieve. Though you may have a perdonal definition of "block" that is different than the GHC meaning. For instance, your pushStack does block.
- popStack on an empty stack goes into a very busy loop, repeatedly taking and putting the Stack MVar. You do not want to do this, you even say "pop should block".
- You use takeMVar and putMVar instead of withMVar or modifyMVar. This means you are not thinking about exceptions, and the Stack will not be good in a general library.
So you have learned about MVars, and you are using them with them to learn more.
Here StackData is either a stack with data (Full) or without data (Empty). When Empty, there is an initally empty MVar for hungry poppers to wait upon.
type Lock = MVar ()
type Some a = (a, [a]) -- non empty version of list
data StackData a = Full !(Some a)
| Empty !Lock
data Stack a = Stack { stack :: MVar (StackData a) }
pop s = do
x <- modifyMVar (stack s) $ \ sd ->
case sd of
Empty lock -> do
return (Empty lock, Left lock)
Full (a, []) -> do
lock <- newEmptyMVar
return (Empty lock, Right a)
Full (a, (b:bs)) -> return (Full (b, bs), Right a)
case x of
Left lock -> do
withMVar lock return -- wait on next pusher
pop s
Right a -> return a
push s a = modifyMVar_ (stack s) $ \ sd ->
case sd of
Empty lock -> do
tryPutMVar lock () -- should succeed, releases waiting poppers
evaluate Full (a,[]) -- do not accumulate lazy thunks
Full (b, bs) -> do
xs <- evaluate (b:bs) -- do not accumulate lazy thunks
evaluate (Full (a, xs)) -- do not accumulate lazy thunks
Note : I have not tried to compile this.
EDIT: A safer version of push needs to only put () into the lock when it has succeeded in modifying the stack from Empty to Full. This certainty can be achieved with the 'mask' operation. The 'restore' is used inside 'modifyMVar' but is not required:
push s a = mask $ \restore -> do
mLock <- modifyMVar (stack s) $ \ sd -> restore $
case sd of
Empty lock -> do
n <- evaluate Full (a,[]) -- do not accumulate lazy thunks
return (n, Just lock)
Full (b, bs) -> do
xs <- evaluate (b:bs) -- do not accumulate lazy thunks
n <- evaluate (Full (a, xs))
return (n, Nothing)
whenJust mLock $ \ lock -> tryPutMVar lock ()