#ifdef __GLASGOW_HASKELL__
#endif
module Control.Concurrent.Chan
(
Chan,
newChan,
writeChan,
readChan,
dupChan,
unGetChan,
isEmptyChan,
getChanContents,
writeList2Chan,
) where
import Prelude
import System.IO.Unsafe ( unsafeInterleaveIO )
import Control.Concurrent.MVar
import Control.Exception (mask_)
import Data.Typeable
#include "Typeable.h"
#define _UPK_(x) {-# UNPACK #-} !(x)
data Chan a
= Chan _UPK_(MVar (Stream a))
_UPK_(MVar (Stream a))
deriving Eq
INSTANCE_TYPEABLE1(Chan,chanTc,"Chan")
type Stream a = MVar (ChItem a)
data ChItem a = ChItem a _UPK_(Stream a)
newChan :: IO (Chan a)
newChan = do
hole <- newEmptyMVar
readVar <- newMVar hole
writeVar <- newMVar hole
return (Chan readVar writeVar)
writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
new_hole <- newEmptyMVar
mask_ $ do
old_hole <- takeMVar writeVar
putMVar old_hole (ChItem val new_hole)
putMVar writeVar new_hole
readChan :: Chan a -> IO a
readChan (Chan readVar _) = do
modifyMVarMasked readVar $ \read_end -> do
(ChItem val new_read_end) <- readMVar read_end
return (new_read_end, val)
dupChan :: Chan a -> IO (Chan a)
dupChan (Chan _ writeVar) = do
hole <- readMVar writeVar
newReadVar <- newMVar hole
return (Chan newReadVar writeVar)
unGetChan :: Chan a -> a -> IO ()
unGetChan (Chan readVar _) val = do
new_read_end <- newEmptyMVar
modifyMVar_ readVar $ \read_end -> do
putMVar new_read_end (ChItem val read_end)
return new_read_end
isEmptyChan :: Chan a -> IO Bool
isEmptyChan (Chan readVar writeVar) = do
withMVar readVar $ \r -> do
w <- readMVar writeVar
let eq = r == w
eq `seq` return eq
getChanContents :: Chan a -> IO [a]
getChanContents ch
= unsafeInterleaveIO (do
x <- readChan ch
xs <- getChanContents ch
return (x:xs)
)
writeList2Chan :: Chan a -> [a] -> IO ()
writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4