<html><head></head><body><div style="font-family: Verdana;font-size: 12.0px;"><div>
<div>I have it read.</div>
<div> </div>
<div>Regards</div>
<div> </div>
<div>Dr William F Fearon</div>
<div>
<div name="quote" style="margin: 10px 5px 5px 10px; padding: 10px 0px 10px 10px; border-left-color: rgb(195, 217, 229); border-left-width: 2px; border-left-style: solid; -ms-word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;">
<div style="margin: 0px 0px 10px;"><b>Sent:</b> Friday, December 28, 2018 at 10:25 PM<br/>
<b>From:</b> "Viktor Dukhovni" <ietf-dane@dukhovni.org><br/>
<b>To:</b> haskell-cafe@haskell.org<br/>
<b>Subject:</b> Re: [Haskell-cafe] MVar considered harmful</div>
<div name="quoted-content">> On Dec 28, 2018, at 12:44 PM, Bertram Felgenhauer via Haskell-Cafe <haskell-cafe@haskell.org> wrote:<br/>
><br/>
> This is awkward to fix. Basically, when abandoning the lock before it<br/>
> has been released by the previous owner, we need a new thread to wait<br/>
> for the 'current' IVar and notify the 'next' one, since the current<br/>
> thread is being interrupted.<br/>
<br/>
I think that work can be delegated to the waiting thread, by making<br/>
locks (really barriers) optionally chain to a parent barrier that<br/>
also needs to be waited for (recursively). This is cheap, because<br/>
unless threads are actually interrupted, the chain is always one<br/>
deep. When a thread is interrupted, the next thread will wait<br/>
for 2 barriers, ...<br/>
<br/>
--<br/>
Viktor.<br/>
<br/>
module Main (main) where<br/>
import Control.Concurrent.MVar -- should be an IVar<br/>
import Control.Concurrent<br/>
import Control.Exception (bracket)<br/>
import Data.IORef<br/>
<br/>
-- Really a recursive barrier<br/>
newtype Lock = Lock (MVar (Maybe Lock))<br/>
type Mutex = IORef Lock<br/>
type Chain = IORef (Maybe Lock)<br/>
<br/>
newMutex :: IO Mutex<br/>
newMutex = Lock <$> newMVar Nothing >>= newIORef<br/>
<br/>
withMutex :: Mutex -> IO a -> IO a<br/>
withMutex m =<br/>
bracket swapShared signalPrivate . (\act -> (>> act) . waitChain . snd)<br/>
where<br/>
-- Return a new IORef containing the old barrier from the mutex, and a new<br/>
-- barrier, that has been atomically swapped into the old mutex.<br/>
swapShared :: IO (Lock, Chain)<br/>
swapShared = Lock <$> newEmptyMVar >>= \b' -><br/>
atomicModifyIORef m (\b -> (b', b)) >>= \b -><br/>
newIORef (Just b) >>= \chain -> return (b', chain)<br/>
<br/>
signalPrivate :: (Lock, Chain) -> IO ()<br/>
signalPrivate (Lock b, chain) = readIORef chain >>= putMVar b<br/>
<br/>
-- The last barrier that we were waiting on (if we're interrupted)<br/>
-- will be left in our chain as a "continuation" for whoever<br/>
-- next gets the mutex. It may be already signalled by the time they<br/>
-- see it, and that's OK. On normal return it will be 'Nothing'.<br/>
waitChain :: Chain -> IO ()<br/>
waitChain c = readIORef c >>= go<br/>
where<br/>
go = mapM_ $ \(Lock a) -> readMVar a >>= \b -> writeIORef c b >> go b<br/>
<br/>
mkThread :: Mutex -> String -> IO ThreadId<br/>
mkThread m name = do<br/>
tid <- forkIO $ withMutex m $ do<br/>
putStrLn $ unwords ["thread", name, "running"]<br/>
threadDelay 200000<br/>
putStrLn $ unwords ["thread", name, "stopping"]<br/>
yield<br/>
return tid<br/>
<br/>
main :: IO ()<br/>
main = do<br/>
m <- newMutex<br/>
_ <- mkThread m "A"<br/>
threadB <- mkThread m "B"<br/>
_ <- mkThread m "C"<br/>
killThread threadB<br/>
threadDelay 1000000<br/>
_______________________________________________<br/>
Haskell-Cafe mailing list<br/>
To (un)subscribe, modify options or view archives go to:<br/>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br/>
Only members subscribed via the mailman list are allowed to post.</div>
</div>
</div>
</div></div></body></html>