(original) (raw)

{-# LANGUAGE Unsafe #-} {-# LANGUAGE NoImplicitPrelude , BangPatterns , RankNTypes , MagicHash , ScopedTypeVariables , UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK not-home #-}

module GHC.IO ( IO(..), unIO, liftIO, mplusIO, unsafePerformIO, unsafeInterleaveIO, unsafeDupablePerformIO, unsafeDupableInterleaveIO, noDuplicate,

    [stToIO](GHC.IO.html#stToIO), [ioToST](GHC.IO.html#ioToST), [unsafeIOToST](GHC.IO.html#unsafeIOToST), [unsafeSTToIO](GHC.IO.html#unsafeSTToIO),

    [FilePath](GHC.IO.html#FilePath),

    [catch](GHC.IO.html#catch), [catchException](GHC.IO.html#catchException), [catchAny](GHC.IO.html#catchAny), [throwIO](GHC.IO.html#throwIO),
    [mask](GHC.IO.html#mask), [mask_](GHC.IO.html#mask%5F), [uninterruptibleMask](GHC.IO.html#uninterruptibleMask), [uninterruptibleMask_](GHC.IO.html#uninterruptibleMask%5F),
    [MaskingState](GHC.IO.html#MaskingState)(..), [getMaskingState](GHC.IO.html#getMaskingState),
    [unsafeUnmask](GHC.IO.html#unsafeUnmask), [interruptible](GHC.IO.html#interruptible),
    [onException](GHC.IO.html#onException), [bracket](GHC.IO.html#bracket), [finally](GHC.IO.html#finally), [evaluate](GHC.IO.html#evaluate),
    [mkUserError](GHC.IO.html#mkUserError)
) where

import GHC.Base import GHC.ST import GHC.Exception import GHC.Show import GHC.IO.Unsafe import Unsafe.Coerce ( unsafeCoerce )

import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )

liftIO :: IO a -> State# RealWorld -> STret RealWorld a liftIO :: forall a. IO a -> State# RealWorld -> STret RealWorld a liftIO (IO State# RealWorld -> (# State# RealWorld, a #) m) = \State# RealWorld s -> case State# RealWorld -> (# State# RealWorld, a #) m State# RealWorld s of (# State# RealWorld s', a r #) -> State# RealWorld -> a -> STret RealWorld a forall s a. State# s -> a -> STret s a STret State# RealWorld s' a r

stToIO :: ST RealWorld a -> IO a stToIO :: forall a. ST RealWorld a -> IO a stToIO (ST STRep RealWorld a m) = STRep RealWorld a -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO STRep RealWorld a m

ioToST :: IO a -> ST RealWorld a ioToST :: forall a. IO a -> ST RealWorld a ioToST (IO State# RealWorld -> (# State# RealWorld, a #) m) = ((State# RealWorld -> (# State# RealWorld, a #)) -> ST RealWorld a forall s a. STRep s a -> ST s a ST State# RealWorld -> (# State# RealWorld, a #) m)

unsafeIOToST :: IO a -> ST s a unsafeIOToST :: forall a s. IO a -> ST s a unsafeIOToST (IO State# RealWorld -> (# State# RealWorld, a #) io) = STRep s a -> ST s a forall s a. STRep s a -> ST s a ST (STRep s a -> ST s a) -> STRep s a -> ST s a forall a b. (a -> b) -> a -> b $ \ State# s s -> ((State# RealWorld -> (# State# RealWorld, a #)) -> STRep s a forall a b. a -> b unsafeCoerce State# RealWorld -> (# State# RealWorld, a #) io) State# s s

unsafeSTToIO :: ST s a -> IO a unsafeSTToIO :: forall s a. ST s a -> IO a unsafeSTToIO (ST STRep s a m) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO (STRep s a -> State# RealWorld -> (# State# RealWorld, a #) forall a b. a -> b unsafeCoerce STRep s a m)

type FilePath = String

catchException :: Exception e => IO a -> (e -> IO a) -> IO a catchException :: forall e a. Exception e => IO a -> (e -> IO a) -> IO a catchException !IO a io e -> IO a handler = IO a -> (e -> IO a) -> IO a forall e a. Exception e => IO a -> (e -> IO a) -> IO a catch IO a io e -> IO a handler

catch :: Exception e => IO a
-> (e -> IO a)
-> IO a

catch :: forall e a. Exception e => IO a -> (e -> IO a) -> IO a catch (IO State# RealWorld -> (# State# RealWorld, a #) io) e -> IO a handler = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ (State# RealWorld -> (# State# RealWorld, a #)) -> (SomeException -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) forall a b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) catch# State# RealWorld -> (# State# RealWorld, a #) io SomeException -> State# RealWorld -> (# State# RealWorld, a #) handler' where handler' :: SomeException -> State# RealWorld -> (# State# RealWorld, a #) handler' SomeException e = case SomeException -> Maybe e forall e. Exception e => SomeException -> Maybe e fromException SomeException e of Just e e' -> IO a -> State# RealWorld -> (# State# RealWorld, a #) forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #) unIO (e -> IO a handler e e') Maybe e Nothing -> SomeException -> State# RealWorld -> (# State# RealWorld, a #) forall a b. a -> State# RealWorld -> (# State# RealWorld, b #) raiseIO# SomeException e

catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a catchAny :: forall a. IO a -> (forall e. Exception e => e -> IO a) -> IO a catchAny !(IO State# RealWorld -> (# State# RealWorld, a #) io) forall e. Exception e => e -> IO a handler = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ (State# RealWorld -> (# State# RealWorld, a #)) -> (SomeException -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) forall a b. (State# RealWorld -> (# State# RealWorld, a #)) -> (b -> State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) catch# State# RealWorld -> (# State# RealWorld, a #) io SomeException -> State# RealWorld -> (# State# RealWorld, a #) handler' where handler' :: SomeException -> State# RealWorld -> (# State# RealWorld, a #) handler' (SomeException e e) = IO a -> State# RealWorld -> (# State# RealWorld, a #) forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #) unIO (e -> IO a forall e. Exception e => e -> IO a handler e e)

mplusIO :: IO a -> IO a -> IO a mplusIO :: forall a. IO a -> IO a -> IO a mplusIO IO a m IO a n = IO a m IO a -> (IOError -> IO a) -> IO a forall e a. Exception e => IO a -> (e -> IO a) -> IO a catchException \ (IOError _ :: IOError) -> IO a n

throwIO :: Exception e => e -> IO a throwIO :: forall e a. Exception e => e -> IO a throwIO e e = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO (SomeException -> State# RealWorld -> (# State# RealWorld, a #) forall a b. a -> State# RealWorld -> (# State# RealWorld, b #) raiseIO# (e -> SomeException forall e. Exception e => e -> SomeException toException e e))

block :: IO a -> IO a block :: forall a. IO a -> IO a block (IO State# RealWorld -> (# State# RealWorld, a #) io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) maskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #) io

unblock :: IO a -> IO a unblock :: forall a. IO a -> IO a unblock = IO a -> IO a forall a. IO a -> IO a unsafeUnmask

unsafeUnmask :: IO a -> IO a unsafeUnmask :: forall a. IO a -> IO a unsafeUnmask (IO State# RealWorld -> (# State# RealWorld, a #) io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) unmaskAsyncExceptions# State# RealWorld -> (# State# RealWorld, a #) io

interruptible :: IO a -> IO a interruptible :: forall a. IO a -> IO a interruptible IO a act = do MaskingState st <- IO MaskingState getMaskingState case MaskingState st of MaskingState Unmasked -> IO a act MaskingState MaskedInterruptible -> IO a -> IO a forall a. IO a -> IO a unsafeUnmask IO a act MaskingState MaskedUninterruptible -> IO a act

blockUninterruptible :: IO a -> IO a blockUninterruptible :: forall a. IO a -> IO a blockUninterruptible (IO State# RealWorld -> (# State# RealWorld, a #) io) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> State# RealWorld -> (# State# RealWorld, a #) maskUninterruptible# State# RealWorld -> (# State# RealWorld, a #) io

data MaskingState = Unmasked | MaskedInterruptible

| MaskedUninterruptible

deriving ( MaskingState -> MaskingState -> Bool (MaskingState -> MaskingState -> Bool) -> (MaskingState -> MaskingState -> Bool) -> Eq MaskingState forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: MaskingState -> MaskingState -> Bool $c/= :: MaskingState -> MaskingState -> Bool == :: MaskingState -> MaskingState -> Bool $c== :: MaskingState -> MaskingState -> Bool Eq
, Int -> MaskingState -> ShowS [MaskingState] -> ShowS MaskingState -> String (Int -> MaskingState -> ShowS) -> (MaskingState -> String) -> ([MaskingState] -> ShowS) -> Show MaskingState forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [MaskingState] -> ShowS $cshowList :: [MaskingState] -> ShowS show :: MaskingState -> String $cshow :: MaskingState -> String showsPrec :: Int -> MaskingState -> ShowS $cshowsPrec :: Int -> MaskingState -> ShowS Show )

getMaskingState :: IO MaskingState getMaskingState :: IO MaskingState getMaskingState = (State# RealWorld -> (# State# RealWorld, MaskingState #)) -> IO MaskingState forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, MaskingState #)) -> IO MaskingState) -> (State# RealWorld -> (# State# RealWorld, MaskingState #)) -> IO MaskingState forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case State# RealWorld -> (# State# RealWorld, Int# #) getMaskingState# State# RealWorld s of (# State# RealWorld s', Int# i #) -> (# State# RealWorld s', case Int# i of Int# 0# -> MaskingState Unmasked Int# 1# -> MaskingState MaskedUninterruptible Int# _ -> MaskingState MaskedInterruptible #)

onException :: IO a -> IO b -> IO a onException :: forall a b. IO a -> IO b -> IO a onException IO a io IO b what = IO a io IO a -> (SomeException -> IO a) -> IO a forall e a. Exception e => IO a -> (e -> IO a) -> IO a catchException \SomeException e -> do b _ <- IO b what SomeException -> IO a forall e a. Exception e => e -> IO a throwIO (SomeException e :: SomeException)

mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b

mask_ :: IO a -> IO a

uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b

uninterruptibleMask_ :: IO a -> IO a

mask_ :: forall a. IO a -> IO a mask_ IO a io = ((forall a. IO a -> IO a) -> IO a) -> IO a forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b mask (((forall a. IO a -> IO a) -> IO a) -> IO a) -> ((forall a. IO a -> IO a) -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \forall a. IO a -> IO a _ -> IO a io

mask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b mask (forall a. IO a -> IO a) -> IO b io = do MaskingState b <- IO MaskingState getMaskingState case MaskingState b of MaskingState Unmasked -> IO b -> IO b forall a. IO a -> IO a block (IO b -> IO b) -> IO b -> IO b forall a b. (a -> b) -> a -> b $ (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a unblock MaskingState MaskedInterruptible -> (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a block MaskingState MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a blockUninterruptible

uninterruptibleMask_ :: forall a. IO a -> IO a uninterruptibleMask_ IO a io = ((forall a. IO a -> IO a) -> IO a) -> IO a forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b uninterruptibleMask (((forall a. IO a -> IO a) -> IO a) -> IO a) -> ((forall a. IO a -> IO a) -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \forall a. IO a -> IO a _ -> IO a io

uninterruptibleMask :: forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b uninterruptibleMask (forall a. IO a -> IO a) -> IO b io = do MaskingState b <- IO MaskingState getMaskingState case MaskingState b of MaskingState Unmasked -> IO b -> IO b forall a. IO a -> IO a blockUninterruptible (IO b -> IO b) -> IO b -> IO b forall a b. (a -> b) -> a -> b $ (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a unblock MaskingState MaskedInterruptible -> IO b -> IO b forall a. IO a -> IO a blockUninterruptible (IO b -> IO b) -> IO b -> IO b forall a b. (a -> b) -> a -> b $ (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a block MaskingState MaskedUninterruptible -> (forall a. IO a -> IO a) -> IO b io forall a. IO a -> IO a blockUninterruptible

bracket :: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracket :: forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket IO a before a -> IO b after a -> IO c thing = ((forall a. IO a -> IO a) -> IO c) -> IO c forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b mask (((forall a. IO a -> IO a) -> IO c) -> IO c) -> ((forall a. IO a -> IO a) -> IO c) -> IO c forall a b. (a -> b) -> a -> b $ \forall a. IO a -> IO a restore -> do a a <- IO a before c r <- IO c -> IO c forall a. IO a -> IO a restore (a -> IO c thing a a) IO c -> IO b -> IO c forall a b. IO a -> IO b -> IO a onException a -> IO b after a a b _ <- a -> IO b after a a c -> IO c forall (m :: * -> *) a. Monad m => a -> m a return c r

finally :: IO a
-> IO b

    -> [IO](../../ghc-prim-0.8.0/src/GHC-Types.html#IO) [a](#local-6989586621679581810)         

IO a a finally :: forall a b. IO a -> IO b -> IO a finally IO b sequel = ((forall a. IO a -> IO a) -> IO a) -> IO a forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b mask (((forall a. IO a -> IO a) -> IO a) -> IO a) -> ((forall a. IO a -> IO a) -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \forall a. IO a -> IO a restore -> do a r <- IO a -> IO a forall a. IO a -> IO a restore IO a a IO a -> IO b -> IO a forall a b. IO a -> IO b -> IO a onException IO b sequel b _ <- IO b sequel a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return a r

evaluate :: a -> IO a evaluate :: forall a. a -> IO a evaluate a a = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a) -> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> a -> State# RealWorld -> (# State# RealWorld, a #) forall a d. a -> State# d -> (# State# d, a #) seq# a a State# RealWorld s

mkUserError :: [Char] -> SomeException mkUserError :: String -> SomeException mkUserError String str = IOError -> SomeException forall e. Exception e => e -> SomeException toException (String -> IOError userError String str)