unagi-chan 0.3.0.2 → 0.4.0.0
raw patch · 20 files changed
+291/−337 lines, 20 filesdep ~atomic-primopsdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: atomic-primops, base
API changes (from Hackage documentation)
- Control.Concurrent.Chan.Unagi: tryReadChan :: OutChan a -> IO (Element a)
+ Control.Concurrent.Chan.Unagi: tryReadChan :: OutChan a -> IO (Element a, IO a)
- Control.Concurrent.Chan.Unagi.Bounded: tryReadChan :: OutChan a -> IO (Element a)
+ Control.Concurrent.Chan.Unagi.Bounded: tryReadChan :: OutChan a -> IO (Element a, IO a)
- Control.Concurrent.Chan.Unagi.Unboxed: tryReadChan :: UnagiPrim a => OutChan a -> IO (Element a)
+ Control.Concurrent.Chan.Unagi.Unboxed: tryReadChan :: UnagiPrim a => OutChan a -> IO (Element a, IO a)
Files
- CHANGELOG.markdown +5/−0
- core-example/Main.hs +0/−183
- src/Control/Concurrent/Chan/Unagi/Bounded/Internal.hs +24/−19
- src/Control/Concurrent/Chan/Unagi/Internal.hs +31/−26
- src/Control/Concurrent/Chan/Unagi/NoBlocking/Internal.hs +9/−7
- src/Control/Concurrent/Chan/Unagi/NoBlocking/Unboxed/Internal.hs +9/−7
- src/Control/Concurrent/Chan/Unagi/Unboxed/Internal.hs +38/−25
- src/Data/Atomics/Counter/Fat.hs +2/−2
- src/Utilities.hs +1/−0
- tests/Atomics.hs +6/−5
- tests/Deadlocks.hs +29/−0
- tests/DupChan.hs +25/−0
- tests/Implementations.hs +20/−6
- tests/Smoke.hs +34/−1
- tests/Unagi.hs +5/−5
- tests/UnagiBounded.hs +7/−5
- tests/UnagiNoBlocking.hs +5/−5
- tests/UnagiNoBlockingUnboxed.hs +5/−5
- tests/UnagiUnboxed.hs +5/−5
- unagi-chan.cabal +31/−31
CHANGELOG.markdown view
@@ -33,3 +33,8 @@ - re-bump atomic-primops version; should now support 7.10 - fix missing other-modules for test suite - fix getChanContents for GHC 7.10 (see GHC Trac #9965) ++### 0.4.0.0++- `tryReadChan` now returns an `(Element a, IO a)` tuple, where the `snd` is a blocking read action +- depend atomic-primops >= 0.8
− core-example/Main.hs
@@ -1,183 +0,0 @@-module Main (main) where--import Control.Monad-import System.Environment-import Control.Concurrent.MVar-import Control.Concurrent-import qualified Control.Concurrent.Chan.Unagi as U-import qualified Control.Concurrent.Chan.Unagi.Unboxed as UU-import qualified Control.Concurrent.Chan.Unagi.Bounded as UB-import qualified Control.Concurrent.Chan.Unagi.NoBlocking as UN-import qualified Control.Concurrent.Chan.Unagi.NoBlocking.Unboxed as UNU--import qualified Control.Concurrent.Chan as C-import qualified Control.Concurrent.STM.TQueue as S-import Control.Concurrent.STM--import Debug.Trace---- This is a copy of the "async 100 writers 100 readers" from chan-benchmarks- {--main = do - (nm:other) <- getArgs- let n = 1000000- (r,w) = case other of- [rS,wS] -> (read rS, read wS)- _ -> (100,100)- putStrLn $ "Running with "++show r++" readers, and "++ show w++" writers."- case nm of- "unagi" -> runU w r n- "chan" -> runC w r n- "stm" -> runS w r n--}--main = do- [n] <- getArgs- runU (read n)- -- runUU (read n)- -- runUB (read n)- -- runUN (read n)- -- runUNStream (read n)- -- runUNUStream (read n)-runU :: Int -> IO ()-runU n = do- (i,o) <- U.newChan- let n1000 = n `quot` 1000- replicateM_ 1000 $ do- replicateM_ n1000 $ U.writeChan i ()- replicateM_ n1000 $ U.readChan o-{--runUU :: Int -> IO ()-runUU n = do- (i,o) <- UU.newChan- let n1000 = n `quot` 1000- replicateM_ 1000 $ do- replicateM_ n1000 $ UU.writeChan i (0::Int)- replicateM_ n1000 $ UU.readChan o--runUB :: Int -> IO ()-runUB n = do- let n1000 = n `quot` 1000- (i,o) <- UB.newChan n1000- replicateM_ 1000 $ do- replicateM_ n1000 $ UB.writeChan i (0::Int)- replicateM_ n1000 $ UB.readChan o---tryReadChanErrUN :: UN.OutChan a -> IO a-{-# INLINE tryReadChanErrUN #-}-tryReadChanErrUN oc = UN.tryReadChan oc - >>= UN.tryRead - >>= maybe (error "A read we expected to succeed failed!") return--runUN n = do- (i,o) <- UN.newChan- let n1000 = n `quot` 1000- replicateM_ 1000 $ do- replicateM_ n1000 $ UN.writeChan i ()- replicateM_ n1000 $ tryReadChanErrUN o--runUNStream n = do- (i,o) <- UN.newChan- [ oStream ] <- UN.streamChan 1 o- let n1000 = n `quot` 1000- let eat str = do- x <- UN.tryReadNext str- case x of- UN.Pending -> return str- UN.Next _ str' -> eat str'- writeAndEat iter str = unless (iter <=0) $ do- replicateM_ n1000 $ UN.writeChan i ()- eat str >>= writeAndEat (iter-1)- - writeAndEat (1000::Int) oStream- -}-tryReadChanErrUNU :: UNU.UnagiPrim a=> UNU.OutChan a -> IO a-{-# INLINE tryReadChanErrUNU #-}-tryReadChanErrUNU oc = UNU.tryReadChan oc - >>= UNU.tryRead - >>= maybe (error "A read we expected to succeed failed!") return--runUNU n = do- (i,o) <- UNU.newChan- let n1000 = n `quot` 1000- replicateM_ 1000 $ do- replicateM_ n1000 $ UNU.writeChan i (0::Int)- replicateM_ n1000 $ tryReadChanErrUNU o--runUNUStream n = do- (i,o) <- UNU.newChan- [ oStream ] <- UNU.streamChan 1 o- let n1000 = n `quot` 1000- let eat str = do- x <- UNU.tryReadNext str- case x of- UNU.Pending -> return str- UNU.Next _ str' -> eat str'- writeAndEat iter str = unless (iter <=0) $ do- replicateM_ n1000 $ UNU.writeChan i (0::Int)- eat str >>= writeAndEat (iter-1)- - writeAndEat (1000::Int) oStream--{--runU :: Int -> Int -> Int -> IO ()-runU writers readers n = do- let nNice = n - rem n (lcm writers readers)- perReader = nNice `quot` readers- perWriter = (nNice `quot` writers)- vs <- replicateM readers newEmptyMVar- (i,o) <- U.newChan- let doRead = replicateM_ perReader $ theRead- theRead = U.readChan o- doWrite = replicateM_ perWriter $ theWrite- theWrite = U.writeChan i (1 :: Int)- mapM_ (\v-> forkIO (traceEventIO "READER START" >> doRead >> putMVar v ())) vs-- wWaits <- replicateM writers newEmptyMVar- mapM_ (\v-> forkIO $ (takeMVar v >> traceEventIO "WRITER START" >> doWrite)) wWaits- mapM_ (\v-> putMVar v ()) wWaits-- mapM_ takeMVar vs -- await readers---- --------------------------------------------------- FOR COMPARISON:--runS :: Int -> Int -> Int -> IO ()-runS writers readers n = do- let nNice = n - rem n (lcm writers readers)- perReader = nNice `quot` readers- perWriter = (nNice `quot` writers)- vs <- replicateM readers newEmptyMVar- tq <- S.newTQueueIO- let doRead = replicateM_ perReader $ theRead- theRead = (atomically . S.readTQueue) tq- doWrite = replicateM_ perWriter $ theWrite- theWrite = atomically $ S.writeTQueue tq (1 :: Int)- mapM_ (\v-> forkIO (traceEventIO "READER START" >> doRead >> putMVar v ())) vs-- wWaits <- replicateM writers newEmptyMVar- mapM_ (\v-> forkIO $ (takeMVar v >> traceEventIO "WRITER START" >> doWrite)) wWaits- mapM_ (\v-> putMVar v ()) wWaits-- mapM_ takeMVar vs -- await readers--runC :: Int -> Int -> Int -> IO ()-runC writers readers n = do- let nNice = n - rem n (lcm writers readers)- perReader = nNice `quot` readers- perWriter = (nNice `quot` writers)- vs <- replicateM readers newEmptyMVar- c <- C.newChan- let doRead = replicateM_ perReader $ theRead- theRead = C.readChan c- doWrite = replicateM_ perWriter $ theWrite- theWrite = C.writeChan c (1 :: Int)- mapM_ (\v-> forkIO (traceEventIO "READER START" >> doRead >> putMVar v ())) vs-- wWaits <- replicateM writers newEmptyMVar- mapM_ (\v-> forkIO $ (takeMVar v >> traceEventIO "WRITER START" >> doWrite)) wWaits- mapM_ (\v-> putMVar v ()) wWaits-- mapM_ takeMVar vs -- await readers--}
src/Control/Concurrent/Chan/Unagi/Bounded/Internal.hs view
@@ -30,6 +30,7 @@ import Utilities(nextHighestPowerOfTwo) import qualified Control.Concurrent.Chan.Unagi.NoBlocking.Types as UT +import Prelude -- | The write end of a channel created with 'newChan'. data InChan a = InChan (IO Int) -- readCounterReader, for tryWriteChan@@ -143,7 +144,7 @@ savedEmptyTkt <- readArrayElem firstSeg 0 stream <- Stream firstSeg <$> newIORef Nothing let end = ChanEnd logBounds boundsMn1 segSource - <$> newCounter (startingCellOffset - 1)+ <$> newCounter startingCellOffset <*> newIORef (StreamHead startingCellOffset stream) endR@(ChanEnd _ _ _ counterR _) <- end endW <- end@@ -245,11 +246,10 @@ else writeChanWithBlocking False c a >> return True -readChanOnExceptionUnmasked :: (IO a -> IO a) -> OutChan a -> IO a-{-# INLINE readChanOnExceptionUnmasked #-}-readChanOnExceptionUnmasked h = \oc-> do- (seg,segIx) <- startReadChan oc-+-- The core of our 'read' operations, with exception handler:+readSegIxUnmasked :: (IO a -> IO a) -> (StreamSegment a, Int) -> IO a+{-# INLINE readSegIxUnmasked #-}+readSegIxUnmasked h = \(seg,segIx)-> do cellTkt <- readArrayElem seg segIx case peekTicket cellTkt of Written a -> return a@@ -275,7 +275,7 @@ (segIx, nextSeg, updateStreamHeadIfNecessary) <- moveToNextCell asReader ce let (seg,next) = case nextSeg of NextByReader (Stream s n) -> (s,n)- _ -> error "moveToNextCell returned a non-reader-installed next segment to readChanOnExceptionUnmasked"+ _ -> error "moveToNextCell returned a non-reader-installed next segment to readSegIxUnmasked" -- try to pre-allocate next segment: when (segIx == 0) $ void $ waitingAdvanceStream asReader next segSource 0@@ -284,32 +284,35 @@ return (seg,segIx) --- TODO we might want also a blocking `IO a` returned here, or use an opaque--- Element type supporting blocking, since otherwise calling `tryReadChan` we--- give up the ability to block on that element. Please open an issue if you--- need this in the meantime. And also handling of lost elements on async--- exceptions. And also isActive... --- | Returns immediately with an @'UT.Element' a@ future, which returns one--- unique element when it becomes available via 'UT.tryRead'.+-- | Returns immediately with: --+-- - an @'UT.Element' a@ future, which returns one unique element when it+-- becomes available via 'UT.tryRead'.+--+-- - a blocking @IO@ action that returns the element when it becomes available.+-- -- /Note re. exceptions/: When an async exception is raised during a @tryReadChan@ -- the message that the read would have returned is likely to be lost, just as -- it would be when raised directly after this function returns.-tryReadChan :: OutChan a -> IO (UT.Element a)+tryReadChan :: OutChan a -> IO (UT.Element a, IO a) {-# INLINE tryReadChan #-} tryReadChan oc = do -- no mask necessary (seg,segIx) <- startReadChan oc - return $ UT.Element $ do+ return ( + UT.Element $ do cell <- P.readArray seg segIx case cell of Written a -> return $ Just a Empty -> return Nothing Blocking v -> tryReadMVar v + , readSegIxUnmasked id (seg,segIx)+ ) + -- | Read an element from the chan, blocking if the chan is empty. -- -- /Note re. exceptions/: When an async exception is raised during a @readChan@ @@ -318,7 +321,7 @@ -- this scenario, you can use 'readChanOnException'. readChan :: OutChan a -> IO a {-# INLINE readChan #-}-readChan = readChanOnExceptionUnmasked id+readChan = \oc-> startReadChan oc >>= readSegIxUnmasked id -- | Like 'readChan' but allows recovery of the queue element which would have -- been read, in the case that an async exception is raised during the read. To@@ -330,8 +333,10 @@ -- the passed @IO a@ is the only way to access the element. readChanOnException :: OutChan a -> (IO a -> IO ()) -> IO a {-# INLINE readChanOnException #-}-readChanOnException c h = mask_ $ - readChanOnExceptionUnmasked (\io-> io `onException` (h io)) c+readChanOnException oc h = mask_ (+ startReadChan oc >>= + readSegIxUnmasked (\io-> io `onException` (h io))+ ) -- increments counter, finds stream segment of corresponding cell (updating the
src/Control/Concurrent/Chan/Unagi/Internal.hs view
@@ -32,6 +32,7 @@ import qualified Control.Concurrent.Chan.Unagi.NoBlocking.Types as UT import Utilities(touchIORef) +import Prelude -- | The write end of a channel created with 'newChan'. data InChan a = InChan !(Ticket (Cell a)) !(ChanEnd (Cell a))@@ -115,7 +116,7 @@ savedEmptyTkt <- readArrayElem firstSeg 0 stream <- Stream firstSeg <$> newIORef NoSegment let end = ChanEnd segSource - <$> newCounter (startingCellOffset - 1)+ <$> newCounter startingCellOffset <*> newIORef (StreamHead startingCellOffset stream) liftA2 (,) (InChan savedEmptyTkt <$> end) (OutChan <$> end) @@ -177,10 +178,10 @@ -- from whether cakes are given to well-behaved customers in the order they -- came out of the oven, or whether a customer leaving at the wrong moment -- might cause the cake shop to burn down...-readChanOnExceptionUnmasked :: (IO a -> IO a) -> OutChan a -> IO a-{-# INLINE readChanOnExceptionUnmasked #-}-readChanOnExceptionUnmasked h = \(OutChan ce)-> do- (segIx, (Stream seg _), maybeUpdateStreamHead) <- moveToNextCell ce+readSegIxUnmasked :: (IO a -> IO a) -> (Int, Stream (Cell a), IO ()) -> IO a+{-# INLINE readSegIxUnmasked #-}+readSegIxUnmasked h =+ \(segIx, (Stream seg _), maybeUpdateStreamHead)-> do maybeUpdateStreamHead cellTkt <- readArrayElem seg segIx case peekTicket cellTkt of@@ -201,33 +202,36 @@ where readBlocking v = inline h $ readMVar v --- TODO we might want also a blocking `IO a` returned here, or use an opaque--- Element type supporting blocking, since otherwise calling `tryReadChan` we--- give up the ability to block on that element. Please open an issue if you--- need this in the meantime. And also handling of lost elements on async--- exceptions. And also isActive...---- | Returns immediately with an @'UT.Element' a@ future, which returns one--- unique element when it becomes available via 'UT.tryRead'. If you're using--- this function exclusively you might find the implementation in --- "Control.Concurrent.Chan.Unagi.NoBlocking" is faster.+-- | Returns immediately with: --+-- - an @'UT.Element' a@ future, which returns one unique element when it+-- becomes available via 'UT.tryRead'.+--+-- - a blocking @IO@ action that returns the element when it becomes available.+--+-- If you're using this function exclusively you might find the implementation+-- in "Control.Concurrent.Chan.Unagi.NoBlocking" is faster.+-- -- /Note re. exceptions/: When an async exception is raised during a @tryReadChan@ -- the message that the read would have returned is likely to be lost, just as -- it would be when raised directly after this function returns.-tryReadChan :: OutChan a -> IO (UT.Element a)+tryReadChan :: OutChan a -> IO (UT.Element a, IO a) {-# INLINE tryReadChan #-} tryReadChan (OutChan ce) = do -- no masking needed- (segIx, (Stream seg _), maybeUpdateStreamHead) <- moveToNextCell ce+ segStuff@(segIx, (Stream seg _), maybeUpdateStreamHead) <- moveToNextCell ce maybeUpdateStreamHead- return $ UT.Element $ do- cell <- P.readArray seg segIx- case cell of- Written a -> return $ Just a- Empty -> return Nothing- Blocking v -> tryReadMVar v+ return ( + UT.Element $ do+ cell <- P.readArray seg segIx+ case cell of+ Written a -> return $ Just a+ Empty -> return Nothing+ Blocking v -> tryReadMVar v + , readSegIxUnmasked id segStuff + ) + -- | Read an element from the chan, blocking if the chan is empty. -- -- /Note re. exceptions/: When an async exception is raised during a @readChan@ @@ -236,7 +240,7 @@ -- this scenario, you can use 'readChanOnException'. readChan :: OutChan a -> IO a {-# INLINE readChan #-}-readChan = readChanOnExceptionUnmasked id+readChan = \(OutChan ce)-> moveToNextCell ce >>= readSegIxUnmasked id -- | Like 'readChan' but allows recovery of the queue element which would have -- been read, in the case that an async exception is raised during the read. To@@ -248,8 +252,9 @@ -- the passed @IO a@ is the only way to access the element. readChanOnException :: OutChan a -> (IO a -> IO ()) -> IO a {-# INLINE readChanOnException #-}-readChanOnException c h = mask_ $ - readChanOnExceptionUnmasked (\io-> io `onException` (h io)) c+readChanOnException (OutChan ce) h = mask_ ( + moveToNextCell ce >>= + readSegIxUnmasked (\io-> io `onException` (h io)) ) ------------ NOTE: ALL CODE BELOW IS RE-USED IN Unagi.NoBlocking --------------
src/Control/Concurrent/Chan/Unagi/NoBlocking/Internal.hs view
@@ -40,7 +40,9 @@ import Control.Concurrent.Chan.Unagi.Constants import qualified Control.Concurrent.Chan.Unagi.NoBlocking.Types as UT +import Prelude + -- | The write end of a channel created with 'newChan'. data InChan a = InChan !(IORef Bool) -- Used for creating an OutChan in dupChan !(ChanEnd (Cell a))@@ -69,7 +71,7 @@ stream <- Stream <$> segSource <*> newIORef NoSegment let end = ChanEnd segSource - <$> newCounter (startingCellOffset - 1)+ <$> newCounter startingCellOffset <*> newIORef (StreamHead startingCellOffset stream) inEnd@(ChanEnd _ _ inHeadRef) <- end finalizee <- newIORef True@@ -202,13 +204,13 @@ -- forkIO $ printStream str3 -- prints: 3,6,9 -- where -- printStream str = do--- h <- 'tryReadNext' str+-- h <- 'UT.tryReadNext' str -- case h of--- 'Next' a str' -> print a >> printStream str'+-- 'UT.Next' a str' -> print a >> printStream str' -- -- We know that all values were already written, so a Pending tells -- -- us we can exit; in other cases we might call 'yield' and then --- -- retry that same @'tryReadNext' str@:--- 'Pending' -> return ()+-- -- retry that same @'UT.tryReadNext' str@:+-- 'UT.Pending' -> return () -- @ -- -- Be aware: if one stream consumer falls behind another (e.g. because it is@@ -223,8 +225,8 @@ (StreamHead offsetInitial strInitial) <- readIORef streamHead -- Make sure the read above occurs before our readCounter: loadLoadBarrier- -- Linearizable as the first unread element; N.B. (+1):- !ix0 <- (+1) <$> readCounter counter+ -- Linearizable as the first unread element+ !ix0 <- readCounter counter -- Adapted from moveToNextCell, given a stream segment location `str0` and -- its offset, `offset0`, this navigates to the UT.Stream segment holding `ix`
src/Control/Concurrent/Chan/Unagi/NoBlocking/Unboxed/Internal.hs view
@@ -37,6 +37,8 @@ import Control.Concurrent.Chan.Unagi.Constants +import Prelude+ -- We can re-use much of the Unagi.Unboxed implementation here, and some of -- Unagi.NoBlocking (at least our types, which is important): import Control.Concurrent.Chan.Unagi.Unboxed.Internal(@@ -74,7 +76,7 @@ <*> undefinedNewIndexedMVar <*> newIORef NoSegment let end = ChanEnd- <$> newCounter (startingCellOffset - 1)+ <$> newCounter startingCellOffset <*> newIORef (StreamHead startingCellOffset stream) inEnd@(ChanEnd _ inHeadRef) <- end finalizee <- newIORef True@@ -248,13 +250,13 @@ -- forkIO $ printStream str3 -- prints: 3,6,9 -- where -- printStream str = do--- h <- 'tryReadNext' str+-- h <- 'UT.tryReadNext' str -- case h of--- 'Next' a str' -> print a >> printStream str'+-- 'UT.Next' a str' -> print a >> printStream str' -- -- We know that all values were already written, so a Pending tells -- -- us we can exit; in other cases we might call 'yield' and then --- -- retry that same @'tryReadNext' str@:--- 'Pending' -> return ()+-- -- retry that same @'UT.tryReadNext' str@:+-- 'UT.Pending' -> return () -- @ -- -- Be aware: if one stream consumer falls behind another (e.g. because it is@@ -269,8 +271,8 @@ (StreamHead offsetInitial strInitial) <- readIORef streamHead -- Make sure the read above occurs before our readCounter: loadLoadBarrier- -- Linearizable as the first unread element; N.B. (+1):- !ix0 <- (+1) <$> readCounter counter+ -- Linearizable as the first unread element+ !ix0 <- readCounter counter -- Adapted from moveToNextCell, given a stream segment location `str0` and -- its offset, `offset0`, this navigates to the UT.Stream segment holding `ix`
src/Control/Concurrent/Chan/Unagi/Unboxed/Internal.hs view
@@ -78,6 +78,8 @@ import Control.Concurrent.Chan.Unagi.Constants import qualified Control.Concurrent.Chan.Unagi.NoBlocking.Types as UT +import Prelude+ -- | The write end of a channel created with 'newChan'. newtype InChan a = InChan (ChanEnd a) deriving Typeable@@ -245,7 +247,7 @@ (sigArr0,eArr0) <- segSource stream <- Stream sigArr0 eArr0 <$> newIndexedMVar <*> newIORef NoSegment let end = ChanEnd- <$> newCounter (startingCellOffset - 1)+ <$> newCounter startingCellOffset <*> newIORef (StreamHead startingCellOffset stream) liftA2 (,) (InChan <$> end) (OutChan <$> end) @@ -285,13 +287,14 @@ -- [1] casByteArrayInt provides the write barrier we need here to make sure -- GHC maintains our ordering such that the element is written before we -- signal its availability with the CAS to sigArr that follows. See [2] in- -- readChanOnExceptionUnmasked.+ -- readSegIxUnmasked. -readChanOnExceptionUnmasked :: UnagiPrim a=> (IO a -> IO a) -> OutChan a -> IO a-{-# INLINE readChanOnExceptionUnmasked #-}-readChanOnExceptionUnmasked h = \(OutChan ce)-> do- (segIx, (Stream sigArr eArr mvarIndexed _), maybeUpdateStreamHead) <- moveToNextCell ce+-- Core of blocking read functions, taking handler and output of moveToNextCell+readSegIxUnmasked :: UnagiPrim a=> (IO a -> IO a) -> (Int, Stream a, IO ()) -> IO a+{-# INLINE readSegIxUnmasked #-}+readSegIxUnmasked h =+ \(segIx, (Stream sigArr eArr mvarIndexed _), maybeUpdateStreamHead)-> do maybeUpdateStreamHead let readBlocking = inline h $ readMVarIx mvarIndexed segIx -- NOTE [1] readElem = readElementArray eArr segIx@@ -305,7 +308,7 @@ 1 {- Written -} -> readElem -- else in the meantime a dupChan reader read, blocking 2 {- Blocking -} -> readBlocking- _ -> error "Invalid signal seen in readChanOnExceptionUnmasked!"+ _ -> error "Invalid signal seen in readSegIxUnmasked!" -- If we know writes of this element are atomic, we can determine if the -- element has been written, and possibly return it without consulting -- sigArr.@@ -332,19 +335,24 @@ -- need this in the meantime. And also handling of lost elements on async -- exceptions. And also isActive... --- | Returns immediately with an @'UT.Element' a@ future, which returns one--- unique element when it becomes available via 'UT.tryRead'. If you're using--- this function exclusively you might find the implementation in --- "Control.Concurrent.Chan.Unagi.NoBlocking.Unboxed" is faster.+-- | Returns immediately with: --+-- - an @'UT.Element' a@ future, which returns one unique element when it+-- becomes available via 'UT.tryRead'.+--+-- - a blocking @IO@ action that returns the element when it becomes available.+--+-- If you're using this function exclusively you might find the implementation+-- in "Control.Concurrent.Chan.Unagi.NoBlocking.Unboxed" is faster.+-- -- /Note re. exceptions/: When an async exception is raised during a @tryReadChan@ -- the message that the read would have returned is likely to be lost, just as -- it would be when raised directly after this function returns.-tryReadChan :: UnagiPrim a=> OutChan a -> IO (UT.Element a)+tryReadChan :: UnagiPrim a=> OutChan a -> IO (UT.Element a, IO a) {-# INLINE tryReadChan #-} tryReadChan (OutChan ce) = do -- no masking needed--- NOTE: implementation adapted from readChanOnExceptionUnmasked:- (segIx, (Stream sigArr eArr mvarIndexed _), maybeUpdateStreamHead) <- moveToNextCell ce+-- NOTE: implementation adapted from readSegIxUnmasked:+ segStuff@(segIx, (Stream sigArr eArr mvarIndexed _), maybeUpdateStreamHead) <- moveToNextCell ce maybeUpdateStreamHead let readElem = readElementArray eArr segIx slowRead = do @@ -354,16 +362,20 @@ 1 {- Written -} -> loadLoadBarrier >> Just <$> readElem 2 {- Blocking -} -> tryReadMVarIx mvarIndexed segIx _ -> error "Invalid signal seen in tryReadChan!"- return $ UT.Element $- case atomicUnicorn of- Just magic -> do- el <- readElem- if (el /= magic) - then return $ Just el- else slowRead- Nothing -> slowRead+ return ( + UT.Element $+ case atomicUnicorn of+ Just magic -> do+ el <- readElem+ if (el /= magic) + then return $ Just el+ else slowRead+ Nothing -> slowRead + , readSegIxUnmasked id segStuff+ ) + -- | Read an element from the chan, blocking if the chan is empty. -- -- /Note re. exceptions/: When an async exception is raised during a @readChan@ @@ -372,7 +384,7 @@ -- this scenario, you can use 'readChanOnException'. readChan :: UnagiPrim a=> OutChan a -> IO a {-# INLINE readChan #-}-readChan = readChanOnExceptionUnmasked id+readChan = \(OutChan ce)-> moveToNextCell ce >>= readSegIxUnmasked id -- | Like 'readChan' but allows recovery of the queue element which would have -- been read, in the case that an async exception is raised during the read. To@@ -384,8 +396,9 @@ -- the passed @IO a@ is the only way to access the element. readChanOnException :: UnagiPrim a=> OutChan a -> (IO a -> IO ()) -> IO a {-# INLINE readChanOnException #-}-readChanOnException c h = mask_ $ - readChanOnExceptionUnmasked (\io-> io `onException` (h io)) c+readChanOnException (OutChan ce) h = mask_ $ + moveToNextCell ce >>=+ readSegIxUnmasked (\io-> io `onException` (h io))
src/Data/Atomics/Counter/Fat.hs view
@@ -11,7 +11,7 @@ import Data.Primitive.MachDeps(sIZEOF_INT) import Control.Monad.Primitive(RealWorld) import Data.Primitive.ByteArray-import Data.Atomics(fetchAddByteArrayInt)+import Data.Atomics(fetchAddIntArray) import Control.Exception(assert) newtype AtomicCounter = AtomicCounter (MutableByteArray RealWorld)@@ -34,7 +34,7 @@ incrCounter :: Int -> AtomicCounter -> IO Int {-# INLINE incrCounter #-} incrCounter incr (AtomicCounter arr) =- fetchAddByteArrayInt arr 0 incr+ fetchAddIntArray arr 0 incr readCounter :: AtomicCounter -> IO Int {-# INLINE readCounter #-}
src/Utilities.hs view
@@ -20,6 +20,7 @@ import GHC.IORef(IORef(..)) import GHC.STRef(STRef(..)) import GHC.Base(IO(..))+import Prelude -- For now: a reverse-ordered assoc list; an IntMap might be better newtype IndexedMVar a = IndexedMVar (IORef [(Int, MVar a)])
tests/Atomics.hs view
@@ -37,7 +37,7 @@ unless (n == 1337) $ error "newCounter magnificently broken" n2 <- incrCounter 1 cntr n2' <- readCounter cntr- unless (n2 == 1338 && n2' == 1338) $ error "incrCounter magnificently broken"+ unless (n2 == 1337 && n2' == 1338) $ error "incrCounter magnificently broken" cHUNK_SIZE, maxInt, minInt :: Int cHUNK_SIZE = 32 -- MUST REMAIN POWER OF TWO for now@@ -56,7 +56,7 @@ in if xmy == x `mod` y then xmy else error "Our bitwise mod isn't working the way we expect in testCounterOverflow"- cntr <- newCounter (maxInt - (cHUNK_SIZE `div` 2)) + cntr <- newCounter (maxInt - (cHUNK_SIZE `div` 2) + 1) spanningCntr <- replicateM cHUNK_SIZE (incrCounter 1 cntr) -- make sure our test is working if all (>0) spanningCntr || all (<0) spanningCntr@@ -79,12 +79,13 @@ -- (We don't use this property) cntr2 <- newCounter maxInt- mbnd <- incrCounter 1 cntr2- unless (mbnd == minInt) $ + _ <- incrCounter 1 cntr2+ mnbnd <- readCounter cntr2+ unless (mnbnd == minInt) $ error $ "Incrementing counter at maxbound didn't yield minBound" -- (3) test subtraction across boundary: count - newFirstIndex, for window spanning boundary.- cntr3 <- newCounter (maxInt - 1)+ cntr3 <- newCounter maxInt let ls = take 30 $ iterate (+1) $ maxInt - 10 cs <- mapM (\x-> fmap (subtract x) $ incrCounter 1 cntr3) ls unless (cs == replicate 30 10) $
tests/Deadlocks.hs view
@@ -33,6 +33,18 @@ -- No real need to checkDeadlocksWriter for tryReadChan. putStrLn "==================="+ putStrLn "Testing Unagi (with tryReadChan, blocking):"+ -- ------+ putStr $ " Checking for deadlocks from killed reader, x"++show tries++"... "+ checkDeadlocksReader unagiTryReadBlockingImpl tries+ putStrLn "OK"+ -- ------+ putStr $ " Checking for deadlocks from killed writer, x"++show tries++"... "+ checkDeadlocksWriter unagiTryReadBlockingImpl tries+ putStrLn "OK"+++ putStrLn "===================" putStrLn "Testing Unagi.NoBlocking:" -- ------ putStr $ " Checking for deadlocks from killed reader, x"++show tries++"... "@@ -60,6 +72,17 @@ putStr $ " Checking for deadlocks from killed reader, x"++show tries++"... " checkDeadlocksReader unboxedUnagiTryReadImpl tries putStrLn "OK"+ + putStrLn "==================="+ putStrLn "Testing Unagi.NoBlocking.Unboxed (with tryReadChan, blocking):"+ -- ------+ putStr $ " Checking for deadlocks from killed reader, x"++show tries++"... "+ checkDeadlocksReader unboxedUnagiTryReadBlockingImpl tries+ putStrLn "OK"+ -- ------+ putStr $ " Checking for deadlocks from killed writer, x"++show tries++"... "+ checkDeadlocksWriter unboxedUnagiTryReadBlockingImpl tries+ putStrLn "OK" putStrLn "===================" putStrLn "Testing Unagi.Unboxed:"@@ -85,10 +108,16 @@ checkDeadlocksReader (unagiBoundedTryReadImpl 50000) tries putStrLn "OK" -- ------+ putStr $ " Checking for deadlocks from killed reader (tryReadChan, blocking), x"++show tries++"... "+ -- bounds must be > 10000 here (note actual bounds rounded up to power of 2):+ checkDeadlocksReader (unagiBoundedTryReadBlockingImpl 50000) tries+ putStrLn "OK"+ -- ------ putStr $ " Checking for deadlocks from killed writer, x"++show tries++"... " -- fragile bounds must be large enought to never be reached here: checkDeadlocksWriterBounded tries putStrLn "OK"+ -- TODO same test for unagiBoundedTryReadBlockingImpl -- -- Chan002.hs -- --
tests/DupChan.hs view
@@ -33,7 +33,19 @@ putStr " Writer/dupChan+Reader... " replicateM_ 1000 $ dupChanTest2 unagiTryReadImpl 10000 putStrLn "OK"+ + putStrLn "==================="+ putStrLn "Test dupChan Unagi (with tryReadChan, blocking):"+ -- ------+ putStr " Reader/Reader... "+ replicateM_ 1000 $ dupChanTest1 unagiTryReadBlockingImpl 50000+ putStrLn "OK"+ -- ------+ putStr " Writer/dupChan+Reader... "+ replicateM_ 1000 $ dupChanTest2 unagiTryReadBlockingImpl 10000+ putStrLn "OK" + putStrLn "===================" putStrLn "Test dupChan Unagi.NoBlocking:" -- ------@@ -79,6 +91,17 @@ putStrLn "OK" putStrLn "==================="+ putStrLn "Test dupChan Unagi.Unboxed (with tryReadChan, blocking):"+ -- ------+ putStr " Reader/Reader... "+ replicateM_ 1000 $ dupChanTest1 unboxedUnagiTryReadBlockingImpl 50000+ putStrLn "OK"+ -- ------+ putStr " Writer/dupChan+Reader... "+ replicateM_ 1000 $ dupChanTest2 unboxedUnagiTryReadBlockingImpl 10000+ putStrLn "OK"++ putStrLn "===================" putStrLn "Test dupChan Unagi.Bounded (and with tryRead)" -- NOTE: n must be <= bounds in dupChanTest1: forM_ [(4096,4096),(65536,50000),(4,2)] $ \(bounds, n)-> do@@ -86,11 +109,13 @@ putStr $ " Reader/Reader with bounds "++(show bounds)++"... " replicateM_ 100 $ dupChanTest1 (unagiBoundedImpl bounds) n replicateM_ 100 $ dupChanTest1 (unagiBoundedTryReadImpl bounds) n+ replicateM_ 100 $ dupChanTest1 (unagiBoundedTryReadBlockingImpl bounds) n putStrLn "OK" forM_ [2, 1024, 65536] $ \bounds-> do putStr $ " Writer/dupChan+Reader with bounds "++(show bounds)++"... " replicateM_ 100 $ dupChanTest2 (unagiBoundedImpl bounds) 10000 replicateM_ 100 $ dupChanTest2 (unagiBoundedTryReadImpl bounds) 10000+ replicateM_ 100 $ dupChanTest2 (unagiBoundedTryReadBlockingImpl bounds) 10000 putStrLn "OK" -- Check output where dupChan at known point in input stream, with two
tests/Implementations.hs view
@@ -9,17 +9,20 @@ type Implementation inc outc a = (IO (inc a, outc a), inc a -> a -> IO (), outc a -> IO a, inc a -> IO (outc a)) -unagiImpl , unagiTryReadImpl :: Implementation U.InChan U.OutChan a+unagiImpl , unagiTryReadImpl , unagiTryReadBlockingImpl :: Implementation U.InChan U.OutChan a unagiImpl = (U.newChan, U.writeChan, U.readChan, U.dupChan) unagiTryReadImpl = (U.newChan, U.writeChan, u_trying_readChan, U.dupChan)+unagiTryReadBlockingImpl = (U.newChan, U.writeChan, u_trying_readChan_blocking, U.dupChan) -unboxedUnagiImpl , unboxedUnagiTryReadImpl:: (UU.UnagiPrim a)=> Implementation UU.InChan UU.OutChan a+unboxedUnagiImpl , unboxedUnagiTryReadImpl, unboxedUnagiTryReadBlockingImpl :: (UU.UnagiPrim a)=> Implementation UU.InChan UU.OutChan a unboxedUnagiImpl = (UU.newChan, UU.writeChan, UU.readChan, UU.dupChan) unboxedUnagiTryReadImpl = (UU.newChan, UU.writeChan, uu_trying_readChan, UU.dupChan)+unboxedUnagiTryReadBlockingImpl = (UU.newChan, UU.writeChan, uu_trying_readChan_blocking, UU.dupChan) -unagiBoundedImpl , unagiBoundedTryReadImpl:: Int -> Implementation UB.InChan UB.OutChan a+unagiBoundedImpl , unagiBoundedTryReadImpl, unagiBoundedTryReadBlockingImpl :: Int -> Implementation UB.InChan UB.OutChan a unagiBoundedImpl n = (UB.newChan n, UB.writeChan, UB.readChan, UB.dupChan) unagiBoundedTryReadImpl n = (UB.newChan n, UB.writeChan, ub_trying_readChan, UB.dupChan)+unagiBoundedTryReadBlockingImpl n = (UB.newChan n, UB.writeChan, ub_trying_readChan_blocking, UB.dupChan) -- We use our yield "blocking" readChan here, and below: unagiNoBlockingImpl :: Implementation UN.InChan UN.OutChan a@@ -32,18 +35,29 @@ -- way to do smoke tests of `tryReadChan`: uu_trying_readChan :: (UU.UnagiPrim a)=> UU.OutChan a -> IO a uu_trying_readChan oc = do- e <- UU.tryReadChan oc+ (e,_) <- UU.tryReadChan oc let go = UU.tryRead e >>= maybe (threadDelay 1000 >> go) return go u_trying_readChan :: U.OutChan a -> IO a u_trying_readChan oc = do- e <- U.tryReadChan oc+ (e,_) <- U.tryReadChan oc let go = U.tryRead e >>= maybe (threadDelay 1000 >> go) return go ub_trying_readChan :: UB.OutChan a -> IO a ub_trying_readChan oc = do- e <- UB.tryReadChan oc+ (e,_) <- UB.tryReadChan oc let go = UB.tryRead e >>= maybe (threadDelay 1000 >> go) return go++-- And we want to test the blocking action of tryReadChan as well:+uu_trying_readChan_blocking :: (UU.UnagiPrim a)=> UU.OutChan a -> IO a+uu_trying_readChan_blocking oc = UU.tryReadChan oc >>= snd++u_trying_readChan_blocking :: U.OutChan a -> IO a+u_trying_readChan_blocking oc = U.tryReadChan oc >>= snd++ub_trying_readChan_blocking :: UB.OutChan a -> IO a+ub_trying_readChan_blocking oc = UB.tryReadChan oc >>= snd+
tests/Smoke.hs view
@@ -45,7 +45,15 @@ putStrLn "OK" -- ------ testContention unagiTryReadImpl 2 2 1000000-+ + putStrLn "==================="+ putStrLn "Testing Unagi (with tryReadChan, blocking):"+ -- ------+ putStr " FIFO smoke test... "+ fifoSmoke unagiTryReadBlockingImpl 1000000+ putStrLn "OK"+ -- ------+ testContention unagiTryReadBlockingImpl 2 2 1000000 putStrLn "===================" putStrLn "Testing Unagi.NoBlocking:"@@ -99,6 +107,31 @@ testContention (unagiBoundedImpl bounds) 2 2 1000000 -- because this is slow: when (bounds > 100) $ testContention (unagiBoundedTryReadImpl bounds) 2 2 1000000++ putStrLn "==================="+ putStrLn "Testing Unagi.Unboxed (with tryReadChan, blocking):"+ -- ------+ putStr " FIFO smoke test... "+ fifoSmoke unboxedUnagiTryReadBlockingImpl 1000000+ putStrLn "OK"+ -- ------+ testContention unboxedUnagiTryReadBlockingImpl 2 2 1000000+++ forM_ [1, 2, 4, 1024] $ \bounds-> do+ putStrLn "==================="+ putStrLn $ "Testing Unagi.Bounded (and with tryReadChan) with bounds "++(show bounds)+ -- ------+ putStr " FIFO smoke test... "+ fifoSmoke (unagiBoundedImpl bounds) 1000000+ -- because this is slow:+ when (bounds > 100) $ fifoSmoke (unagiBoundedTryReadBlockingImpl bounds) 1000000+ putStrLn "OK"+ -- ------+ testContention (unagiBoundedImpl bounds) 2 2 1000000+ -- because this is slow:+ when (bounds > 100) $ testContention (unagiBoundedTryReadBlockingImpl bounds) 2 2 1000000+ ) `onException` (threadDelay 1000000) -- wait for forkCatching logging
tests/Unagi.hs view
@@ -163,7 +163,7 @@ oCnt <- readCounter $ (\(UI.OutChan(UI.ChanEnd _ cntr _))-> cntr) o iCnt <- readCounter $ (\(UI.InChan _ (UI.ChanEnd _ cntr _))-> cntr) i- unless (iCnt == numPreloaded + 1) $ + unless (iCnt == numPreloaded + 2) $ error "The InChan counter doesn't match what we'd expect from numPreloaded!" case finalRead of@@ -176,17 +176,17 @@ -- -- Rare. Reader was killed after reading all pre-loaded messages -- but before starting what would be the blocking read:- 1 | oCnt == numPreloaded -> putStr "X" >> run n normalRetries (numRace + 1)+ 1 | oCnt == (numPreloaded+1) -> putStr "X" >> run n normalRetries (numRace + 1) | otherwise -> error $ "Having read final 1, "++- "Expecting a counter value of "++(show numPreloaded)+++ "Expecting a counter value of "++(show $ numPreloaded+1)++ " but got: "++(show oCnt) 2 -> do when usingReadChanOnException $ do shouldBe1 <- join $ takeMVar saved unless (shouldBe1 == 1) $ error "The handler for our readChanOnException should only have returned 1"- unless (oCnt == numPreloaded + 1) $+ unless (oCnt == numPreloaded + 2) $ error $ "Having read final 2, "++- "Expecting a counter value of "++(show $ numPreloaded+1)+++ "Expecting a counter value of "++(show $ numPreloaded+2)++ " but got: "++(show oCnt) putStr "+" >> run n (normalRetries + 1) numRace
tests/UnagiBounded.hs view
@@ -14,6 +14,8 @@ import Data.Maybe(isNothing) +import Prelude+ unagiBoundedMain :: IO () unagiBoundedMain = do putStrLn "==================="@@ -156,7 +158,7 @@ oCnt <- readCounter $ (\(UI.OutChan(UI.ChanEnd _ _ _ cntr _))-> cntr) o iCnt <- readCounter $ (\(UI.InChan _ _ (UI.ChanEnd _ _ _ cntr _))-> cntr) i- unless (iCnt == numPreloaded + 1) $ + unless (iCnt == numPreloaded + 2) $ error "The InChan counter doesn't match what we'd expect from numPreloaded!" case finalRead of@@ -169,17 +171,17 @@ -- -- Rare. Reader was killed after reading all pre-loaded messages -- but before starting what would be the blocking read:- 1 | oCnt == numPreloaded -> putStr "X" >> run n normalRetries (numRace + 1)+ 1 | oCnt == numPreloaded+1 -> putStr "X" >> run n normalRetries (numRace + 1) | otherwise -> error $ "Having read final 1, "++- "Expecting a counter value of "++(show numPreloaded)+++ "Expecting a counter value of "++(show $ numPreloaded+1)++ " but got: "++(show oCnt) 2 -> do when usingReadChanOnException $ do shouldBe1 <- join $ takeMVar saved unless (shouldBe1 == 1) $ error "The handler for our readChanOnException should only have returned 1"- unless (oCnt == numPreloaded + 1) $+ unless (oCnt == numPreloaded + 2) $ error $ "Having read final 2, "++- "Expecting a counter value of "++(show $ numPreloaded+1)+++ "Expecting a counter value of "++(show $ numPreloaded+2)++ " but got: "++(show oCnt) putStr "+" >> run n (normalRetries + 1) numRace
tests/UnagiNoBlocking.hs view
@@ -177,7 +177,7 @@ oCnt <- readCounter $ (\(UI.OutChan _ (UI.ChanEnd _ cntr _))-> cntr) o iCnt <- readCounter $ (\(UI.InChan _ (UI.ChanEnd _ cntr _))-> cntr) i- unless (iCnt == numPreloaded + 1) $ + unless (iCnt == numPreloaded + 2) $ error "The InChan counter doesn't match what we'd expect from numPreloaded!" case finalRead of@@ -190,13 +190,13 @@ -- -- Rare. Reader was killed after reading all pre-loaded messages -- but before starting what would be the blocking read:- 1 | oCnt == numPreloaded -> putStr "X" >> run n normalRetries (numRace + 1)+ 1 | oCnt == numPreloaded+1 -> putStr "X" >> run n normalRetries (numRace + 1) | otherwise -> error $ "Having read final 1, "++- "Expecting a counter value of "++(show numPreloaded)+++ "Expecting a counter value of "++(show $ numPreloaded+1)++ " but got: "++(show oCnt)- 2 -> do unless (oCnt == numPreloaded + 1) $+ 2 -> do unless (oCnt == numPreloaded + 2) $ error $ "Having read final 2, "++- "Expecting a counter value of "++(show $ numPreloaded+1)+++ "Expecting a counter value of "++(show $ numPreloaded+2)++ " but got: "++(show oCnt) putStr "+" >> run n (normalRetries + 1) numRace
tests/UnagiNoBlockingUnboxed.hs view
@@ -180,7 +180,7 @@ oCnt <- readCounter $ (\(UI.OutChan _ (UI.ChanEnd cntr _))-> cntr) o iCnt <- readCounter $ (\(UI.InChan _ (UI.ChanEnd cntr _))-> cntr) i- unless (iCnt == numPreloaded + 1) $ + unless (iCnt == numPreloaded + 2) $ error "The InChan counter doesn't match what we'd expect from numPreloaded!" case finalRead of@@ -193,13 +193,13 @@ -- -- Rare. Reader was killed after reading all pre-loaded messages -- but before starting what would be the blocking read:- 1 | oCnt == numPreloaded -> putStr "X" >> run n normalRetries (numRace + 1)+ 1 | oCnt == numPreloaded+1 -> putStr "X" >> run n normalRetries (numRace + 1) | otherwise -> error $ "Having read final 1, "++- "Expecting a counter value of "++(show numPreloaded)+++ "Expecting a counter value of "++(show $ numPreloaded+1)++ " but got: "++(show oCnt)- 2 -> do unless (oCnt == numPreloaded + 1) $+ 2 -> do unless (oCnt == numPreloaded + 2) $ error $ "Having read final 2, "++- "Expecting a counter value of "++(show $ numPreloaded+1)+++ "Expecting a counter value of "++(show $ numPreloaded+2)++ " but got: "++(show oCnt) putStr "+" >> run n (normalRetries + 1) numRace
tests/UnagiUnboxed.hs view
@@ -273,7 +273,7 @@ oCnt <- readCounter $ (\(UI.OutChan(UI.ChanEnd cntr _))-> cntr) o iCnt <- readCounter $ (\(UI.InChan (UI.ChanEnd cntr _))-> cntr) i- unless (iCnt == numPreloaded + 1) $ + unless (iCnt == numPreloaded + 2) $ error "The InChan counter doesn't match what we'd expect from numPreloaded!" case finalRead of@@ -286,17 +286,17 @@ -- -- Rare. Reader was killed after reading all pre-loaded messages -- but before starting what would be the blocking read:- 1 | oCnt == numPreloaded -> putStr "X" >> run n normalRetries (numRace + 1)+ 1 | oCnt == numPreloaded+1 -> putStr "X" >> run n normalRetries (numRace + 1) | otherwise -> error $ "Having read final 1, "++- "Expecting a counter value of "++(show numPreloaded)+++ "Expecting a counter value of "++(show $ numPreloaded+1)++ " but got: "++(show oCnt) 2 -> do when usingReadChanOnException $ do shouldBe1 <- join $ takeMVar saved unless (shouldBe1 == 1) $ error "The handler for our readChanOnException should only have returned 1"- unless (oCnt == numPreloaded + 1) $+ unless (oCnt == numPreloaded + 2) $ error $ "Having read final 2, "++- "Expecting a counter value of "++(show $ numPreloaded+1)+++ "Expecting a counter value of "++(show $ numPreloaded+2)++ " but got: "++(show oCnt) putStr "+" >> run n (normalRetries + 1) numRace
unagi-chan.cabal view
@@ -1,5 +1,5 @@ name: unagi-chan-version: 0.3.0.2+version: 0.4.0.0 synopsis: Fast concurrent queues with a Chan-like API, and more @@ -80,7 +80,7 @@ ghc-options: -Wall -funbox-strict-fields build-depends: base < 5- , atomic-primops >= 0.6.0.5 && <= 0.7+ , atomic-primops >= 0.8 , primitive>=0.5.3 , ghc-prim default-language: Haskell2010@@ -146,7 +146,7 @@ , UnagiNoBlockingUnboxed build-depends: base , primitive>=0.5.3- , atomic-primops >= 0.6.0.5 && <= 0.7+ , atomic-primops >= 0.8 , containers , ghc-prim default-language: Haskell2010@@ -204,33 +204,33 @@ build-depends: async -flag dev- default: False- manual: True+-- flag dev+-- default: False+-- manual: True -- for profiling, checking out core, etc-executable dev-example- -- for n in `find dist/build/dev-example/dev-example-tmp -name '*dump-simpl'`; do cp $n "core-example/$(basename $n).$(git rev-parse --abbrev-ref HEAD)"; done- if !flag(dev)- buildable: False- else- build-depends: - base- , stm- , unagi-chan-- ghc-options: -ddump-to-file -ddump-simpl -dsuppress-module-prefixes -dsuppress-uniques -ddump-core-stats -ddump-inlinings- ghc-options: -O2 -rtsopts - - -- Either do threaded for eventlogging and simple timing...- --ghc-options: -threaded -with-rtsopts=-N2- --ghc-options: -eventlog- -- ...or do non-threaded runtime- ghc-prof-options: -fprof-auto- --Relevant profiling RTS settings: -xt- -- TODO also check out +RTS -A10m, and look at output of -sstderr-- hs-source-dirs: core-example- main-is: Main.hs- default-language: Haskell2010-+-- executable dev-example+-- -- for n in `find dist/build/dev-example/dev-example-tmp -name '*dump-simpl'`; do cp $n "core-example/$(basename $n).$(git rev-parse --abbrev-ref HEAD)"; done+-- if !flag(dev)+-- buildable: False+-- else+-- build-depends: +-- base+-- , stm+-- , unagi-chan+--+-- ghc-options: -ddump-to-file -ddump-simpl -dsuppress-module-prefixes -dsuppress-uniques -ddump-core-stats -ddump-inlinings+-- ghc-options: -O2 -rtsopts +-- +-- -- Either do threaded for eventlogging and simple timing...+-- ghc-options: -threaded -eventlog+-- -- and run e.g. with +RTS -N -l+--+-- -- ...or do non-threaded runtime+-- --ghc-prof-options: -fprof-auto+-- --Relevant profiling RTS settings: -xt+-- -- TODO also check out +RTS -A10m, and look at output of -sstderr+--+-- hs-source-dirs: core-example+-- main-is: Main.hs+-- default-language: Haskell2010