module Feldspar.Run.Concurrent
( ThreadId
, Chan, Closeable, Uncloseable
, Transferable (..), BulkTransferable (..)
, fork
, forkWithId
, asyncKillThread
, killThread
, waitThread
, delayThread
, closeChan
, lastChanReadOK
) where
import Prelude hiding ((&&))
import Data.Proxy
import Data.TypedStruct
import qualified Language.Embedded.Concurrent as Imp
import Language.Embedded.Concurrent (ThreadId, Chan, Closeable, Uncloseable)
import Feldspar
import Feldspar.Representation
import Feldspar.Run.Representation
fork :: Run () -> Run ThreadId
fork = Run . Imp.fork . unRun
forkWithId :: (ThreadId -> Run ()) -> Run ThreadId
forkWithId f = Run $ Imp.forkWithId (unRun . f)
asyncKillThread :: ThreadId -> Run ()
asyncKillThread = Run . Imp.asyncKillThread
killThread :: ThreadId -> Run ()
killThread = Run . Imp.killThread
waitThread :: ThreadId -> Run ()
waitThread = Run . Imp.waitThread
delayThread :: Integral i => Data i -> Run ()
delayThread = Run . Imp.delayThread
class Transferable a
where
type SizeSpec a :: *
calcChanSize :: proxy a -> SizeSpec a -> Imp.ChanSize Data PrimType' Length
newChan :: SizeSpec a -> Run (Chan Uncloseable a)
newChan = Run . Imp.newChan' . calcChanSize (Proxy :: Proxy a)
newCloseableChan :: SizeSpec a -> Run (Chan Closeable a)
newCloseableChan = Run . Imp.newCloseableChan' . calcChanSize (Proxy :: Proxy a)
readChan :: Chan t a -> Run a
readChan = untypedReadChan
untypedReadChan :: Chan t c -> Run a
writeChan :: Chan t a -> a -> Run (Data Bool)
writeChan = untypedWriteChan
untypedWriteChan :: Chan t c -> a -> Run (Data Bool)
class Transferable a => BulkTransferable a
where
type ContainerType a :: *
readChanBuf :: Chan t a
-> Data Index
-> Data Index
-> (ContainerType a)
-> Run (Data Bool)
readChanBuf = untypedReadChanBuf (Proxy :: Proxy a)
untypedReadChanBuf :: proxy a
-> Chan t c
-> Data Index
-> Data Index
-> (ContainerType a)
-> Run (Data Bool)
writeChanBuf :: Chan t a
-> Data Index
-> Data Index
-> (ContainerType a)
-> Run (Data Bool)
writeChanBuf = untypedWriteChanBuf (Proxy :: Proxy a)
untypedWriteChanBuf :: proxy a
-> Chan t c
-> Data Index
-> Data Index
-> (ContainerType a)
-> Run (Data Bool)
lastChanReadOK :: Chan Closeable a -> Run (Data Bool)
lastChanReadOK = Run . Imp.lastChanReadOK
closeChan :: Chan Closeable a -> Run ()
closeChan = Run . Imp.closeChan
instance PrimType' a => Transferable (Data a)
where
type SizeSpec (Data a) = Data Length
calcChanSize _ sz = sz `Imp.timesSizeOf` (Proxy :: Proxy a)
untypedReadChan = Run . Imp.readChan'
untypedWriteChan c = Run . Imp.writeChan' c
instance PrimType' a => BulkTransferable (Data a)
where
type ContainerType (Data a) = DArr a
untypedReadChanBuf _ c off len arr = do
r <- sequence $ listStruct (Run . Imp.readChanBuf' c off len) (unArr arr)
return $ foldl1 (&&) r
untypedWriteChanBuf _ c off len arr = do
r <- sequence $ listStruct (Run . Imp.writeChanBuf' c off len) (unArr arr)
return $ foldl1 (&&) r
instance ( Transferable a, Transferable b
, SizeSpec a ~ SizeSpec b
) => Transferable (a, b)
where
type SizeSpec (a, b) = SizeSpec a
calcChanSize _ sz =
let asz = calcChanSize (Proxy :: Proxy a) sz
bsz = calcChanSize (Proxy :: Proxy b) sz
in asz `Imp.plusSize` bsz
untypedReadChan ch = (,) <$> untypedReadChan ch <*> untypedReadChan ch
untypedWriteChan ch (a, b) = do
sa <- untypedWriteChan ch a
ifE sa (untypedWriteChan ch b) (return false)
instance ( Transferable a, Transferable b, Transferable c
, SizeSpec a ~ SizeSpec b, SizeSpec b ~ SizeSpec c
) => Transferable (a, b, c)
where
type SizeSpec (a, b, c) = SizeSpec a
calcChanSize _ sz =
let asz = calcChanSize (Proxy :: Proxy a) sz
bsz = calcChanSize (Proxy :: Proxy b) sz
csz = calcChanSize (Proxy :: Proxy c) sz
in asz `Imp.plusSize` bsz `Imp.plusSize` csz
untypedReadChan ch = (,,)
<$> untypedReadChan ch
<*> untypedReadChan ch
<*> untypedReadChan ch
untypedWriteChan ch (a, b, c) = do
sa <- untypedWriteChan ch a
ifE sa
(do sb <- untypedWriteChan ch b
ifE sb (untypedWriteChan ch c) (return false))
(return false)
instance ( Transferable a, Transferable b, Transferable c, Transferable d
, SizeSpec a ~ SizeSpec b, SizeSpec b ~ SizeSpec c, SizeSpec c ~ SizeSpec d
) => Transferable (a, b, c, d)
where
type SizeSpec (a, b, c, d) = SizeSpec a
calcChanSize _ sz =
let asz = calcChanSize (Proxy :: Proxy a) sz
bsz = calcChanSize (Proxy :: Proxy b) sz
csz = calcChanSize (Proxy :: Proxy c) sz
dsz = calcChanSize (Proxy :: Proxy d) sz
in asz `Imp.plusSize` bsz `Imp.plusSize` csz `Imp.plusSize` dsz
untypedReadChan ch = (,,,)
<$> untypedReadChan ch
<*> untypedReadChan ch
<*> untypedReadChan ch
<*> untypedReadChan ch
untypedWriteChan ch (a, b, c, d) = do
sa <- untypedWriteChan ch a
ifE sa
(do sb <- untypedWriteChan ch b
ifE sb
(do sc <- untypedWriteChan ch c
ifE sc
(untypedWriteChan ch d)
(return false))
(return false))
(return false)