(original) (raw)

{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK hide #-}

module Control.Monad.ST.Imp (

    [ST](GHC.ST.html#ST),             
    [runST](GHC.ST.html#runST),
    [fixST](Control.Monad.ST.Imp.html#fixST),

    
    RealWorld,              
    [stToIO](GHC.IO.html#stToIO),

    
    [unsafeInterleaveST](GHC.ST.html#unsafeInterleaveST),
    [unsafeDupableInterleaveST](GHC.ST.html#unsafeDupableInterleaveST),
    [unsafeIOToST](GHC.IO.html#unsafeIOToST),
    [unsafeSTToIO](GHC.IO.html#unsafeSTToIO)
) where

import GHC.ST ( ST, runST, unsafeInterleaveST , unsafeDupableInterleaveST ) import GHC.Base ( RealWorld, ($), return ) import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO , unsafeDupableInterleaveIO ) import GHC.MVar ( readMVar, putMVar, newEmptyMVar ) import Control.Exception.Base ( catch, throwIO, NonTermination (..) , BlockedIndefinitelyOnMVar (..) )

fixST :: (a -> ST s a) -> ST s a

fixST k = unsafeIOToST $ do m <- newEmptyMVar ans <- unsafeDupableInterleaveIO (readMVar m [catch](GHC.IO.html#catch) [BlockedIndefinitelyOnMVar](GHC.IO.Exception.html#BlockedIndefinitelyOnMVar) -> throwIO NonTermination) result <- unsafeSTToIO (k ans) putMVar m result return result