{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Concurrent.STM.TChan (
#ifdef __GLASGOW_HASKELL__
TChan,
newTChan,
newTChanIO,
newBroadcastTChan,
newBroadcastTChanIO,
dupTChan,
cloneTChan,
readTChan,
tryReadTChan,
peekTChan,
tryPeekTChan,
writeTChan,
unGetTChan,
isEmptyTChan
#endif
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Conc
import Data.Typeable (Typeable)
#define _UPK_(x) {-# UNPACK #-} !(x)
data TChan a = TChan _UPK_(TVar (TVarList a))
_UPK_(TVar (TVarList a))
deriving (TChan a -> TChan a -> Bool
forall a. TChan a -> TChan a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TChan a -> TChan a -> Bool
$c/= :: forall a. TChan a -> TChan a -> Bool
== :: TChan a -> TChan a -> Bool
$c== :: forall a. TChan a -> TChan a -> Bool
Eq, Typeable)
type TVarList a = TVar (TList a)
data TList a = TNil | TCons a _UPK_(TVarList a)
newTChan :: STM (TChan a)
newTChan :: forall a. STM (TChan a)
newTChan = do
TVar (TList a)
hole <- forall a. a -> STM (TVar a)
newTVar forall a. TList a
TNil
TVar (TVar (TList a))
read <- forall a. a -> STM (TVar a)
newTVar TVar (TList a)
hole
TVar (TVar (TList a))
write <- forall a. a -> STM (TVar a)
newTVar TVar (TList a)
hole
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVar (TList a))
read TVar (TVar (TList a))
write)
newTChanIO :: IO (TChan a)
newTChanIO :: forall a. IO (TChan a)
newTChanIO = do
TVar (TList a)
hole <- forall a. a -> IO (TVar a)
newTVarIO forall a. TList a
TNil
TVar (TVar (TList a))
read <- forall a. a -> IO (TVar a)
newTVarIO TVar (TList a)
hole
TVar (TVar (TList a))
write <- forall a. a -> IO (TVar a)
newTVarIO TVar (TList a)
hole
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVar (TList a))
read TVar (TVar (TList a))
write)
newBroadcastTChan :: STM (TChan a)
newBroadcastTChan :: forall a. STM (TChan a)
newBroadcastTChan = do
TVar (TList a)
write_hole <- forall a. a -> STM (TVar a)
newTVar forall a. TList a
TNil
TVar (TVar (TList a))
read <- forall a. a -> STM (TVar a)
newTVar (forall a. HasCallStack => [Char] -> a
error [Char]
"reading from a TChan created by newBroadcastTChan; use dupTChan first")
TVar (TVar (TList a))
write <- forall a. a -> STM (TVar a)
newTVar TVar (TList a)
write_hole
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVar (TList a))
read TVar (TVar (TList a))
write)
newBroadcastTChanIO :: IO (TChan a)
newBroadcastTChanIO :: forall a. IO (TChan a)
newBroadcastTChanIO = do
TVar (TList a)
write_hole <- forall a. a -> IO (TVar a)
newTVarIO forall a. TList a
TNil
TVar (TVar (TList a))
read <- forall a. a -> IO (TVar a)
newTVarIO (forall a. HasCallStack => [Char] -> a
error [Char]
"reading from a TChan created by newBroadcastTChanIO; use dupTChan first")
TVar (TVar (TList a))
write <- forall a. a -> IO (TVar a)
newTVarIO TVar (TList a)
write_hole
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVar (TList a))
read TVar (TVar (TList a))
write)
writeTChan :: TChan a -> a -> STM ()
writeTChan :: forall a. TChan a -> a -> STM ()
writeTChan (TChan TVar (TVarList a)
_read TVar (TVarList a)
write) a
a = do
TVarList a
listend <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
write
TVarList a
new_listend <- forall a. a -> STM (TVar a)
newTVar forall a. TList a
TNil
forall a. TVar a -> a -> STM ()
writeTVar TVarList a
listend (forall a. a -> TVarList a -> TList a
TCons a
a TVarList a
new_listend)
forall a. TVar a -> a -> STM ()
writeTVar TVar (TVarList a)
write TVarList a
new_listend
readTChan :: TChan a -> STM a
readTChan :: forall a. TChan a -> STM a
readTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TList a
head <- forall a. TVar a -> STM a
readTVar TVarList a
listhead
case TList a
head of
TList a
TNil -> forall a. STM a
retry
TCons a
a TVarList a
tail -> do
forall a. TVar a -> a -> STM ()
writeTVar TVar (TVarList a)
read TVarList a
tail
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
tryReadTChan :: TChan a -> STM (Maybe a)
tryReadTChan :: forall a. TChan a -> STM (Maybe a)
tryReadTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TList a
head <- forall a. TVar a -> STM a
readTVar TVarList a
listhead
case TList a
head of
TList a
TNil -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
TCons a
a TVarList a
tl -> do
forall a. TVar a -> a -> STM ()
writeTVar TVar (TVarList a)
read TVarList a
tl
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
peekTChan :: TChan a -> STM a
peekTChan :: forall a. TChan a -> STM a
peekTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TList a
head <- forall a. TVar a -> STM a
readTVar TVarList a
listhead
case TList a
head of
TList a
TNil -> forall a. STM a
retry
TCons a
a TVarList a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
tryPeekTChan :: TChan a -> STM (Maybe a)
tryPeekTChan :: forall a. TChan a -> STM (Maybe a)
tryPeekTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TList a
head <- forall a. TVar a -> STM a
readTVar TVarList a
listhead
case TList a
head of
TList a
TNil -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
TCons a
a TVarList a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
dupTChan :: TChan a -> STM (TChan a)
dupTChan :: forall a. TChan a -> STM (TChan a)
dupTChan (TChan TVar (TVarList a)
_read TVar (TVarList a)
write) = do
TVarList a
hole <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
write
TVar (TVarList a)
new_read <- forall a. a -> STM (TVar a)
newTVar TVarList a
hole
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVarList a)
new_read TVar (TVarList a)
write)
unGetTChan :: TChan a -> a -> STM ()
unGetTChan :: forall a. TChan a -> a -> STM ()
unGetTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) a
a = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TVarList a
newhead <- forall a. a -> STM (TVar a)
newTVar (forall a. a -> TVarList a -> TList a
TCons a
a TVarList a
listhead)
forall a. TVar a -> a -> STM ()
writeTVar TVar (TVarList a)
read TVarList a
newhead
isEmptyTChan :: TChan a -> STM Bool
isEmptyTChan :: forall a. TChan a -> STM Bool
isEmptyTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
_write) = do
TVarList a
listhead <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TList a
head <- forall a. TVar a -> STM a
readTVar TVarList a
listhead
case TList a
head of
TList a
TNil -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
TCons a
_ TVarList a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
cloneTChan :: TChan a -> STM (TChan a)
cloneTChan :: forall a. TChan a -> STM (TChan a)
cloneTChan (TChan TVar (TVarList a)
read TVar (TVarList a)
write) = do
TVarList a
readpos <- forall a. TVar a -> STM a
readTVar TVar (TVarList a)
read
TVar (TVarList a)
new_read <- forall a. a -> STM (TVar a)
newTVar TVarList a
readpos
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. TVar (TVarList a) -> TVar (TVarList a) -> TChan a
TChan TVar (TVarList a)
new_read TVar (TVarList a)
write)
#endif