(original) (raw)

{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK not-home #-}

module Control.Monad.ST.Imp (

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

    
    [RealWorld](../../ghc-prim-0.8.0/src/GHC-Prim.html#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 :: forall a s. (a -> ST s a) -> ST s a fixST a -> ST s a k = IO a -> ST s a forall a s. IO a -> ST s a unsafeIOToST (IO a -> ST s a) -> IO a -> ST s a forall a b. (a -> b) -> a -> b $ do MVar a m <- IO (MVar a) forall a. IO (MVar a) newEmptyMVar a ans <- IO a -> IO a forall a. IO a -> IO a unsafeDupableInterleaveIO (MVar a -> IO a forall a. MVar a -> IO a readMVar MVar a m IO a -> (BlockedIndefinitelyOnMVar -> IO a) -> IO a forall e a. Exception e => IO a -> (e -> IO a) -> IO a catch \BlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar -> NonTermination -> IO a forall e a. Exception e => e -> IO a throwIO NonTermination NonTermination) a result <- ST s a -> IO a forall s a. ST s a -> IO a unsafeSTToIO (a -> ST s a k a ans) MVar a -> a -> IO () forall a. MVar a -> a -> IO () putMVar MVar a m a result a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return a result