chp 1.5.1 → 1.6.0

raw patch · 8 files changed

+232/−22 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Concurrent/CHP.hs +2/−0
• Control/Concurrent/CHP/Arrow.hs +5/−0
• Control/Concurrent/CHP/Behaviours.hs +190/−0
• Control/Concurrent/CHP/Channels/BroadcastReduce.hs +22/−13
• Control/Concurrent/CHP/Common.hs +3/−3
• Control/Concurrent/CHP/Monad.hs +6/−3
• Control/Concurrent/CHP/Traces/Base.hs +2/−2
• chp.cabal +2/−1

@@ -33,6 +33,8 @@ -- * "Control.Concurrent.CHP.Actions" --  -- * "Control.Concurrent.CHP.Arrow"+-- +-- * "Control.Concurrent.CHP.Behaviours" -- -- * "Control.Concurrent.CHP.Buffers" --

@@ -167,6 +167,8 @@   -- | The type that is an instance of 'Arrow' for process pipelines.  See 'runPipeline'.+--+-- The 'Functor' instance was added in version 1.6.0. data ProcessPipeline a b = ProcessPipeline   { runPipeline :: Chanin a -> Chanout b -> CHP ()     -- ^ Given a 'ProcessPipeline' (formed using its 'Arrow' instance) and@@ -208,6 +210,9 @@ -- Added in version 1.3.2 arrStrict :: NFData b => (a -> b) -> ProcessPipeline a b arrStrict = ProcessPipeline . CHP.map'++instance Functor (ProcessPipeline a) where+  fmap f x = x >>> arr f  #if __GLASGOW_HASKELL__ >= 609 instance Category ProcessPipeline where

@@ -0,0 +1,190 @@+-- Communicating Haskell Processes.+-- Copyright (c) 2009, University of Kent.+-- All rights reserved.+-- +-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+--  * Redistributions of source code must retain the above copyright+--    notice, this list of conditions and the following disclaimer.+--  * Redistributions in binary form must reproduce the above copyright+--    notice, this list of conditions and the following disclaimer in the+--    documentation and/or other materials provided with the distribution.+--  * Neither the name of the University of Kent nor the names of its+--    contributors may be used to endorse or promote products derived from+--    this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR+-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+++-- | A module containing CHP behaviours.  See 'offer' for details.+--+-- This whole module was added in CHP 1.6.0.+module Control.Concurrent.CHP.Behaviours (+  CHPBehaviour, offer, offerAll, alongside, alongside_, endWhen, once, repeatedly, repeatedly_,+  repeatedlyRecurse, repeatedlyRecurse_) where++import Control.Applicative+import Control.Monad++import Control.Concurrent.CHP++-- | This data represents a behaviour (potentially repeated) that will result in+-- returning a value of type @a@.  See 'offer' for more details.+data CHPBehaviour a = CHPBehaviour a (Maybe (CHP (CHPBehaviour a)))++instance Functor CHPBehaviour where+  fmap f (CHPBehaviour x Nothing) = CHPBehaviour (f x) Nothing+  fmap f (CHPBehaviour x (Just m)) = CHPBehaviour (f x) (Just $ fmap f <$> m)++-- | Offers the given behaviour, and when it occurs, ends the entire call to 'offer'.+--  Returns Just the result if the behaviour happens, otherwise gives Nothing.+endWhen :: CHP a -> CHPBehaviour (Maybe a)+endWhen m = CHPBehaviour Nothing (Just $ (\x -> CHPBehaviour (Just x) Nothing) <$> m)++-- | Offers the given behaviour, and when it occurs, does not offer it again.+-- Returns Just the result if the behaviour happens, otherwise gives Nothing.+-- 'once' is different to 'endWhen' because the latter terminates the call to 'offer'+-- regardless of other behaviours, whereas 'once' does not terminate the call to 'offer',+-- it just won't be offered again during the call to 'offer'.  Thus if you only+-- offer some 'once' items without any 'endWhen', then after all the 'once' events+-- have happened, the process will deadlock.+once :: CHP a -> CHPBehaviour (Maybe a)+once m = CHPBehaviour Nothing (Just $ (\x -> CHPBehaviour (Just x) (Just stop)) <$> m)++-- | Repeatedly offers the given behaviour until the outer call to 'offer' is terminated+-- by an 'endWhen' event.  A list is returned (in chronological order) of the results+-- of each occurrence of the behaviour.+repeatedly :: forall a. CHP a -> CHPBehaviour [a]+repeatedly m = reverse <$> repeatedly' []+  where+    repeatedly' :: [a] -> CHPBehaviour [a]+    repeatedly' xs = CHPBehaviour xs $ Just $ +      (\x -> repeatedly' (x:xs)) <$> m++-- | Like 'repeatedly', but discards the output.  Useful if the event is likely+-- to occur a lot, and you don't need the results.+repeatedly_ :: CHP a -> CHPBehaviour ()+repeatedly_ m = CHPBehaviour () $ Just $ m >> return (repeatedly_ m)++-- | Like 'repeatedly', but allows some state (of type @a@) to be passed from one+-- subsequent call to another, as well as generating the results of type @b@.+-- To begin with the function (first parameter) will be called with the initial+-- state (second parameter).  If chosen, it will return the new state, and a result+-- to be accumulated into the list.  The second call to the function will be passed+-- the new state, to then return the even newer state and a second result, and+-- so on.+--+-- If you want to use this with the StateT monad transformer from the mtl library,+-- you can call:+--+-- > repeatedlyRecurse (runStateT myStateAction) initialState+-- >   where+-- >     myStateAction :: StateT s CHP a+-- >     initialState :: s+repeatedlyRecurse :: forall a b. (a -> CHP (b, a)) -> a -> CHPBehaviour [b]+repeatedlyRecurse f = fmap reverse . repeatedlyRecurse' []+  where+    repeatedlyRecurse' :: [b] -> a -> CHPBehaviour [b]+    repeatedlyRecurse' rs x = CHPBehaviour rs $ Just $+      (\(r, y) -> repeatedlyRecurse' (r : rs) y) <$> f x++-- | Like 'repeatedlyRecurse', but does not accumulate a list of results.+--+-- If you want to use this with the StateT monad transformer from the mtl library,+-- you can call:+--+-- > repeatedlyRecurse (execStateT myStateAction) initialState+-- >   where+-- >     myStateAction :: StateT s CHP a+-- >     initialState :: s+repeatedlyRecurse_ :: forall a. (a -> CHP a) -> a -> CHPBehaviour ()+repeatedlyRecurse_ f = repeatedlyRecurse'+  where+    repeatedlyRecurse' :: a -> CHPBehaviour ()+    repeatedlyRecurse' x = CHPBehaviour () $ Just $ repeatedlyRecurse' <$> f x++-- | Offers one behaviour alongside another, combining their semantics.  See 'offer'.+--+-- This operation is semantically associative and commutative.+alongside :: CHPBehaviour a -> CHPBehaviour b -> CHPBehaviour (a, b)+alongside oa@(CHPBehaviour a mfa) ob@(CHPBehaviour b mfb)+  = CHPBehaviour (a, b) (do fa <- mfa+                            fb <- mfb+                            return $ (flip alongside ob <$> fa) <-> (alongside oa <$> fb)+                        )++-- | Offers one behaviour alongside another, combining their semantics.  See 'offer'.+-- Unlike 'alongside', discards the output of the behaviours.+--+-- This operation is associative and commutative.+alongside_ :: CHPBehaviour a -> CHPBehaviour b -> CHPBehaviour ()+alongside_ (CHPBehaviour _ mfa) (CHPBehaviour _ mfb)+  = CHPBehaviour () (liftM2 (<->) (liftM blank <$> mfa) (liftM blank <$> mfb))+  where+    blank :: CHPBehaviour c -> CHPBehaviour ()+    blank = fmap (const ())++infixr `alongside`++-- | Offers the given behaviour until finished.+--+-- For example,+-- +-- > offer $ repeatedly p `alongside` repeatedly q+-- +-- will repeatedly offer p and q without ever terminating.  This:+-- +-- > offer $ repeatedly p `alongside` repeatedly q `alongside` endWhen r+-- +-- will offer p repeatedly and q repeatedly and r, until r happens, at which point+-- the behaviour will end.+-- This:+-- +-- > offer $ once p `alongside` endWhen q+-- +-- will offer p and q; if p happens first it will wait for q, but if q happens+-- first it will finish.  This:+-- +-- > offer $ once p `alongside` endWhen q `alongside` endWhen r+-- +-- permits p to happen at most once, while either of q or r happening will finish+-- the call.+--+-- All sorts of combinations are possible, but it is important to note that you+-- need at least one 'endWhen' event if you ever intend the call to finish.  Some+-- laws involving 'offer' (ignoring the types and return values) are:+--+-- > offer (repeatedly p) == forever p+-- > offer (once p) == p >> stop -- i.e. it does not finish+-- > offer (endWhen q) == Just <$> q+-- > offer (endWhen p `alongside` endWhen q) == p <-> q+-- > offer (once p `alongside` endWhen q) == (p >> q) <-> q+--+-- Most other uses of 'offer' and 'alongside' do not reduce down to simple CHP+-- programs, which is of course their attraction.+offer :: CHPBehaviour a -> CHP a+offer (CHPBehaviour x Nothing) = return x+offer (CHPBehaviour _x (Just m)) = m >>= offer++-- | Offers all the given behaviours together, and gives back a list of the outcomes.+--  +-- This is roughly a shorthand for @offer . foldl1 alongside@, except that if you+-- pass the empty list, you simply get the empty list returned (rather than an+-- error)+offerAll :: [CHPBehaviour a] -> CHP [a]+offerAll [] = return []+offerAll bs = offer $ foldl1 (\x y -> fmap (uncurry (++)) $ alongside x y) bs'+  where+    bs' = map (fmap (:[])) bs

@@ -36,8 +36,15 @@ -- -- A communication on a one-to-many channel only takes place when the writer -- and all readers currently enrolled agree to communicate.  What happens when--- the writer wants to communicate and no readers are enrolled is undefined--- (the writer may block, or may communicate happily to no-one).+-- the writer wants to communicate and no readers are enrolled was undefined+-- in versions 1.5.1 and earlier (the writer may block, or may communicate+-- happily to no-one).  However, in version 1.6.0 onwards the semantics are+-- clear: a writer that communicates on a broadcast channel with no readers+-- involved will succeed immediately, communicating to no-one (i.e. the data+-- is lost).  Similarly, a read from a reduce channel will immediately return+-- 'mempty' when no writers are enrolled.  It is possible to get into a state+-- of livelock (by repeatedly performing these instant communications) in+-- these sorts of situations. -- -- This module also contains reduce channels (added in version 1.1.1).  Because -- in CHP channels must have the same type at both ends, we use the Monoid@@ -82,7 +89,7 @@  -- | The Eq instance was added in version 1.4.0. ----- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. newtype BroadcastChannel a = BC (Barrier, TVar (Maybe a), ManyToOneTVar Int) @@ -166,14 +173,14 @@  -- | Added in version 1.5.0. ----- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. oneToManyChannel' :: MonadCHP m => ChanOpts a -> m (OneToManyChannel a) oneToManyChannel' = newChannel'  -- | Added in version 1.5.0. ----- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. anyToManyChannel' :: MonadCHP m => ChanOpts a -> m (AnyToManyChannel a) anyToManyChannel' = newChannel'@@ -181,7 +188,7 @@  -- | The Eq instance was added in version 1.4.0. -- --- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. newtype ReduceChannel a = GC (Barrier, ManyToOneTVar (Int, Maybe (a, TVar Bool)), (a -> a -> a, a)) @@ -219,14 +226,16 @@          return r  instance ReadableChannel ReduceChanin where-  extReadChannel (GI (GC (b, tv, (_, _empty)))) f+  extReadChannel (GI (GC (b, tv, (_, empty)))) f     = do syncBarrierWith (indivRecJust ChannelRead)            (\n -> resetManyToOneTVar tv (pred n, Nothing)) $ Enrolled b            -- Subtract one for reader-         (_, Just (x, tvb)) <- liftIO $ atomically $ readManyToOneTVar tv-         y <- f x-         liftIO $ atomically $ writeTVar tvb True-         return y+         (_, val) <- liftIO $ atomically $ readManyToOneTVar tv+         case val of+           Just (x, tvb) -> do y <- f x+                               liftIO $ atomically $ writeTVar tvb True+                               return y+           Nothing -> f empty  instance Poisonable (Enrolled ReduceChanout a) where   poison (Enrolled (GO (GC (b,_,_)))) = poison $ Enrolled b@@ -267,14 +276,14 @@  -- | Added in version 1.5.0. -- --- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. manyToOneChannel' :: (Monoid a, MonadCHP m) => ChanOpts a -> m (ManyToOneChannel a) manyToOneChannel' = const manyToOneChannel --TODO  -- | Added in version 1.5.0. -- --- In version 1.5.0, the broadcast and reduce channels do not appear correctly+-- In versions 1.5.0-1.6.0, the broadcast and reduce channels do not appear correctly -- in the traces. manyToAnyChannel' :: (Monoid a, MonadCHP m) => ChanOpts a -> m (ManyToAnyChannel a) manyToAnyChannel' = const manyToAnyChannel --TODO

@@ -123,7 +123,7 @@ -- assume that this process will actually perform the computation.  If you -- require a strict transformation, use 'map''. map :: (a -> b) -> Chanin a -> Chanout b -> CHP ()-map f in_ out = forever (readChannel in_ >>= (return . f) >>= writeChannel out)+map f in_ out = forever (readChannel in_ >>= writeChannel out . f)   `onPoisonRethrow` (poison in_ >> poison out)  -- | Like 'map', but applies the transformation strictly before sending on@@ -131,7 +131,7 @@ -- -- Added in version 1.1.0. map' :: NFData b => (a -> b) -> Chanin a -> Chanout b -> CHP ()-map' f in_ out = forever (readChannel in_ >>= (return . f) >>= writeChannelStrict out)+map' f in_ out = forever (readChannel in_ >>= writeChannelStrict out . f)   `onPoisonRethrow` (poison in_ >> poison out)  -- | Forever reads in a value, and then based on applying the given function@@ -219,7 +219,7 @@ -- | Forever reads a value from all its input channels in parallel, then joins -- the values into a list in the same order as the channels, and sends them out again. joinList :: [Chanin a] -> Chanout [a] -> CHP ()-joinList ins out = (forever $ runParallel [readChannel c | c <- ins] >>= writeChannel out+joinList ins out = (forever $ runParMapM readChannel ins >>= writeChannel out   ) `onPoisonRethrow` (poisonAll ins >> poison out)  

@@ -164,7 +164,9 @@ -- can be used to mask out guards.  If you actually execute 'stop', that process -- will do nothing more.  Any parent process waiting for it to complete will -- wait forever.-stop :: CHP ()+--+-- The type of this function was generalised in CHP 1.6.0.+stop :: CHP a stop = liftPoison $ AltableT (Right [(stopGuard, liftIO hang)]) (liftIO hang)   where     -- Strangely, I can't work out a good way to actually implement stop.@@ -173,5 +175,6 @@     -- CPU.  Throwing an exception would be caught and terminate the     -- process, which is not the desired behaviour.  The only thing I can think     -- to do is to repeatedly wait for a very long time.-    hang :: IO ()-    hang = forever $ threadDelay maxBound+    hang :: IO a+    hang = do forever $ threadDelay maxBound+              return undefined

@@ -115,8 +115,8 @@ nameEvent (t, c) = liftM (++ suffix) $ getName prefix c   where     (prefix, suffix) = case t of-      ChannelComm x -> ("_c", if null x then "" else "[" ++ x ++ "]")-      BarrierSync x -> ("_b", if null x then "" else "[" ++ x ++ "]")+      ChannelComm x -> ("_c", if null x then "" else "." ++ x)+      BarrierSync x -> ("_b", if null x then "" else "." ++ x)       ClockSync st -> ("_t", ':' : st)  nameEvent' :: Ord u => RecordedEvent u -> State (Map.Map u String) (RecordedEvent String)

@@ -1,5 +1,5 @@ Name:            chp-Version:         1.5.1+Version:         1.6.0 Synopsis:        An implementation of concurrency ideas from Communicating Sequential Processes License:         BSD3 License-file:    LICENSE@@ -27,6 +27,7 @@                  Control.Concurrent.CHP.Alt                  Control.Concurrent.CHP.Arrow                  Control.Concurrent.CHP.Barriers+                 Control.Concurrent.CHP.Behaviours                  Control.Concurrent.CHP.BroadcastChannels                  Control.Concurrent.CHP.Buffers                  Control.Concurrent.CHP.Channels