{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK hide #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.IOPort
-- Copyright   :  (c) Tamar Christina 2019
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  ghc-devs@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The 'IOPort' type. This is a facility used by the Windows IO subsystem.
--
-- /The API of this module is unstable and not meant to be consumed by the general public./
-- If you absolutely must depend on it, make sure to use a tight upper
-- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
-- change rapidly without much warning.
--
-- We have strict rules with an I/O Port:
-- * writing more than once is an error
-- * reading more than once is an error
--
-- It gives us the ability to have one thread to block, wait for a result from
-- another thread and then being woken up. *Nothing* more.
--
-- This type is very much GHC internal. It might be changed or removed without
-- notice in future releases.
--
-----------------------------------------------------------------------------

module GHC.Internal.IOPort (
        -- * IOPorts
          IOPort(..)
        , newIOPort
        , newEmptyIOPort
        , readIOPort
        , writeIOPort
        , doubleReadException
    ) where

import GHC.Internal.Base
import GHC.Internal.Exception
import GHC.Internal.Text.Show

data IOPortException = IOPortException deriving Int -> IOPortException -> ShowS
[IOPortException] -> ShowS
IOPortException -> String
(Int -> IOPortException -> ShowS)
-> (IOPortException -> String)
-> ([IOPortException] -> ShowS)
-> Show IOPortException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IOPortException -> ShowS
showsPrec :: Int -> IOPortException -> ShowS
$cshow :: IOPortException -> String
show :: IOPortException -> String
$cshowList :: [IOPortException] -> ShowS
showList :: [IOPortException] -> ShowS
Show

instance Exception IOPortException where
    displayException :: IOPortException -> String
displayException IOPortException
IOPortException = String
"IOPortException"


doubleReadException :: SomeException
doubleReadException :: SomeException
doubleReadException = IOPortException -> SomeException
forall e. Exception e => e -> SomeException
toException IOPortException
IOPortException

data IOPort a = IOPort (IOPort# RealWorld a)
{- ^
An 'IOPort' is a synchronising variable, used
for communication between concurrent threads, where one of the threads is
controlled by an external state. e.g. by an I/O action that is serviced by the
runtime.  It can be thought of as a box, which may be empty or full.

It is mostly similar to the behavior of 'Control.Concurrent.MVar.MVar'
except 'writeIOPort' doesn't block if the variable is full and the GC
won't forcibly release the lock if it thinks
there's a deadlock.

The properties of IOPorts are:
* Writing to an empty IOPort will not block.
* Writing to an full  IOPort will not block. It might throw an exception.
* Reading from an IOPort for the second time might throw an exception.
* Reading from a full IOPort will not block, return the value and empty the port.
* Reading from an empty IOPort will block until a write.
* Reusing an IOPort (that is, reading or writing twice) is not supported
  and might throw an exception. Even if reads and writes are
  interleaved.

This type is very much GHC internal. It might be changed or removed without
notice in future releases.

-}

-- | @since base-4.1.0.0
instance Eq (IOPort a) where
        (IOPort IOPort# RealWorld a
ioport1#) == :: IOPort a -> IOPort a -> Bool
== (IOPort IOPort# RealWorld a
ioport2#) =
            Int# -> Bool
isTrue# (IOPort# RealWorld a -> IOPort# RealWorld a -> Int#
forall s a. IOPort# s a -> IOPort# s a -> Int#
sameIOPort# IOPort# RealWorld a
ioport1# IOPort# RealWorld a
ioport2#)



-- |Create an 'IOPort' which is initially empty.
newEmptyIOPort  :: IO (IOPort a)
newEmptyIOPort :: forall a. IO (IOPort a)
newEmptyIOPort = (State# RealWorld -> (# State# RealWorld, IOPort a #))
-> IO (IOPort a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, IOPort a #))
 -> IO (IOPort a))
-> (State# RealWorld -> (# State# RealWorld, IOPort a #))
-> IO (IOPort a)
forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case State# RealWorld -> (# State# RealWorld, IOPort# RealWorld a #)
forall d a. State# d -> (# State# d, IOPort# d a #)
newIOPort# State# RealWorld
s# of
         (# State# RealWorld
s2#, IOPort# RealWorld a
svar# #) -> (# State# RealWorld
s2#, IOPort# RealWorld a -> IOPort a
forall a. IOPort# RealWorld a -> IOPort a
IOPort IOPort# RealWorld a
svar# #)

-- |Create an 'IOPort' which contains the supplied value.
newIOPort :: a -> IO (IOPort a)
newIOPort :: forall a. a -> IO (IOPort a)
newIOPort a
value =
    IO (IOPort a)
forall a. IO (IOPort a)
newEmptyIOPort        IO (IOPort a) -> (IOPort a -> IO (IOPort a)) -> IO (IOPort a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ IOPort a
ioport ->
    IOPort a -> a -> IO Bool
forall a. IOPort a -> a -> IO Bool
writeIOPort IOPort a
ioport a
value  IO Bool -> IO (IOPort a) -> IO (IOPort a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    IOPort a -> IO (IOPort a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOPort a
ioport

-- |Atomically read the contents of the 'IOPort'.  If the 'IOPort' is
-- currently empty, 'readIOPort' will wait until it is full.  After a
-- 'readIOPort', the 'IOPort' is left empty.
--
-- There is one important property of 'readIOPort':
--
--   * Only a single threads can be blocked on an 'IOPort'.
--
readIOPort :: IOPort a -> IO a
readIOPort :: forall a. IOPort a -> IO a
readIOPort (IOPort IOPort# RealWorld a
ioport#) = (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# -> IOPort# RealWorld a
-> State# RealWorld -> (# State# RealWorld, a #)
forall d a. IOPort# d a -> State# d -> (# State# d, a #)
readIOPort# IOPort# RealWorld a
ioport# State# RealWorld
s#

-- |Put a value into an 'IOPort'.  If the 'IOPort' is currently full,
-- 'writeIOPort' will throw an exception.
--
-- There is one important property of 'writeIOPort':
--
--   * Only a single thread can be blocked on an 'IOPort'.
--
writeIOPort  :: IOPort a -> a -> IO Bool
writeIOPort :: forall a. IOPort a -> a -> IO Bool
writeIOPort (IOPort IOPort# RealWorld a
ioport#) a
x = (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ State# RealWorld
s# ->
    case IOPort# RealWorld a
-> a -> State# RealWorld -> (# State# RealWorld, Int# #)
forall d a. IOPort# d a -> a -> State# d -> (# State# d, Int# #)
writeIOPort# IOPort# RealWorld a
ioport# a
x State# RealWorld
s# of
        (# State# RealWorld
s, Int#
0# #) -> (# State# RealWorld
s, Bool
False #)
        (# State# RealWorld
s, Int#
_  #) -> (# State# RealWorld
s, Bool
True #)