id,summary,reporter,owner,description,type,status,priority,milestone,component,version,resolution,keywords,cc,os,architecture,failure,difficulty,testcase,blockedby,blocking,related
5238,throwSTM+catchSTM pollutes the masking state,mikhail.vorozhtsov,simonmar,"The following program prints ""(Unmasked,MaskedUninterruptible)""
{{{
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Exception
import Control.Concurrent.STM
import GHC.Conc (STM(..))
import GHC.Prim (getMaskingState#)

getMaskingStateSTM = STM $ \s → case getMaskingState# s of
 (# s', i #) -> (# s', case i of 0# → Unmasked
                                 1# → MaskedUninterruptible
                                 _  → MaskedInterruptible #)

main = do
  mss ← atomically $ do
    ms1 ← getMaskingStateSTM
    (throwSTM Overflow) `catchSTM` (\(e ∷ SomeException) → return ())
    ms2 ← getMaskingStateSTM
    return (ms1, ms2)
  putStrLn $ show mss
}}}
I would be nice to have (un)maskAsyncExceptions+retry supported too, currenly
{{{
maskSTM (STM stm) = STM $ maskAsyncExceptions# stm

main = do
  mss ← atomically $ do
    ms1 ← getMaskingStateSTM
    maskSTM retry `orElse` return ()
    ms2 ← getMaskingStateSTM
    return (ms1, ms2)
  putStrLn $ show mss
}}}
prints ""(Unmasked,MaskedInterruptible)""",bug,closed,high,7.4.1,Runtime System,7.1,fixed,stm,,Unknown/Multiple,Unknown/Multiple,None/Unknown,,,,,