blob: 235b2aa58e27262bff785f46538d9f8a4b595a6c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
import Control.Exception
import Control.Concurrent
import GHC.Conc
import Foreign.StablePtr
main :: IO ()
main = do
tv <- atomically $ newTVar True
_ <- newStablePtr tv
t <- mask_ $ forkIO (blockSTM tv)
killThread t
check b = if b then return () else retry
blockSTM :: TVar Bool -> IO ()
blockSTM tv = do
atomically $ do
v <- readTVar tv
check $ not v
|