<div dir="ltr">Thanks for the examples showcasing how things can go wrong. I had not even really considered something like the second case. It's weird that STM discards exception handlers, but the idea of ever trying to smuggle something like that into an STM transaction seems insane. Interestingly, it appears that this deadlock can be induced without unsafePerformIO, using the mildly-less-awful unsafeIOToSTM from GHC.Conc. The documentation for it backs up your second example.</div><div class="gmail_extra"><br><div class="gmail_quote">On Sun, Nov 12, 2017 at 2:41 PM, Bertram Felgenhauer via Libraries <span dir="ltr"><<a href="mailto:libraries@haskell.org" target="_blank">libraries@haskell.org</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">Andrew Martin wrote:<br>
> In the stm package, the docs for atomically read:<br>
><br>
> > You cannot use 'atomically' inside an 'unsafePerformIO' or<br>
> 'unsafeInterleaveIO'. Any attempt to do so will result in a runtime error.<br>
>  (Reason: allowing this would effectively allow a transaction inside a<br>
> transaction, depending on exactly when the thunk is evaluated.)<br>
><br>
> This doesn't seem to be true. The following program runs fine:<br>
><br>
>     import Control.Monad.STM<br>
>     import Control.Concurrent.STM.TVar<br>
>     import System.IO.Unsafe<br>
><br>
>     main :: IO ()<br>
>     main = do<br>
>       v <- atomically $ newTVar (7 :: Int)<br>
>       print $ unsafePerformIO $ atomically $ do<br>
>         readTVar v<br>
><br>
> I suspect that the runtime only gives you an error if you actually create a<br>
> nested transaction. Is my understanding correct?<br>
<br>
</span>Yes, that is correct. But you should not conclude from this that using<br>
`unsafePerformIO`, in particular in connection with STM, is safe in any<br>
way. Consider the following program, especially the `main2` function:<br>
<span class=""><br>
  import Control.Monad.STM<br>
  import Control.Concurrent.STM.TVar<br>
  import System.IO.Unsafe<br>
</span>  import Control.Concurrent.MVar<br>
  import Control.Concurrent<br>
  import Control.Monad<br>
  import System.Mem<br>
<br>
  -- This is not very scary but bad news for compositionality:<br>
  -- using STM inside `unsafePerformIO`, used inside `atomically`,<br>
  -- causes an error.<br>
  --<br>
  -- output:<br>
  -- foo: Control.Concurrent.STM.<wbr>atomically was nested<br>
<br>
  main1 = do<br>
      let val = unsafePerformIO (atomically (return (0 :: Int)))<br>
      atomically (return $! val) >>= print<br>
<br>
  -- This one is much worse:<br>
  --<br>
  -- There is no use of STM in the unsafePerformIO-ed action, but the<br>
  -- program ends up taking a resource (an MVar here) without releasing<br>
  -- it; it turns out that when retrying an STM action that is in the<br>
  -- middle of an unsafePerformIO computation, the IO action is stopped<br>
  -- without raising an exception!<br>
  --<br>
  -- output (tested with ghc 7.10.2, 8.0.2 and 8.2.1, but I see no way<br>
  --   to ensuring that it always works):<br>
  -- foo: thread blocked indefinitely in an MVar operation<br>
<br>
  main2 = do<br>
      var <- newMVar ()<br>
      tvar <- atomically $ newTVar (0 :: Int)<br>
      let val v = unsafePerformIO $<br>
          withMVar var $ \_ -> threadDelay 10000 >> return v<br>
      replicateM_ 32 $ do<br>
          forkIO $ atomically (readTVar tvar >>= (writeTVar tvar $!) . val . succ)<br>
      threadDelay 100000<br>
      performGC<br>
      takeMVar var >>= print<br>
<br>
  main = main2<br>
<br>
Cheers,<br>
<br>
Bertram<br>
<div class="HOEnZb"><div class="h5">______________________________<wbr>_________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/libraries</a><br>
</div></div></blockquote></div><br><br clear="all"><div><br></div>-- <br><div class="gmail_signature" data-smartmail="gmail_signature">-Andrew Thaddeus Martin</div>
</div>