diff --git a/Control/Concurrent/CHP.hs b/Control/Concurrent/CHP.hs
--- a/Control/Concurrent/CHP.hs
+++ b/Control/Concurrent/CHP.hs
@@ -30,7 +30,7 @@
 -- | This module re-exports the core functionality of the CHP library.  Other
 -- modules that you also may wish to import are:
 --
--- * "Control.Concurrent.CHP.Action"
+-- * "Control.Concurrent.CHP.Actions"
 -- 
 -- * "Control.Concurrent.CHP.Arrow"
 --
@@ -39,6 +39,8 @@
 -- * "Control.Concurrent.CHP.Common"
 --
 -- * "Control.Concurrent.CHP.Console"
+--
+-- * "Control.Concurrent.CHP.Test"
 --
 -- * "Control.Concurrent.CHP.Traces"
 --
diff --git a/Control/Concurrent/CHP/Alt.hs b/Control/Concurrent/CHP/Alt.hs
--- a/Control/Concurrent/CHP/Alt.hs
+++ b/Control/Concurrent/CHP/Alt.hs
@@ -103,13 +103,16 @@
 -- would).
 module Control.Concurrent.CHP.Alt (alt, (<->), priAlt, (</>), every, (<&>)) where
 
+import Control.Arrow
 import Control.Concurrent.STM
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Trans
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Set as Set
 import Data.Unique
 import System.IO
 
@@ -365,7 +368,7 @@
         altStuff = liftM concat $ mapM pullOutAltable items
 
 -- Performs the select operation on all the guards, and then executes the body
-selectFromGuards :: (Either String [(Guard, TraceT IO (WithPoison a))]) -> TraceT IO (WithPoison a)
+selectFromGuards :: forall a. (Either String [(Guard, TraceT IO (WithPoison a))]) -> TraceT IO (WithPoison a)
 selectFromGuards (Left str) =
            let err = "ALTing not supported on given guard: " ++ str
            in liftIO $ do hPutStrLn stderr err
@@ -374,20 +377,25 @@
         | null (eventGuards $ map fst both) =
            join $ liftM snd $ liftIO $ waitNormalGuards both Nothing
         | otherwise =
-           do let (guards, bodies) = unzip both
+           do let (guards, _bodies) = unzip both
                   earliestReady = findIndex isSkipGuard guards
-                  recordAndRun _ (Signal PoisonItem)
-                    = return PoisonItem
-                  recordAndRun m (Signal (NoPoison n))
-                    = let (EventGuard rec _ _, body) = both !! n
-                      in recordEvent (rec $ makeLookup m) >> body
-                  justRun (Signal PoisonItem) = return PoisonItem
-                  justRun (Signal (NoPoison n)) = bodies !! n
-                  guardsAndSignal :: [(Guard, (SignalValue, Map.Map Unique Integer))]
-                  guardsAndSignal = zip guards (zip (map (Signal . NoPoison) [0..]) (repeat Map.empty))
+                  recordAndRun :: WithPoison ([RecordedIndivEvent Unique], TraceT
+                    IO (WithPoison a)) -> TraceT IO (WithPoison a)
+                  recordAndRun PoisonItem = return PoisonItem
+                  recordAndRun (NoPoison (r, m)) = recordEvent r >> m
+                  guardsAndRec :: [(Guard, WithPoison ([RecordedIndivEvent Unique], TraceT IO (WithPoison a)))]
+                  guardsAndRec = map (second (NoPoison . (,) [])) both
+                  getRec :: (SignalValue, Map.Map Unique (Integer, RecordedEventType))
+                         -> WithPoison ([RecordedIndivEvent Unique], TraceT IO (WithPoison a))
+                  getRec (Signal PoisonItem, _) = PoisonItem
+                  getRec (Signal (NoPoison n), m)
+                    = case both !! n of
+                        (EventGuard rec _ _, body) ->
+                          NoPoison (rec (makeLookup m), body)
+                        (_, body) -> NoPoison ([], body)
               tv <- liftIO $ newTVarIO Nothing
               pid <- getProcessId
-              tr <- get
+              tr <- ask
               mn <- liftIO . atomically $ do
                       ret <- enableEvents tv pid
                         (maybe id take earliestReady $ eventGuards guards)
@@ -399,15 +407,15 @@
                                  Signal PoisonItem -> return ()
                                  Signal (NoPoison n) ->
                                    let EventGuard _ act _ = guards !! n
-                                   in actWhenLast act
+                                   in actWhenLast act (Map.fromList $ map (snd *** Set.size) es)
                             )
                             ret
-                      return ret
+                      return $ fmap (getRec . fst) ret
               case (mn, earliestReady) of
                 -- An event -- and we were the last person to arrive:
                 -- The event must have been higher priority than any other
                 -- ready guards
-                (Just ((n, m), _), _) -> recordAndRun m n
+                (Just r, _) -> recordAndRun r
                 -- No events were ready, but there was an available normal
                 -- guards.  Re-run the normal guards; at least one will be ready
                 (Nothing, Just _) ->
@@ -415,10 +423,10 @@
                 -- No events ready, no other guards ready either
                 -- Events will have been enabled; wait for everything:
                 (Nothing, Nothing) ->
-                    do (wasAltingBarrier, (n, m)) <- liftIO $ waitNormalGuards
-                         guardsAndSignal $ Just $ waitAlting tv
+                    do (wasAltingBarrier, pr) <- liftIO $ waitNormalGuards
+                         guardsAndRec $ Just $ liftM getRec $ waitAlting tv
                        if wasAltingBarrier
-                         then recordAndRun m n -- It was a barrier, all done
+                         then recordAndRun pr -- It was a barrier, all done
                          else
                             -- Another guard fired, but we must check in case
                             -- we have meanwhile been committed to taking an
@@ -427,18 +435,19 @@
                                  $ eventGuards guards)
                                case mn' of
                                  -- An event overrides our non-event choice:
-                                 Just (x, m') -> recordAndRun m' x
+                                 Just pr' -> recordAndRun $ getRec pr'
                                  -- Go with the original option, no events
                                  -- became ready:
-                                 Nothing -> justRun n
+                                 Nothing -> recordAndRun pr
 
-waitAlting :: SignalVar -> STM (SignalValue, Map.Map Unique Integer)
+waitAlting :: SignalVar -> STM (SignalValue, Map.Map Unique (Integer, RecordedEventType))
 waitAlting tv = do b <- readTVar tv
                    case b of
                      Nothing -> retry
                      Just ns -> return ns
 
-makeLookup :: Map.Map Unique Integer -> Unique -> Integer
+makeLookup :: Map.Map Unique (Integer, RecordedEventType) -> Unique -> (Integer,
+  RecordedEventType)
 makeLookup m u = fromMaybe (error "CHP: Unique not found in alt") $ Map.lookup u m
 
 -- The alting barrier guards:
diff --git a/Control/Concurrent/CHP/Arrow.hs b/Control/Concurrent/CHP/Arrow.hs
--- a/Control/Concurrent/CHP/Arrow.hs
+++ b/Control/Concurrent/CHP/Arrow.hs
@@ -60,7 +60,9 @@
 -- together a certain class of process network, you should do fine.
 --
 -- Added in version 1.0.2.
-module Control.Concurrent.CHP.Arrow (ProcessPipeline, runPipeline, arrowProcess, arrStrict) where
+module Control.Concurrent.CHP.Arrow (ProcessPipeline, runPipeline, arrowProcess, arrStrict,
+  ProcessPipelineLabel, runPipelineLabel, arrowProcessLabel, arrLabel, arrStrictLabel,
+  (*>>>*), (*<<<*), (*&&&*), (*****)) where
 
 -- I have got this module to work on GHC 6.8 and 6.10 by following the CPP-variant
 -- instructions on this page: http://haskell.org/haskellwiki/Upgrading_packages
@@ -81,6 +83,89 @@
 import qualified Control.Concurrent.CHP.Common as CHP
 import Control.Concurrent.CHP.Utils
 
+-- | ProcessPipelineLabel is a version of 'ProcessPipeline' that allows the processes
+-- to be labelled, and thus in turn for the channels connecting the processes to
+-- be automatically labelled.  ProcessPipelineLabel is not an instance of Arrow,
+-- but it does have a lot of similarly named functions for working with it.  This
+-- awkwardness is due to the extra Show constraints on the connectors that allow
+-- the arrow's contents to appear in traces.
+--
+-- If you don't use traces, use 'ProcessPipeline'.  If you do use traces, and want
+-- to have better labels on the process and values used in your arrows, consider
+-- switching to ProcessPipelineLabel.
+--
+-- ProcessPipelineLabel and all the functions that use it, were added in version
+-- 1.5.0.
+data ProcessPipelineLabel a b = ProcessPipelineLabel
+  { runPipelineLabel :: Chanin a -> Chanout b -> CHP ()
+    -- ^ Like 'runPipeline' but for 'ProcessPipelineLabel'
+  , _pipelineLabels :: (String, String)
+  }
+
+-- | Like 'arrowProcess', but allows the process to be labelled.  The same
+-- warnings as 'arrowProcess' apply.
+arrowProcessLabel :: String -> (Chanin a -> Chanout b -> CHP ()) -> ProcessPipelineLabel a b
+arrowProcessLabel l p = ProcessPipelineLabel p (l, l)
+
+-- | Like 'arr' for 'ProcessPipeline', but allows the process to be labelled.
+arrLabel :: String -> (a -> b) -> ProcessPipelineLabel a b
+arrLabel l = arrowProcessLabel l . CHP.map
+
+-- | Like 'arrStrict', but allows the process to be labelled.
+arrStrictLabel :: NFData b => String -> (a -> b) -> ProcessPipelineLabel a b
+arrStrictLabel l = arrowProcessLabel l . CHP.map'
+
+-- | The '(>>>)' arrow combinator, for 'ProcessPipelineLabel'.
+(*>>>*) :: Show b => ProcessPipelineLabel a b -> ProcessPipelineLabel b c
+  -> ProcessPipelineLabel a c
+(*>>>*) (ProcessPipelineLabel p (pl, pr)) (ProcessPipelineLabel q (ql, qr))
+  = ProcessPipelineLabel (p |->|^ (pr ++ "->" ++ ql, q)) (pl, qr)
+
+-- | The '(<<<)' arrow combinator, for 'ProcessPipelineLabel'.
+(*<<<*) :: Show b => ProcessPipelineLabel b c -> ProcessPipelineLabel a b
+  -> ProcessPipelineLabel a c
+(*<<<*) = flip (*>>>*)
+
+-- | The '(&&&)' arrow combinator, for 'ProcessPipelineLabel'.
+(*&&&*) :: (Show b, Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b c' -> ProcessPipelineLabel b (c, c')
+(*&&&*) (ProcessPipelineLabel p (pl, pr))
+        (ProcessPipelineLabel q (ql, qr))
+  = ProcessPipelineLabel proc (mix pl ql, mix pr qr)
+  where
+    mix a b = "(" ++ a ++ "*&&&*" ++ b ++ ")"
+    proc input output
+       = do deltaP <- oneToOneChannel' $ chanLabel $ pl ++ ".in"
+            deltaQ <- oneToOneChannel' $ chanLabel $ ql ++ ".in"
+            joinP <- oneToOneChannel' $ chanLabel $ pr ++ ".out"
+            joinQ <- oneToOneChannel' $ chanLabel $ qr ++ ".out"
+            runParallel_
+              [CHP.parDelta input (writers [deltaP, deltaQ])
+              ,p (reader deltaP) (writer joinP)
+              ,q (reader deltaQ) (writer joinQ)
+              ,CHP.join (,) (reader joinP) (reader joinQ) output
+              ]
+
+-- | The '(***)' arrow combinator, for 'ProcessPipelineLabel'.
+(*****) :: (Show b, Show b', Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b' c'
+  -> ProcessPipelineLabel (b, b') (c, c')
+(*****) (ProcessPipelineLabel p (pl, pr))
+        (ProcessPipelineLabel q (ql, qr))
+  = ProcessPipelineLabel proc (mix pl ql, mix pr qr)
+  where
+    mix a b = "(" ++ a ++ "*****" ++ b ++ ")"
+    proc input output
+       = do deltaP <- oneToOneChannel' $ chanLabel $ mix pl ql ++ "->" ++ pl
+            deltaQ <- oneToOneChannel' $ chanLabel $ mix pl ql ++ "->" ++ ql
+            joinP <- oneToOneChannel' $ chanLabel $ pr ++ "->" ++ mix pr qr
+            joinQ <- oneToOneChannel' $ chanLabel $ qr ++ "->" ++ mix pr qr
+            runParallel_
+              [CHP.split input (writer deltaP) (writer deltaQ)
+              ,p (reader deltaP) (writer joinP)
+              ,q (reader deltaQ) (writer joinQ)
+              ,CHP.join (,) (reader joinP) (reader joinQ) output
+              ]
+
+
 -- | The type that is an instance of 'Arrow' for process pipelines.  See 'runPipeline'.
 data ProcessPipeline a b = ProcessPipeline
   { runPipeline :: Chanin a -> Chanout b -> CHP ()
@@ -108,7 +193,8 @@
 -- Any process you apply this to should produce exactly one output per
 -- input, or else you will find odd behaviour resulting (including deadlock).
 --  So for example, /don't/ use @arrowProcess ('Control.Concurrent.CHP.Common.filter'
--- ...)@ or @arrowProcess 'Control.Concurrent.CHP.Common.stream'@
+-- ...)@ or @arrowProcess 'Control.Concurrent.CHP.Common.stream'@ inside any arrow combinators
+-- other than >>> and <<<.
 --
 -- Added in version 1.1.0
 arrowProcess :: (Chanin a -> Chanout b -> CHP ()) -> ProcessPipeline a b
diff --git a/Control/Concurrent/CHP/Barriers.hs b/Control/Concurrent/CHP/Barriers.hs
--- a/Control/Concurrent/CHP/Barriers.hs
+++ b/Control/Concurrent/CHP/Barriers.hs
@@ -65,7 +65,8 @@
 -- on.
 module Control.Concurrent.CHP.Barriers (Barrier, EnrolledBarrier, newBarrier, newBarrierWithLabel,
   PhasedBarrier, newPhasedBarrier, newPhasedBarrierWithLabel, newPhasedBarrierCustomInc,
-    newPhasedBarrierWithLabelCustomInc, currentPhase, waitForPhase,
+    newPhasedBarrierCustomShowInc, newPhasedBarrierWithLabelCustomInc,
+    newPhasedBarrierWithLabelCustomShowInc, currentPhase, waitForPhase,
     syncBarrier, getBarrierIdentifier) where
 
 import Control.Concurrent.STM
@@ -91,7 +92,7 @@
 -- | Synchronises on the given barrier.  You must be enrolled on a barrier in order
 -- to synchronise on it.  Returns the new phase, following the synchronisation.
 syncBarrier :: Enrolled PhasedBarrier phase -> CHP phase
-syncBarrier = syncBarrierWith (indivRecJust BarrierSyncIndiv)
+syncBarrier = syncBarrierWith (indivRecJust BarrierSyncIndiv) (const $ return ())
     
 -- | Finds out the current phase a barrier is on.
 currentPhase :: Enrolled PhasedBarrier phase -> CHP phase
@@ -112,13 +113,18 @@
 newBarrier :: CHP Barrier
 newBarrier = newPhasedBarrier ()
 
+newBarrierEvent :: (phase -> String) -> TVar phase -> IO Event
+newBarrierEvent sh tv = newEvent (liftM (BarrierSync . sh) $ readTVar tv) 0
+
 -- | Creates a new barrier with no processes enrolled, that will be on the
 -- given phase.  You will often want to pass in the last value in your phase
 -- cycle, so that the first synchronisation moves it on to the first
-newPhasedBarrier :: (Enum phase, Bounded phase, Eq phase) => phase -> CHP (PhasedBarrier phase)
+--
+-- The Show constraint was added in version 1.5.0
+newPhasedBarrier :: (Enum phase, Bounded phase, Eq phase, Show phase) => phase -> CHP (PhasedBarrier phase)
 newPhasedBarrier ph = liftPoison $ liftTrace $ do
-  e <- liftIO $ newEvent BarrierSync 0
   tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent show tv 
   return $ Barrier (e, tv, \p -> if p == maxBound then minBound else succ p)
 
 -- | Creates a new barrier with no processes enrolled, that will be on the
@@ -127,13 +133,32 @@
 -- function) to get a barrier that never cycles.  You can also do things like supplying
 -- (+2) as the incrementing function, or even using lists as the phase type to
 -- do crazy things.
+--
+-- Note that the phase will not show up in the traces -- see
+-- 'newPhasedBarrierCustomShowInc' for that.
 newPhasedBarrierCustomInc :: (phase -> phase) -> phase -> CHP (PhasedBarrier phase)
 newPhasedBarrierCustomInc f ph = liftPoison $ liftTrace $ do
-  e <- liftIO $ newEvent BarrierSync 0
   tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent (const "") tv
   return $ Barrier (e, tv, f)
 
+-- | Creates a new barrier with no processes enrolled, that will be on the
+-- given phase, along with a custom function to show the phase in traces and to
+-- increment the phase.  You can therefore
+-- use this function with Integer as the inner type (and succ or (+1) as the incrementing
+-- function, and show as the showing function) to get a barrier that never cycles.  You can also do things like supplying
+-- (+2) as the incrementing function, or even using lists as the phase type to
+-- do crazy things.
+--
+-- This function was added in version 1.5.0.
+newPhasedBarrierCustomShowInc :: (phase -> String) -> (phase -> phase) -> phase -> CHP (PhasedBarrier phase)
+newPhasedBarrierCustomShowInc sh f ph = liftPoison $ liftTrace $ do
+  tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent sh tv
+  return $ Barrier (e, tv, f)
 
+
+
 -- | Creates a new barrier with no processes enrolled and labels it in traces
 -- using the given label.  See 'newBarrier'.
 newBarrierWithLabel :: String -> CHP Barrier
@@ -141,20 +166,36 @@
 
 -- | Creates a new barrier with no processes enrolled and labels it in traces
 -- using the given label.  See 'newPhasedBarrier'.
-newPhasedBarrierWithLabel :: (Enum phase, Bounded phase, Eq phase) => String -> phase -> CHP (PhasedBarrier phase)
+--
+-- The Show constraint was added in version 1.5.0.
+newPhasedBarrierWithLabel :: (Enum phase, Bounded phase, Eq phase, Show phase) => String -> phase -> CHP (PhasedBarrier phase)
 newPhasedBarrierWithLabel l ph = liftPoison $ liftTrace $ do
-  e <- liftIO $ newEvent BarrierSync 0
-  labelEvent e l
   tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent show tv
+  labelEvent e l
   return $ Barrier (e, tv, \p -> if p == maxBound then minBound else succ p)
 
 -- | Creates a new barrier with no processes enrolled and labels it in traces
 -- using the given label.  See 'newPhasedBarrierCustomInc'.
+--
+-- Note that the barrier will not record the phase in the traces -- see
+-- 'newPhasedBarrierWithLabelCustomShowInc' for that.
 newPhasedBarrierWithLabelCustomInc :: String -> (phase -> phase) -> phase -> CHP (PhasedBarrier phase)
 newPhasedBarrierWithLabelCustomInc l f ph = liftPoison $ liftTrace $ do
-  e <- liftIO $ newEvent BarrierSync 0
+  tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent (const "") tv
   labelEvent e l
+  return $ Barrier (e, tv, f)
+
+-- | Creates a new barrier with no processes enrolled and labels it in traces
+-- using the given label and given show function for the phase.  See 'newPhasedBarrierWithLabelCustomInc'.
+--
+-- This function was added in version 1.5.0.
+newPhasedBarrierWithLabelCustomShowInc :: String -> (phase -> String) -> (phase -> phase) -> phase -> CHP (PhasedBarrier phase)
+newPhasedBarrierWithLabelCustomShowInc l sh f ph = liftPoison $ liftTrace $ do
   tv <- liftIO $ atomically $ newTVar ph
+  e <- liftIO $ newBarrierEvent sh tv
+  labelEvent e l
   return $ Barrier (e, tv, f)
 
 
diff --git a/Control/Concurrent/CHP/Base.hs b/Control/Concurrent/CHP/Base.hs
--- a/Control/Concurrent/CHP/Base.hs
+++ b/Control/Concurrent/CHP/Base.hs
@@ -36,6 +36,7 @@
 import Control.Applicative
 import Control.Arrow
 import Control.Concurrent.STM
+import qualified Control.Exception.Extensible as C
 import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
@@ -43,6 +44,7 @@
 import Control.Monad.Trans
 import qualified Data.Map as Map
 import Data.Unique
+import System.IO
 import qualified Text.PrettyPrint.HughesPJ
 
 import Control.Concurrent.CHP.Guard
@@ -189,27 +191,84 @@
 liftSTM = liftIO . atomically
 
 getProcessId :: TraceT IO ProcessId
-getProcessId = do x <- get
+getProcessId = do x <- ask
                   case x of
                     Trace (pid,_,_) -> return pid
-                    NoTrace -> return emptyProcessId
+                    NoTrace pid -> return pid
 
-runCHPProgramWith :: TraceStore -> (TraceStore -> t) -> CHP a -> IO (Maybe a, t)
-runCHPProgramWith start f (PoisonT p)
-  = do (x, t) <- runStateT (liftM (either (const Nothing) Just) $ pullOutStandard $ runErrorT p) start
-       return (x, f t)
+wrapProcess :: CHP a -> (CHP' (Either PoisonError a) -> IO (Either PoisonError a)) -> IO (Maybe (Either () a))
+wrapProcess (PoisonT proc) unwrapInner
+  = do let inner = runErrorT proc
+       x <- liftM Just (unwrapInner inner) `C.catches` allHandlers
+       case x of
+         Nothing -> return Nothing
+         Just (Left _) -> return $ Just $ Left ()
+         Just (Right y) -> return $ Just $ Right y
+  where
+    response :: C.Exception e => e -> IO (Maybe a)
+    response x = liftIO (hPutStrLn stderr $ "(CHP) Thread terminated with: " ++ show x)
+                   >> return Nothing
 
-runCHPProgramWith' :: SubTraceStore -> (ChannelLabels Unique -> SubTraceStore -> IO t) -> CHP a -> IO (Maybe a, t)
+    allHandlers = [C.Handler (response :: C.IOException -> IO (Maybe a))
+                  ,C.Handler (response :: C.AsyncException -> IO (Maybe a))
+                  ,C.Handler (response :: C.NonTermination -> IO (Maybe a))
+#if __GLASGOW_HASKELL__ >= 611
+                  ,C.Handler (response :: C.BlockedIndefinitelyOnSTM -> IO (Maybe a))
+#else
+                  ,C.Handler (response :: C.BlockedIndefinitely -> IO (Maybe a))
+#endif
+                  ,C.Handler (response :: C.Deadlock -> IO (Maybe a))
+                  ]
+
+runCHPProgramWith :: TraceStore -> CHP a -> IO (Maybe a)
+runCHPProgramWith start p
+  = do r <- wrapProcess p run
+       case r of
+         Nothing -> return Nothing
+         Just (Left _) -> return Nothing
+         Just (Right x) -> return (Just x)
+  where
+    run :: CHP' (Either PoisonError a) -> IO (Either PoisonError a)
+    run = flip runReaderT start . pullOutStandard
+    --run m = runStateT ({-liftM (either (const Nothing) Just) $ -} pullOutStandard m) start
+
+runCHPProgramWith' :: SubTraceStore -> (ChannelLabels Unique -> IO t) -> CHP a -> IO (Maybe a, t)
 runCHPProgramWith' subStart f p
   = do tv <- atomically $ newTVar Map.empty
-       (x, Trace (_,_,t)) <- runCHPProgramWith
-                                (Trace (rootProcessId, tv, subStart))
-                                id p
+       x <- runCHPProgramWith (Trace (rootProcessId, tv, subStart)) p
 --                             `C.catch` const (return (Nothing,
 --                               Trace (undefined, undefined, subStart)))
        l <- atomically $ readTVar tv
-       t' <- f l t
+       t' <- f l
        return (x, t')
+
+newtype ManyToOneTVar a = ManyToOneTVar (TVar a, TVar (Maybe a))
+  deriving Eq
+
+newManyToOneTVar :: a -> STM (ManyToOneTVar a)
+newManyToOneTVar x
+  = do tvInter <- newTVar x
+       tvFinal <- newTVar Nothing
+       return $ ManyToOneTVar (tvInter, tvFinal)
+
+writeManyToOneTVar :: (a -> Bool, STM a) -> (a -> a) -> ManyToOneTVar a -> STM a
+writeManyToOneTVar (done, reset) f (ManyToOneTVar (tvInter, tvFinal))
+  = do x <- readTVar tvInter
+       if done (f x)
+         then do writeTVar tvFinal $ Just $ f x
+                 reset >>= writeTVar tvInter
+         else writeTVar tvInter $ f x
+       return $ f x
+
+readManyToOneTVar :: ManyToOneTVar a -> STM a
+readManyToOneTVar (ManyToOneTVar (_tvInter, tvFinal))
+  = do x <- readTVar tvFinal >>= maybe retry return
+       writeTVar tvFinal Nothing
+       return x
+
+resetManyToOneTVar :: ManyToOneTVar a -> a -> STM ()
+resetManyToOneTVar (ManyToOneTVar (tvInter, tvFinal)) x
+  = writeTVar tvInter x >> writeTVar tvFinal Nothing
 
 -- ==========
 -- Instances: 
diff --git a/Control/Concurrent/CHP/BroadcastChannels.hs b/Control/Concurrent/CHP/BroadcastChannels.hs
--- a/Control/Concurrent/CHP/BroadcastChannels.hs
+++ b/Control/Concurrent/CHP/BroadcastChannels.hs
@@ -1,5 +1,5 @@
 -- Communicating Haskell Processes.
--- Copyright (c) 2008, University of Kent.
+-- Copyright (c) 2008--2009, University of Kent.
 -- All rights reserved.
 -- 
 -- Redistribution and use in source and binary forms, with or without
@@ -27,269 +27,9 @@
 -- 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 broadcast channels (one-to-many).  Whereas a one-to-any
--- channel features one writer sending a /single/ value to /one/ (of many) readers, a
--- one-to-many channel features one writer sending the /same/ value to /many/
--- readers.  So a one-to-any channel involves claiming the channel-end to ensure
--- exclusivity, but a one-to-many channel involves enrolling on the channel-end
--- (subscribing) before it can engage in communication.
---
--- 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).
---
--- 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
--- type-class.  It is important to be aware that the order of mappends will be
--- non-deterministic, and thus you should either use an mappend that is commutative
--- or code around this restruction.
---
--- For example, a common thing to do would be to use lists as the type for
--- reduce channels, make each writer write a single item list (but more is
--- possible), then use the list afterwards, but be aware that it is unordered.
---  If it is important to have an ordered list, make each writer write a pair
--- containing a (unique) index value and the real data, then sort by the index
--- value and discard it.
---
--- Since reduce channels were added after the initial library design, there
--- is a slight complication: it is not possible to use newChannel (and all
--- similar functions) with reduce channels because it is impossible to express
--- the Monoid constraint for the Channel instance.  Instead, you must use manyToOneChannel
--- and manyToAnyChannel.
-module Control.Concurrent.CHP.BroadcastChannels (BroadcastChanin, BroadcastChanout,
-  OneToManyChannel, AnyToManyChannel, oneToManyChannel, anyToManyChannel,
-    oneToManyChannelWithLabel, anyToManyChannelWithLabel, ReduceChanin,
-    ReduceChanout, sameReduceChannel, ManyToOneChannel, ManyToAnyChannel, manyToOneChannel,
-    manyToAnyChannel, manyToOneChannelWithLabel, manyToAnyChannelWithLabel)
-      where
-
-import Control.Concurrent.STM
-import Control.Monad.Trans
-import Data.Monoid
-
-import Control.Concurrent.CHP.Barriers
-import Control.Concurrent.CHP.Base
-import Control.Concurrent.CHP.Channels
-import Control.Concurrent.CHP.CSP
-import Control.Concurrent.CHP.Enroll
-import Control.Concurrent.CHP.Event
-import Control.Concurrent.CHP.Mutex
-import Control.Concurrent.CHP.Traces.Base
-
-
--- The general pattern of a broadcast channel is as follows:
--- SYNC -> Agreement; the readers indicate they are all willing to read, and the
--- writer indicates it is ready to write.  Either side may ALT.
---
--- After this synchronisation, the writer can write his data to the TVar, possibly
--- following an extended action
--- 
--- SYNC -> Reading; everyone syncs (no-one ALTs) to move to the reading phase
---
--- After this synchronisation, the readers can all read the data from the TVar,
--- and possibly complete an extended action
---
--- SYNC -> Neutral; everyone syncs (no-one ALTs) to indicate one communication
--- cycle has finished.  After this the writer may proceed on their way (the
--- main reason for needing a third sync).
-
--- There used to be a warning that the first two constructors are never used, but they
--- do need to be there for the Enum and Bounded instances...
-data Phase = Agreement | Reading | Neutral deriving (Enum, Bounded, Eq)
--- So I constructed this horrendous hack to suppress the warning:
-dontWarnMe :: a -> a
-dontWarnMe = flip const [Agreement, Reading, Neutral]
-
--- | The Eq instance was added in version 1.4.0.
-newtype BroadcastChannel a = BC (PhasedBarrier Phase, TVar a)
-
-instance Eq (BroadcastChannel a) where
-  (BC (_, tvX)) == (BC (_, tvY)) = tvX == tvY
-
--- | The reading end of a broadcast channel.  You must enroll on it before
--- you can read from it or poison it.
--- 
--- The Eq instance was added in version 1.4.0.
-newtype BroadcastChanin a = BI (BroadcastChannel a) deriving (Eq)
-
--- | The writing end of a broadcast channel.
--- 
--- The Eq instance was added in version 1.4.0.
-newtype BroadcastChanout a = BO (BroadcastChannel a) deriving (Eq)
-
-instance Enrollable BroadcastChanin a where
-  enroll c@(BI (BC (b,_))) f = enroll b (\eb -> waitForPhase Neutral eb >> f (Enrolled c))
-  resign (Enrolled (BI (BC (b,_)))) m
-    = do x <- resign (Enrolled b) m
-         waitForPhase Neutral (Enrolled b)
-         return x
-
-instance WriteableChannel BroadcastChanout where
-  extWriteChannel' (BO (BC (b, tv))) m
-    = do syncBarrierWith (indivRecJust ChannelWrite)
-           $ Enrolled b
-         (x, r) <- m
-         liftIO . atomically $ writeTVar tv x
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         return r
-
-instance ReadableChannel (Enrolled BroadcastChanin) where
-  extReadChannel (Enrolled (BI (BC (b, tv)))) f
-    = do syncBarrierWith (indivRecJust ChannelRead)
-           $ Enrolled b
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         x <- liftIO (atomically $ readTVar tv)
-         y <- f x
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         return y
-
-instance Poisonable (BroadcastChanout a) where
-  poison (BO (BC (b,_))) = poison $ Enrolled b
-  checkForPoison (BO (BC (b,_))) = checkForPoison $ Enrolled b
-
-instance Poisonable (Enrolled BroadcastChanin a) where
-  poison (Enrolled (BI (BC (b,_)))) = poison $ Enrolled b
-  checkForPoison (Enrolled (BI (BC (b,_)))) = checkForPoison $ Enrolled b
-
-newBroadcastChannel :: CHP (BroadcastChannel a)
-newBroadcastChannel = dontWarnMe {- see above -} $ do
-    do b@(Barrier (e, _, _)) <- newPhasedBarrier Neutral
-       -- Writer is always enrolled:
-       liftIO $ atomically $ enrollEvent e
-       tv <- liftIO $ atomically $ newTVar undefined
-       return $ BC (b, tv)
-
-instance Channel BroadcastChanin BroadcastChanout where
-  newChannel = liftCHP $ do
-    c@(BC (b,_)) <- newBroadcastChannel
-    return $ Chan (getBarrierIdentifier b) (BI c) (BO c)
-  sameChannel (BI x) (BO y) = x == y
-
-instance Channel BroadcastChanin (Shared BroadcastChanout) where
-  newChannel = liftCHP $ do
-    m <- newMutex
-    c <- newChannel
-    return $ Chan (getChannelIdentifier c) (reader c) (Shared (m, writer c))
-  sameChannel (BI x) (Shared (_, BO y)) = x == y
-
-type OneToManyChannel = Chan BroadcastChanin BroadcastChanout
-type AnyToManyChannel = Chan BroadcastChanin (Shared BroadcastChanout)
-
-oneToManyChannel :: MonadCHP m => m (OneToManyChannel a)
-oneToManyChannel = newChannel
-
-anyToManyChannel :: MonadCHP m => m (AnyToManyChannel a)
-anyToManyChannel = newChannel
-
--- | Added in version 1.2.0.
-oneToManyChannelWithLabel :: MonadCHP m => String -> m (OneToManyChannel a)
-oneToManyChannelWithLabel = newChannelWithLabel
-
--- | Added in version 1.2.0.
-anyToManyChannelWithLabel :: MonadCHP m => String -> m (AnyToManyChannel a)
-anyToManyChannelWithLabel = newChannelWithLabel
-
-
--- | The Eq instance was added in version 1.4.0.
-newtype ReduceChannel a = GC (PhasedBarrier Phase, TVar a, (a -> a -> a, a))
-
-instance Eq (ReduceChannel a) where
-  (GC (_, tvX, _)) == (GC (_, tvY, _)) = tvX == tvY
-
--- | The reading end of a reduce channel.
---
--- The Eq instance was added in version 1.4.0.
-newtype ReduceChanin a = GI (ReduceChannel a) deriving (Eq)
-
--- | The writing end of a reduce channel.  You must enroll on it before
--- you can read from it or poison it.
---
--- The Eq instance was added in version 1.4.0.
-newtype ReduceChanout a = GO (ReduceChannel a) deriving (Eq)
-
-instance Enrollable ReduceChanout a where
-  enroll c@(GO (GC (b,_,_))) f = enroll b (\eb -> waitForPhase Neutral eb >> f (Enrolled c))
-  resign (Enrolled (GO (GC (b,_,_)))) m
-    = do x <- resign (Enrolled b) m
-         waitForPhase Neutral (Enrolled b)
-         return x
-
-instance WriteableChannel (Enrolled ReduceChanout) where
-  extWriteChannel' (Enrolled (GO (GC (b, tv, (f,_))))) m
-    = do syncBarrierWith (indivRecJust ChannelWrite)
-           $ Enrolled b
-         (x, r) <- m
-         liftIO . atomically $ readTVar tv >>= writeTVar tv . f x
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         return r
-
-instance ReadableChannel ReduceChanin where
-  extReadChannel (GI (GC (b, tv, (_, empty)))) f
-    = do syncBarrierWith (indivRecJust ChannelRead)
-           $ Enrolled b
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         x <- liftIO (atomically $ readTVar tv)
-         y <- f x
-         liftIO (atomically $ writeTVar tv empty)
-         syncBarrierWith (const $ const Nothing)
-           $ Enrolled b
-         return y
-
-instance Poisonable (Enrolled ReduceChanout a) where
-  poison (Enrolled (GO (GC (b,_,_)))) = poison $ Enrolled b
-  checkForPoison (Enrolled (GO (GC (b,_,_)))) = checkForPoison $ Enrolled b
-
-instance Poisonable (ReduceChanin a) where
-  poison (GI (GC (b,_,_))) = poison $ Enrolled b
-  checkForPoison (GI (GC (b,_,_))) = checkForPoison $ Enrolled b
-
-newReduceChannel :: Monoid a => CHP (ReduceChannel a)
-newReduceChannel = dontWarnMe {- see above -} $ do
-    do b@(Barrier (e, _, _)) <- newPhasedBarrier Neutral
-       -- Writer is always enrolled:
-       liftIO $ atomically $ enrollEvent e
-       tv <- liftIO $ atomically $ newTVar mempty
-       return $ GC (b, tv, (mappend, mempty))
-
--- | The reduce channel version of sameChannel.
--- 
--- This function was added in version 1.4.0.
-sameReduceChannel :: ReduceChanin a -> ReduceChanout a -> Bool
-sameReduceChannel (GI x) (GO y) = x == y
-
-type ManyToOneChannel = Chan ReduceChanin ReduceChanout
-type ManyToAnyChannel = Chan (Shared ReduceChanin) ReduceChanout
-
-manyToOneChannel :: (Monoid a, MonadCHP m) => m (ManyToOneChannel a)
-manyToOneChannel = do
-    c@(GC (b,_,_)) <- liftCHP newReduceChannel
-    return $ Chan (getBarrierIdentifier b) (GI c) (GO c)
-
-
-manyToAnyChannel :: (Monoid a, MonadCHP m) => m (ManyToAnyChannel a)
-manyToAnyChannel = do
-    m <- newMutex
-    c <- manyToOneChannel
-    return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (writer c)
-
-manyToOneChannelWithLabel :: (Monoid a, MonadCHP m) => String -> m (ManyToOneChannel a)
-manyToOneChannelWithLabel l
-  = do c <- manyToOneChannel
-       liftCHP . liftPoison . liftTrace $ labelUnique (getChannelIdentifier c) l
-       return c
+-- | Since version 1.5.0, this module is a synonym for the "Control.Concurrent.CHP.Channels.BroadcastReduce"
+-- module, and is liable to be removed in a future version.
+module Control.Concurrent.CHP.BroadcastChannels
+  (module Control.Concurrent.CHP.Channels.BroadcastReduce) where
 
-manyToAnyChannelWithLabel :: (Monoid a, MonadCHP m) => String -> m (ManyToAnyChannel a)
-manyToAnyChannelWithLabel l
-  = do c <- manyToAnyChannel
-       liftCHP . liftPoison . liftTrace $ labelUnique (getChannelIdentifier c) l
-       return c
+import Control.Concurrent.CHP.Channels.BroadcastReduce
diff --git a/Control/Concurrent/CHP/CSP.hs b/Control/Concurrent/CHP/CSP.hs
--- a/Control/Concurrent/CHP/CSP.hs
+++ b/Control/Concurrent/CHP/CSP.hs
@@ -34,11 +34,11 @@
 
 import Control.Concurrent.STM
 import Control.Exception
-import Control.Monad.State
+import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.Trans
 import Data.List
-import Data.Maybe
+import qualified Data.Map as Map
 import Data.Unique
 import System.IO
 
@@ -47,41 +47,43 @@
 import qualified Control.Concurrent.CHP.Event as Event
 import Control.Concurrent.CHP.Enroll
 import Control.Concurrent.CHP.Guard
-import Control.Concurrent.CHP.Mutex
 import Control.Concurrent.CHP.Traces.Base
 
 -- First engages in event, then executes the body.  The returned value is suitable
 -- for use in an alt
-buildOnEventPoison :: (Unique -> (Unique -> Integer) -> Maybe (RecordedIndivEvent Unique)) -> Event.Event -> EventActions -> CHP a -> CHP a
+buildOnEventPoison :: (Unique -> (Unique -> (Integer, Event.RecordedEventType)) -> [RecordedIndivEvent Unique]) -> Event.Event -> EventActions -> CHP a -> CHP a
 buildOnEventPoison rec e act body
   = liftPoison (AltableT (Right [(theGuard, return True)])
                    (return False))
     >>= \b -> if b then body else
       alt [liftPoison $ AltableT (Right [(theGuard, return ())]) (return ())] >> body
     where
-      theGuard = EventGuard (maybeToList . rec (Event.getEventUnique e)) act [e]
+      theGuard = EventGuard (rec (Event.getEventUnique e)) act [e]
 
 scopeBlock :: CHP a -> (a -> CHP b) -> IO () -> CHP b
 scopeBlock start body errorEnd
     = do x <- start
-         tr <- liftPoison $ liftTrace get
-         (y, tr') <- liftIO $ bracketOnError (return ()) (const errorEnd) $ const
-           $ runStateT (pullOutStandard (wrapPoison $ body x)) tr
-         liftPoison $ liftTrace $ put tr'
+         tr <- liftPoison $ liftTrace ask
+         y <- liftIO $ bracketOnError (return ()) (const errorEnd) $ const
+           $ runReaderT (pullOutStandard (wrapPoison $ body x)) tr
          checkPoison y
 
+wrapIndiv :: (Unique -> (Unique -> Integer) -> String -> [RecordedIndivEvent Unique])
+          -> Unique -> (Unique -> (Integer, Event.RecordedEventType))
+          -> [RecordedIndivEvent Unique]
+wrapIndiv rec u lu = rec u (fst . lu) (Event.getEventTypeVal $ snd $ lu u)
 
 -- | Synchronises on the given barrier.  You must be enrolled on a barrier in order
 -- to synchronise on it.  Returns the new phase, following the synchronisation.
-syncBarrierWith :: (Unique -> (Unique -> Integer) -> Maybe (RecordedIndivEvent Unique))
-  -> Enrolled PhasedBarrier phase -> CHP phase
-syncBarrierWith rec (Enrolled (Barrier (e,tv, fph)))
-    = buildOnEventPoison rec e (EventActions incPhase (return ()))
+syncBarrierWith :: (Unique -> (Unique -> Integer) -> String -> [RecordedIndivEvent Unique])
+  -> (Int -> STM ()) -> Enrolled PhasedBarrier phase -> CHP phase
+syncBarrierWith rec storeN (Enrolled (Barrier (e,tv, fph)))
+    = buildOnEventPoison (wrapIndiv rec) e (EventActions incPhase (return ()))
         (liftIO $ atomically $ readTVar tv)
     where
-      incPhase :: STM ()
-      incPhase = do p <- readTVar tv
-                    writeTVar tv $ fph p
+      incPhase :: Map.Map Unique Int -> STM ()
+      incPhase m = do readTVar tv >>= writeTVar tv . fph
+                      maybe (return ()) storeN $ Map.lookup (Event.getEventUnique e) m
 
 -- | A phased barrier that is capable of being poisoned and throwing poison.
 --  You will need to enroll on it to do anything useful with it.
@@ -113,37 +115,23 @@
     = do liftSTM (Event.enrollEvent e) >>= checkPoison
          x <- f $ Enrolled b
          liftSTM (Event.resignEvent e) >>= checkPoison >>= (\es ->
-           do tr <- liftPoison $ liftTrace get
+           do tr <- liftPoison $ liftTrace ask
               when (not $ null es) $ liftSTM $ recordEventLast (nub es) tr)
          return x
 
   resign (Enrolled (Barrier (e, _, _))) m
     = do liftSTM (Event.resignEvent e) >>= checkPoison >>= (\es ->
-           do tr <- liftPoison $ liftTrace get
+           do tr <- liftPoison $ liftTrace ask
               when (not $ null es) $ liftSTM $ recordEventLast (nub es) tr)
          x <- m
          liftSTM (Event.enrollEvent e) >>= checkPoison
          return x
 
-
--- | A channel type, that can be used to get the ends of the channel via 'reader'
--- and 'writer'
-data Chan r w a = Chan {
-  -- | Gets the channel's identifier.  Useful if you need to be able to identify
-  -- a channel in the trace later on.
-  getChannelIdentifier :: Unique,
-  -- | Gets the reading end of a channel from its 'Chan' type.
-  reader :: r a,
-  -- | Gets the writing end of a channel from its 'Chan' type.
-  writer :: w a}
-
 instance Poisonable (Enrolled PhasedBarrier phase) where
   poison (Enrolled (Barrier (e, _, _)))
     = liftSTM $ Event.poisonEvent e
   checkForPoison (Enrolled (Barrier (e, _, _)))
     = liftCHP $ liftSTM (Event.checkEventForPoison e) >>= checkPoison
 
--- | A wrapper (usually around a channel-end) indicating that the inner item
--- is shared.  Use the 'claim' function to use this type.
-data Shared c a = Shared (Mutex, c a)
+
 
diff --git a/Control/Concurrent/CHP/Channels.hs b/Control/Concurrent/CHP/Channels.hs
--- a/Control/Concurrent/CHP/Channels.hs
+++ b/Control/Concurrent/CHP/Channels.hs
@@ -1,5 +1,5 @@
 -- Communicating Haskell Processes.
--- Copyright (c) 2008, University of Kent.
+-- Copyright (c) 2008--2009, University of Kent.
 -- All rights reserved.
 -- 
 -- Redistribution and use in source and binary forms, with or without
@@ -28,483 +28,65 @@
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
--- | The module containing all the different types of channels in CHP.  Unlike
--- JCSP and C++CSP2, CHP does not offer buffered channels directly (see the
--- "Control.Concurrent.CHP.Buffers" module).  There are four different channel types, effectively
--- all possible combinations of:
+-- | The module containing all the different types of channels in CHP.
+-- 
+-- A communication in CHP is always synchronised: the writer must wait until the
+-- reader arrives to take the data.  There is thus no automatic or underlying buffering
+-- of data.  (If you want to use buffers, see the "Control.Concurrent.CHP.Buffers"
+-- module).
 --
--- * Shared reader vs non-shared reader
+-- If it helps, a channel communication can be thought of as a distributed binding.
+--  Imagine you have a process that creates a channel and then becomes the parallel
+-- composition of two sub-processes that at some point communicate on that channel
+-- (formatted here as two columns for illustration):
 --
--- * Shared writer vs non-shared writer
+-- > do                      c <- oneToOneChannel
+-- >                                    (<||>)
+-- >    do p                                   do p'
+-- >       q                                      y <- q'
+-- >       x <- readChannel (reader c)            writeChannel (writer c) y
+-- >       r                                      r'
+-- >       s x                                    s'
 --
--- For most applications you probably want just 'OneToOneChannel'.
+-- It is as if, at the point where the two processes want to communicate, they come
+-- together and directly bind the value from one process in the other:
+-- 
+-- > do                      c <- oneToOneChannel
+-- >                                    (<||>)
+-- >    do p                                   do p'
+-- >       q                                      y <- q'
+-- >       x                            <-        return y
+-- >       r                                      r'
+-- >       s x                                    s'
 --
--- It is possible for the type system to infer which channel you want when
--- you use 'newChannel'.  If the types of the ends are known by the type system,
--- the channel-type can be inferred.  So you can usually just write 'newChannel',
--- and depending on how you use the channel, the type system will figure out
--- which one you needed.
+-- The "Control.Concurrent.CHP.Channels.Creation" contains functions relating to
+-- the creation of channels.  Channels are used via their ends -- see the "Control.Concurrent.CHP.Channels.Ends"
+-- module, and the "Control.Concurrent.CHP.Channels.Communication" module.
+--
+-- Broadcast and reduce channels are available in the "Control.Concurrent.CHP.Channels.BroadcastReduce"
+-- module, which is not automatically re-exported here.
+-- 
+-- This module was split into several smaller modules in version 1.5.0.  Since
+-- it re-exports all the new modules, your code should not be affected at all.
 module Control.Concurrent.CHP.Channels (
-  -- * Channel Creation
-  Chan, Channel(..), writeChannelStrict, newChannelWithLabel, newChannelWR, newChannelRW, ChannelTuple(..),
-  newChannelList, newChannelListWithLabels, newChannelListWithStem,
+  -- * Channel Creation and Types
+  module Control.Concurrent.CHP.Channels.Creation,
   getChannelIdentifier,
   -- * Channel-Ends
-  Chanin, Chanout,
-  reader, writer, readers, writers,
+  module Control.Concurrent.CHP.Channels.Ends,
 
   -- * Reading and Writing with Channels
-  ReadableChannel(..), WriteableChannel(..), 
+  module Control.Concurrent.CHP.Channels.Communication,
 
-  -- * Shared Channels
-  claim, Shared,
+  -- * Useful Type and Function Synonyms
+  module Control.Concurrent.CHP.Channels.Synonyms
 
-  -- * Specific Channel Types
-  -- | All the functions here are equivalent to newChannel (or newChannelWithLabel), but typed.  So for
-  -- example, @oneToOneChannel = newChannel :: MonadCHP m => m OneToOneChannel@.
-  OneToOneChannel, oneToOneChannel, oneToOneChannelWithLabel,
-  OneToAnyChannel, oneToAnyChannel, oneToAnyChannelWithLabel,
-  AnyToOneChannel, anyToOneChannel, anyToOneChannelWithLabel,
-  AnyToAnyChannel, anyToAnyChannel, anyToAnyChannelWithLabel
   )
   where
 
 
-import Control.Concurrent.STM.TVar
-import Control.Monad
-import Control.Monad.STM
-import Control.Monad.Trans
-import Control.Parallel.Strategies
-import Data.Maybe
-import Data.Monoid
-import Data.Unique
-
-import Control.Concurrent.CHP.Base
-import Control.Concurrent.CHP.CSP
-import Control.Concurrent.CHP.Event
-import Control.Concurrent.CHP.Guard
-import Control.Concurrent.CHP.Monad
-import Control.Concurrent.CHP.Mutex
-import Control.Concurrent.CHP.Poison
-import Control.Concurrent.CHP.Traces.Base
-
--- ======
--- Types:
--- ======
-
--- | A reading channel-end type that allows poison to be thrown
---
--- Eq instance added in version 1.1.1
-newtype Chanin a = Chanin (STMChannel a) deriving Eq
-
--- | A writing channel-end type that allows poison to be thrown
---
--- Eq instance added in version 1.1.1
-newtype Chanout a = Chanout (STMChannel a) deriving Eq
-
-newtype STMChannel a = STMChan (Event, TVar (WithPoison (Maybe a, Maybe ()))) deriving
-  Eq
-
-type OneToOneChannel = Chan Chanin Chanout
-type AnyToOneChannel = Chan (Chanin) (Shared Chanout)
-type OneToAnyChannel = Chan (Shared Chanin) (Chanout)
-type AnyToAnyChannel = Chan (Shared Chanin) (Shared Chanout)
-
--- ========
--- Classes:
--- ========
-
-class ChaninC c a where
-  -- Start gets the event and the transaction that will wait for data.  You
-  -- sync on the event (possible extended write occurs) then wait for data
-  startReadChannelC :: c a -> (Event, STM (WithPoison a))
-  -- (extended read action goes here)
-  -- Read releases the writer
-  endReadChannelC :: c a -> STM (WithPoison ())
-
-  -- First action is to be done as part of the completion:
-  readChannelC :: c a -> (Event, STM (), STM (WithPoison a))
-
-  poisonReadC :: c a -> IO ()
-  checkPoisonReadC :: c a -> IO (WithPoison ())
-
-class ChanoutC c a where
-  -- Start checks for poison and gets the event:
-  startWriteChannelC :: c a -> (Event, STM (WithPoison ()))
-  -- (extended write action goes here)
-  -- Send actually transmits the value:
-  sendWriteChannelC :: c a -> a -> STM (WithPoison ())
-  -- (extended read action goes here)
-  -- End waits for the reader to tell us we're done, must be done in a different
-  -- transaction to the send
-  endWriteChannelC :: c a -> STM (WithPoison ())
-
-  -- First action is to be done as part of the completion:
-  writeChannelC :: c a -> a -> (Event, STM (), STM (WithPoison ()))
-  
-  poisonWriteC :: c a -> IO ()
-  checkPoisonWriteC :: c a -> IO (WithPoison ())
-
--- | A class used for allocating new channels, and getting the reading and
--- writing ends.  There is a bijective assocation between the channel, and
--- its pair of end types.  You can see the types in the list of instances below.
--- Thus, 'newChannel' may be used, and the compiler will infer which type of
--- channel is required based on what end-types you get from 'reader' and 'writer'.
--- Alternatively, if you explicitly type the return of 'newChannel', it will
--- be definite which ends you will use.  If you do want to fix the type of
--- the channel you are using when you allocate it, consider using one of the
--- many 'oneToOneChannel'-like shorthand functions that fix the type.
-class Channel r w where
-  -- | Allocates a new channel.  Nothing need be done to
-  -- destroy\/de-allocate the channel when it is no longer in use.
-  newChannel :: MonadCHP m => m (Chan r w a)
-
-  -- | Determines if two channel-ends refer to the same channel.
-  --
-  -- This function was added in version 1.4.0.
-  sameChannel :: r a -> w a -> Bool
-
--- | A class indicating that a channel can be read from.
-class ReadableChannel chanEnd where -- minimal implementation: extReadChannel
-  -- | Reads from the given reading channel-end
-  readChannel :: chanEnd a -> CHP a
-  readChannel c = extReadChannel c return
-  -- | Performs an extended read from the channel, performing the given action
-  -- before freeing the writer
-  extReadChannel :: chanEnd a -> (a -> CHP b) -> CHP b
-
--- | A class indicating that a channel can be written to.
-class WriteableChannel chanEnd where -- minimal implementation: extWriteChannel
-  -- | Writes from the given writing channel-end
-  writeChannel :: chanEnd a -> a -> CHP ()
-  writeChannel c x = extWriteChannel c (return x) >> return ()
-
-  -- | Starts the communication, then performs the given extended action, then
-  -- sends the result of that down the channel.
-  extWriteChannel :: chanEnd a -> CHP a -> CHP ()
-  extWriteChannel c m = extWriteChannel' c (liftM (flip (,) ()) m)
-
-  -- | Like extWriteChannel, but allows a value to be returned from the inner action.
-  --
-  -- This function was added in version 1.4.0.
-  extWriteChannel' :: chanEnd a -> CHP (a, b) -> CHP b
-  
-
--- | A helper class for easily creating several channels of the same type.
---  The same type refers not only to what type the channel carries, but
---  also to the type of channel (one-to-one no poison, one-to-any with
---  poison, etc).  You can write code like this:
---
--- > (a, b, c, d, e) <- newChannels
---
--- To create five channels of the same type.
-class ChannelTuple t where
-  newChannels :: MonadCHP m => m t
-
--- ==========
--- Functions: 
--- ==========
-
--- | A helper function that uses the parallel strategies library (see the
--- paper: \"Algorithm + Strategy = Parallelism\", P.W. Trinder et al, JFP
--- 8(1) 1998,
--- <http://www.macs.hw.ac.uk/~dsg/gph/papers/html/Strategies/strategies.html>)
--- to make sure that the value sent down a channel is strictly evaluated
--- by the sender before transmission.
---
--- This is useful when you want to write worker processes that evaluate data
---  and send it back to some \"harvester\" process.  By default the values sent
--- back may be unevaluated, and thus the harvester might end up doing the evaluation.
---  If you use this function, the value is guaranteed to be completely evaluated
--- before sending.
---
--- Added in version 1.0.2.
-writeChannelStrict :: (NFData a, WriteableChannel chanEnd) => chanEnd a -> a -> CHP ()
-writeChannelStrict c x = (writeChannel c $| rnf) x
-
-chan :: Monad m => m (Unique, c a) -> (c a -> r a) -> (c a -> w a) -> m (Chan r w a)
-chan m r w = do (u, x) <- m
-                return $ Chan u (r x) (w x)
-
--- | Like 'newChannel' but also associates a label with that channel in a
--- trace.  You can use this function whether tracing is turned on or not,
--- so if you ever use tracing, you should use this rather than 'newChannel'.
-newChannelWithLabel :: (Channel r w, MonadCHP m) => String -> m (Chan r w a)
-newChannelWithLabel l
-  = do c <- newChannel
-       liftCHP . liftPoison . liftTrace $ labelUnique (getChannelIdentifier c) l
-       return c
-
-
--- | A helper that is like 'newChannel' but returns the reading and writing
--- end of the channels directly.
-newChannelRW :: (Channel r w, MonadCHP m) => m (r a, w a)
-newChannelRW = do c <- newChannel
-                  return (reader c, writer c)
-
--- | A helper that is like 'newChannel' but returns the writing and reading
--- end of the channels directly.
-newChannelWR :: (Channel r w, MonadCHP m) => m (w a, r a)
-newChannelWR = do c <- newChannel
-                  return (writer c, reader c)
-
--- | Creates a list of channels of the same type with the given length.  If
--- you need to access some channels by index, use this function.  Otherwise
--- you may find using 'newChannels' to be easier.
-newChannelList :: (Channel r w, MonadCHP m) => Int -> m [Chan r w a]
-newChannelList n = replicateM n newChannel
-
--- | A helper that is like 'newChannelList', but labels the channels according
--- to a pattern.  Given a stem such as foo, it names the channels in the list
--- foo0, foo1, foo2, etc.
-newChannelListWithStem :: (Channel r w, MonadCHP m) => Int -> String -> m [Chan r w a]
-newChannelListWithStem n s = sequence [newChannelWithLabel (s ++ show i) | i <- [0 .. (n - 1)]]
-
--- | A helper that is like 'newChannelList', but labels the channels with the
--- given list.  The number of channels returned is the same as the length of
--- the list of labels
-newChannelListWithLabels :: (Channel r w, MonadCHP m) => [String] -> m [Chan r w a]
-newChannelListWithLabels = mapM newChannelWithLabel
-
--- | Gets all the reading ends of a list of channels.  A shorthand for @map
--- reader@.
-readers :: [Chan r w a] -> [r a]
-readers = map reader
-
--- | Gets all the writing ends of a list of channels.  A shorthand for @map
--- writer@.
-writers :: [Chan r w a] -> [w a]
-writers = map writer
-
-stmChannel :: MonadIO m => m (Unique, STMChannel a)
-stmChannel = liftIO $
-  do e <- newEvent ChannelComm 2
-     c <- atomically $ newTVar $ NoPoison (Nothing, Nothing)
-     return (getEventUnique e, STMChan (e,c))
-
--- | A type-constrained version of newChannel.
-oneToOneChannel :: MonadCHP m => m (OneToOneChannel a)
-oneToOneChannel = newChannel
-
--- | A type-constrained version of newChannelWithLabel.
---
--- Added in version 1.2.0.
-oneToOneChannelWithLabel :: MonadCHP m => String -> m (OneToOneChannel a)
-oneToOneChannelWithLabel = newChannelWithLabel
-
-
--- | Claims the given channel-end, executes the given block, then releases
--- the channel-end and returns the output value.  If poison or an IO
--- exception is thrown inside the block, the channel is released and the
--- poison\/exception re-thrown.
-claim :: Shared c a -> (c a -> CHP b) -> CHP b
-claim (Shared (lock, c)) body
-  = scopeBlock
-       (claimMutex lock >> return c)
-       (\y -> do x <- body y
-                 liftIO $ releaseMutex lock
-                 return x)
-       (releaseMutex lock)
-
--- | A type-constrained version of newChannel.
-anyToOneChannel :: MonadCHP m => m (AnyToOneChannel a)
-anyToOneChannel = newChannel
-
--- | A type-constrained version of newChannel.
-oneToAnyChannel :: MonadCHP m => m (OneToAnyChannel a)
-oneToAnyChannel = newChannel
-
--- | A type-constrained version of newChannel.
-anyToAnyChannel :: MonadCHP m => m (AnyToAnyChannel a)
-anyToAnyChannel = newChannel
-
--- | A type-constrained version of newChannelWithLabel.
---
--- Added in version 1.2.0.
-anyToOneChannelWithLabel :: MonadCHP m => String -> m (AnyToOneChannel a)
-anyToOneChannelWithLabel = newChannelWithLabel
-
--- | A type-constrained version of newChannelWithLabel.
---
--- Added in version 1.2.0.
-oneToAnyChannelWithLabel :: MonadCHP m => String -> m (OneToAnyChannel a)
-oneToAnyChannelWithLabel = newChannelWithLabel
-
--- | A type-constrained version of newChannelWithLabel.
---
--- Added in version 1.2.0.
-anyToAnyChannelWithLabel :: MonadCHP m => String -> m (AnyToAnyChannel a)
-anyToAnyChannelWithLabel = newChannelWithLabel
-
--- ==========
--- Instances: 
--- ==========
-
-instance ReadableChannel Chanin where
-  readChannel (Chanin c)
-    = let (e, mdur, mafter) = readChannelC c in
-      buildOnEventPoison (indivRecJust ChannelRead) e
-        (EventActions (return ()) mdur)
-        (liftSTM mafter) >>= checkPoison
-
-  extReadChannel (Chanin c) body
-    = let (e, m) = startReadChannelC c in
-      scopeBlock
-        (buildOnEventPoison (indivRecJust ChannelRead) e mempty (liftSTM m) >>= checkPoison)
-        (\val -> do x <- body val
-                    liftSTM $ endReadChannelC c
-                    return x)
-        (poisonReadC c)
-
-instance WriteableChannel Chanout where
-  writeChannel (Chanout c) x
-    = let (e, mdur, mafter) = writeChannelC c x in
-        buildOnEventPoison (indivRecJust ChannelWrite) e
-          (EventActions (return ()) mdur) (liftSTM mafter)
-        >>= checkPoison
-  extWriteChannel' (Chanout c) body
-    = let (e, m) = startWriteChannelC c in
-      scopeBlock
-        (buildOnEventPoison (indivRecJust ChannelWrite)
-          e mempty (liftSTM m) >>= checkPoison)
-        (const $ do (x, r) <- body
-                    sequence [liftSTM $ sendWriteChannelC c x
-                             ,liftSTM (endWriteChannelC c)]
-                      >>= checkPoison . mergeWithPoison
-                    return r)
-        (poisonWriteC c)
-        
-
-instance Poisonable (Chanin a) where
-  poison (Chanin c) = liftIO $ poisonReadC c
-  checkForPoison (Chanin c) = liftCHP $ liftIO (checkPoisonReadC c) >>= checkPoison
-
-instance Poisonable (Chanout a) where
-  poison (Chanout c) = liftIO $ poisonWriteC c
-  checkForPoison (Chanout c) = liftCHP $ liftIO (checkPoisonWriteC c) >>= checkPoison
-
-instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a) where
-  newChannels = do c0 <- newChannel
-                   c1 <- newChannel
-                   return (c0, c1)
-
-instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a) where
-  newChannels = do c0 <- newChannel
-                   c1 <- newChannel
-                   c2 <- newChannel
-                   return (c0, c1, c2)
-
-instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
-  Chan r w a) where
-  newChannels = do c0 <- newChannel
-                   c1 <- newChannel
-                   c2 <- newChannel
-                   c3 <- newChannel
-                   return (c0, c1, c2, c3)
-
-instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
-  Chan r w a, Chan r w a) where
-  newChannels = do c0 <- newChannel
-                   c1 <- newChannel
-                   c2 <- newChannel
-                   c3 <- newChannel
-                   c4 <- newChannel
-                   return (c0, c1, c2, c3, c4)
-
-instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
-  Chan r w a, Chan r w a, Chan r w a) where
-  newChannels = do c0 <- newChannel
-                   c1 <- newChannel
-                   c2 <- newChannel
-                   c3 <- newChannel
-                   c4 <- newChannel
-                   c5 <- newChannel
-                   return (c0, c1, c2, c3, c4, c5)
-
--- Some of this is defensive programming -- the writer should never be able
--- to discover poison in the channel variable, for example
-
-consumeData :: TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison a)
-consumeData tv = do d <- readTVar tv
-                    case d of
-                      PoisonItem -> return PoisonItem
-                      NoPoison (Nothing, _) -> retry
-                      NoPoison (Just x, a) -> do writeTVar tv $ NoPoison (Nothing, a)
-                                                 return $ NoPoison x
-
-sendData :: TVar (WithPoison (Maybe a, Maybe ())) -> a -> STM (WithPoison ())
-sendData tv x  = do y <- readTVar tv
-                    case y of
-                      PoisonItem -> return PoisonItem
-                      NoPoison (Just _, _) -> error "CHP: Found data while sending data"
-                      NoPoison (Nothing, a) -> do writeTVar tv $ NoPoison (Just x, a)
-                                                  return $ NoPoison ()
-
-consumeAck :: TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison ())
-consumeAck tv = do d <- readTVar tv
-                   case d of
-                      PoisonItem -> return PoisonItem
-                      NoPoison (_, Nothing) -> retry
-                      NoPoison (x, Just _) -> do writeTVar tv $ NoPoison (x, Nothing)
-                                                 return $ NoPoison ()
-
-sendAck ::  TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison ())
-sendAck tv =    do d <- readTVar tv
-                   case d of
-                      PoisonItem -> return PoisonItem
-                      NoPoison (_, Just _) -> error "CHP: Found ack while placing ack!"
-                      NoPoison (x, Nothing) -> do writeTVar tv $ NoPoison (x, Just ())
-                                                  return $ NoPoison ()
-
-instance ChaninC STMChannel a where
-  startReadChannelC (STMChan (e,tv)) = (e, consumeData tv)
-  endReadChannelC (STMChan (_,tv)) = sendAck tv
-  readChannelC (STMChan (e, tv))
-    = (e, sendAck tv >> return (), consumeData tv)
-
-  poisonReadC (STMChan (e,tv))
-    = liftSTM $ do poisonEvent e
-                   writeTVar tv PoisonItem
-  checkPoisonReadC (STMChan (e,_)) = liftSTM $ checkEventForPoison e
-
-instance ChanoutC STMChannel a where
-  startWriteChannelC (STMChan (e,tv))
-    = (e, do x <- readTVar tv
-             case x of
-               PoisonItem -> return PoisonItem
-               NoPoison _ -> return $ NoPoison ())
-  sendWriteChannelC (STMChan (_, tv)) val
-    = sendData tv val
-  endWriteChannelC (STMChan (_, tv))
-    = consumeAck tv
-
-  writeChannelC (STMChan (e, tv)) val
-    = (e, sendData tv val >> return (), consumeAck tv)
-
-  poisonWriteC (STMChan (e,tv))
-    = liftSTM $ do poisonEvent e
-                   writeTVar tv PoisonItem
-  checkPoisonWriteC (STMChan (e,_)) = liftSTM $ checkEventForPoison e
-
-instance Channel Chanin Chanout where
-  newChannel = chan stmChannel Chanin Chanout
-  sameChannel (Chanin x) (Chanout y) = x == y
-
-instance Channel (Shared Chanin) Chanout where
-  newChannel = do m <- newMutex
-                  c <- newChannel
-                  return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (writer c)
-  sameChannel (Shared (_, Chanin x)) (Chanout y) = x == y
-
-instance Channel Chanin (Shared Chanout) where
-  newChannel = do m <- newMutex
-                  c <- newChannel
-                  return $ Chan (getChannelIdentifier c) (reader c) (Shared (m, writer c))
-  sameChannel (Chanin x) (Shared (_, Chanout y)) = x == y
-
-instance Channel (Shared Chanin) (Shared Chanout) where
-  newChannel = do m <- newMutex
-                  m' <- newMutex
-                  c <- newChannel
-                  return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (Shared (m', writer c))
-  sameChannel (Shared (_, Chanin x)) (Shared (_, Chanout y)) = x == y
+import Control.Concurrent.CHP.Channels.Base
+import Control.Concurrent.CHP.Channels.Communication
+import Control.Concurrent.CHP.Channels.Creation
+import Control.Concurrent.CHP.Channels.Ends
+import Control.Concurrent.CHP.Channels.Synonyms
diff --git a/Control/Concurrent/CHP/Channels/Base.hs b/Control/Concurrent/CHP/Channels/Base.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/Base.hs
@@ -0,0 +1,183 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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.
+
+module Control.Concurrent.CHP.Channels.Base where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Trans
+import Data.Unique (Unique)
+
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.Event
+import Control.Concurrent.CHP.Poison
+
+
+-- | A reading channel-end type.
+--
+-- See 'reader' to obtain one, and 'ReadableChannel' for how to use one.
+--
+-- Eq instance added in version 1.1.1
+newtype Chanin a = Chanin (STMChannel a) deriving Eq
+
+-- | A writing channel-end type.
+--
+-- See 'writer' to obtain one, and 'WritableChannel' for how to use one.
+-- 
+-- Eq instance added in version 1.1.1
+newtype Chanout a = Chanout (STMChannel a) deriving Eq
+
+newtype STMChannel a = STMChan (Event, TVar (WithPoison (Maybe a, Maybe ())))
+  deriving Eq
+
+-- | A channel type, that can be used to get the ends of the channel via 'reader'
+-- and 'writer'
+data Chan r w a = Chan {
+  -- | Gets the channel's identifier.  Useful if you need to be able to identify
+  -- a channel in the trace later on.
+  getChannelIdentifier :: Unique,
+  -- | Gets the reading end of a channel from its 'Chan' type.
+  reader :: r a,
+  -- | Gets the writing end of a channel from its 'Chan' type.
+  writer :: w a}
+
+
+class ChaninC c a where
+  -- Start gets the event and the transaction that will wait for data.  You
+  -- sync on the event (possible extended write occurs) then wait for data
+  startReadChannelC :: c a -> (Event, STM (WithPoison a))
+  -- (extended read action goes here)
+  -- Read releases the writer
+  endReadChannelC :: c a -> STM (WithPoison ())
+
+  -- First action is to be done as part of the completion:
+  readChannelC :: c a -> (Event, STM (), STM (WithPoison a))
+
+  poisonReadC :: c a -> IO ()
+  checkPoisonReadC :: c a -> IO (WithPoison ())
+
+class ChanoutC c a where
+  -- Start checks for poison and gets the event:
+  startWriteChannelC :: c a -> (Event, STM (WithPoison ()))
+  -- (extended write action goes here)
+  -- Send actually transmits the value:
+  sendWriteChannelC :: c a -> a -> STM (WithPoison ())
+  -- (extended read action goes here)
+  -- End waits for the reader to tell us we're done, must be done in a different
+  -- transaction to the send
+  endWriteChannelC :: c a -> STM (WithPoison ())
+
+  -- First action is to be done as part of the completion:
+  writeChannelC :: c a -> a -> (Event, STM (), STM (WithPoison ()))
+  
+  poisonWriteC :: c a -> IO ()
+  checkPoisonWriteC :: c a -> IO (WithPoison ())
+
+instance Poisonable (Chanin a) where
+  poison (Chanin c) = liftIO $ poisonReadC c
+  checkForPoison (Chanin c) = liftCHP $ liftIO (checkPoisonReadC c) >>= checkPoison
+
+instance Poisonable (Chanout a) where
+  poison (Chanout c) = liftIO $ poisonWriteC c
+  checkForPoison (Chanout c) = liftCHP $ liftIO (checkPoisonWriteC c) >>= checkPoison
+
+
+stmChannel :: MonadIO m => (a -> String) -> m (Unique, STMChannel a)
+stmChannel sh = liftIO $
+  do c <- atomically $ newTVar $ NoPoison (Nothing, Nothing)
+     e <- newEvent (liftM (ChannelComm . maybe "" sh . getVal) $ readTVar c) 2
+     return (getEventUnique e, STMChan (e,c))
+  where
+    getVal PoisonItem = Nothing
+    getVal (NoPoison (x, _)) = x
+
+-- Some of this is defensive programming -- the writer should never be able
+-- to discover poison in the channel variable, for example
+
+consumeData :: TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison a)
+consumeData tv = do d <- readTVar tv
+                    case d of
+                      PoisonItem -> return PoisonItem
+                      NoPoison (Nothing, _) -> retry
+                      NoPoison (Just x, a) -> do writeTVar tv $ NoPoison (Nothing, a)
+                                                 return $ NoPoison x
+
+sendData :: TVar (WithPoison (Maybe a, Maybe ())) -> a -> STM (WithPoison ())
+sendData tv x  = do y <- readTVar tv
+                    case y of
+                      PoisonItem -> return PoisonItem
+                      NoPoison (Just _, _) -> error "CHP: Found data while sending data"
+                      NoPoison (Nothing, a) -> do writeTVar tv $ NoPoison (Just x, a)
+                                                  return $ NoPoison ()
+
+consumeAck :: TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison ())
+consumeAck tv = do d <- readTVar tv
+                   case d of
+                      PoisonItem -> return PoisonItem
+                      NoPoison (_, Nothing) -> retry
+                      NoPoison (x, Just _) -> do writeTVar tv $ NoPoison (x, Nothing)
+                                                 return $ NoPoison ()
+
+sendAck ::  TVar (WithPoison (Maybe a, Maybe ())) -> STM (WithPoison ())
+sendAck tv =    do d <- readTVar tv
+                   case d of
+                      PoisonItem -> return PoisonItem
+                      NoPoison (_, Just _) -> error "CHP: Found ack while placing ack!"
+                      NoPoison (x, Nothing) -> do writeTVar tv $ NoPoison (x, Just ())
+                                                  return $ NoPoison ()
+
+instance ChaninC STMChannel a where
+  startReadChannelC (STMChan (e,tv)) = (e, consumeData tv)
+  endReadChannelC (STMChan (_,tv)) = sendAck tv
+  readChannelC (STMChan (e, tv))
+    = (e, sendAck tv >> return (), consumeData tv)
+
+  poisonReadC (STMChan (e,tv))
+    = liftSTM $ do poisonEvent e
+                   writeTVar tv PoisonItem
+  checkPoisonReadC (STMChan (e,_)) = liftSTM $ checkEventForPoison e
+
+instance ChanoutC STMChannel a where
+  startWriteChannelC (STMChan (e,tv))
+    = (e, do x <- readTVar tv
+             case x of
+               PoisonItem -> return PoisonItem
+               NoPoison _ -> return $ NoPoison ())
+  sendWriteChannelC (STMChan (_, tv)) val
+    = sendData tv val
+  endWriteChannelC (STMChan (_, tv))
+    = consumeAck tv
+
+  writeChannelC (STMChan (e, tv)) val
+    = (e, sendData tv val >> return (), consumeAck tv)
+
+  poisonWriteC (STMChan (e,tv))
+    = liftSTM $ do poisonEvent e
+                   writeTVar tv PoisonItem
+  checkPoisonWriteC (STMChan (e,_)) = liftSTM $ checkEventForPoison e
diff --git a/Control/Concurrent/CHP/Channels/BroadcastReduce.hs b/Control/Concurrent/CHP/Channels/BroadcastReduce.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/BroadcastReduce.hs
@@ -0,0 +1,280 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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 broadcast channels (one-to-many).  Whereas a one-to-any
+-- channel features one writer sending a /single/ value to /one/ (of many) readers, a
+-- one-to-many channel features one writer sending the /same/ value to /many/
+-- readers.  So a one-to-any channel involves claiming the channel-end to ensure
+-- exclusivity, but a one-to-many channel involves enrolling on the channel-end
+-- (subscribing) before it can engage in communication.
+--
+-- 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).
+--
+-- 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
+-- type-class.  It is important to be aware that the order of mappends will be
+-- non-deterministic, and thus you should either use an mappend that is commutative
+-- or code around this restruction.
+--
+-- For example, a common thing to do would be to use lists as the type for
+-- reduce channels, make each writer write a single item list (but more is
+-- possible), then use the list afterwards, but be aware that it is unordered.
+--  If it is important to have an ordered list, make each writer write a pair
+-- containing a (unique) index value and the real data, then sort by the index
+-- value and discard it.
+--
+-- Since reduce channels were added after the initial library design, there
+-- is a slight complication: it is not possible to use newChannel (and all
+-- similar functions) with reduce channels because it is impossible to express
+-- the Monoid constraint for the Channel instance.  Instead, you must use manyToOneChannel
+-- and manyToAnyChannel.
+module Control.Concurrent.CHP.Channels.BroadcastReduce (BroadcastChanin, BroadcastChanout,
+  OneToManyChannel, AnyToManyChannel, oneToManyChannel, anyToManyChannel,
+    oneToManyChannel', anyToManyChannel', ReduceChanin,
+    ReduceChanout, sameReduceChannel, ManyToOneChannel, ManyToAnyChannel, manyToOneChannel,
+    manyToAnyChannel, manyToOneChannel', manyToAnyChannel')
+      where
+
+import Control.Arrow
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Trans
+import Data.Monoid
+
+import Control.Concurrent.CHP.Barriers
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.Channels
+import Control.Concurrent.CHP.Channels.Base
+import Control.Concurrent.CHP.CSP
+import Control.Concurrent.CHP.Enroll
+import Control.Concurrent.CHP.Event
+import Control.Concurrent.CHP.Mutex
+import Control.Concurrent.CHP.Traces.Base
+
+-- | 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 the traces.
+newtype BroadcastChannel a = BC (Barrier, TVar (Maybe a), ManyToOneTVar Int)
+
+instance Eq (BroadcastChannel a) where
+  (BC (_, tvX, _)) == (BC (_, tvY, _)) = tvX == tvY
+
+-- | The reading end of a broadcast channel.  You must enroll on it before
+-- you can read from it or poison it.
+-- 
+-- The Eq instance was added in version 1.4.0.
+newtype BroadcastChanin a = BI (BroadcastChannel a) deriving (Eq)
+
+-- | The writing end of a broadcast channel.
+-- 
+-- The Eq instance was added in version 1.4.0.
+newtype BroadcastChanout a = BO (BroadcastChannel a) deriving (Eq)
+
+instance Enrollable BroadcastChanin a where
+  enroll c@(BI (BC (b,_,_))) f = enroll b (const $ f (Enrolled c))
+  resign (Enrolled (BI (BC (b,_,_)))) m
+    = resign (Enrolled b) m
+
+instance WriteableChannel BroadcastChanout where
+  extWriteChannel' (BO (BC (b, tvSend, tvAck))) m
+    = do syncBarrierWith (indivRecJust ChannelWrite)
+           (resetManyToOneTVar tvAck . pred) $ Enrolled b
+           -- subtract one for writer
+         (x, r) <- m
+         liftIO . atomically $ writeTVar tvSend $ Just x
+         -- Must be two separate transactions:
+         liftIO . atomically $ readManyToOneTVar tvAck
+         return r
+
+instance ReadableChannel (Enrolled BroadcastChanin) where
+  extReadChannel (Enrolled (BI (BC (b, tvSend, tvAck)))) f
+    = do syncBarrierWith (indivRecJust ChannelRead)
+           (resetManyToOneTVar tvAck . pred) $ Enrolled b
+         x <- liftIO $ atomically $ readTVar tvSend >>= maybe retry return
+         y <- f x
+         liftIO $ atomically $ writeManyToOneTVar ((== 0), return 0) pred tvAck
+         return y
+
+instance Poisonable (BroadcastChanout a) where
+  poison (BO (BC (b,_,_))) = poison $ Enrolled b
+  checkForPoison (BO (BC (b,_,_))) = checkForPoison $ Enrolled b
+
+instance Poisonable (Enrolled BroadcastChanin a) where
+  poison (Enrolled (BI (BC (b,_,_)))) = poison $ Enrolled b
+  checkForPoison (Enrolled (BI (BC (b,_,_)))) = checkForPoison $ Enrolled b
+
+newBroadcastChannel :: CHP (BroadcastChannel a)
+newBroadcastChannel = do
+    do b@(Barrier (e, _, _)) <- newBarrier
+       -- Writer is always enrolled:
+       liftIO $ atomically $ enrollEvent e
+       tvSend <- liftIO $ atomically $ newTVar Nothing
+       tvAck <- liftIO $ atomically $ newManyToOneTVar 0
+       return $ BC (b, tvSend, tvAck)
+
+instance Channel BroadcastChanin BroadcastChanout where
+  newChannel' _sh = liftCHP $ do
+    c@(BC (b, _, _)) <- newBroadcastChannel
+    return $ Chan (getBarrierIdentifier b) (BI c) (BO c)
+  sameChannel (BI x) (BO y) = x == y
+
+instance Channel BroadcastChanin (Shared BroadcastChanout) where
+  newChannel' _sh = liftCHP $ do
+    m <- newMutex
+    c <- newChannel
+    return $ Chan (getChannelIdentifier c) (reader c) (Shared (m, writer c))
+  sameChannel (BI x) (Shared (_, BO y)) = x == y
+
+type OneToManyChannel = Chan BroadcastChanin BroadcastChanout
+type AnyToManyChannel = Chan BroadcastChanin (Shared BroadcastChanout)
+
+oneToManyChannel :: MonadCHP m => m (OneToManyChannel a)
+oneToManyChannel = newChannel
+
+anyToManyChannel :: MonadCHP m => m (AnyToManyChannel a)
+anyToManyChannel = newChannel
+
+-- | Added in version 1.5.0.
+--
+-- In version 1.5.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 the traces.
+anyToManyChannel' :: MonadCHP m => ChanOpts a -> m (AnyToManyChannel a)
+anyToManyChannel' = newChannel'
+
+
+-- | 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 the traces.
+newtype ReduceChannel a = GC (Barrier, ManyToOneTVar (Int, Maybe (a, TVar Bool)), (a -> a -> a, a))
+
+instance Eq (ReduceChannel a) where
+  (GC (_, tvX, _)) == (GC (_, tvY, _)) = tvX == tvY
+
+-- | The reading end of a reduce channel.
+--
+-- The Eq instance was added in version 1.4.0.
+newtype ReduceChanin a = GI (ReduceChannel a) deriving (Eq)
+
+-- | The writing end of a reduce channel.  You must enroll on it before
+-- you can read from it or poison it.
+--
+-- The Eq instance was added in version 1.4.0.
+newtype ReduceChanout a = GO (ReduceChannel a) deriving (Eq)
+
+instance Enrollable ReduceChanout a where
+  enroll c@(GO (GC (b,_,_))) f = enroll b (const $ f (Enrolled c))
+  resign (Enrolled (GO (GC (b,_,_)))) m
+    = resign (Enrolled b) m
+      
+instance WriteableChannel (Enrolled ReduceChanout) where
+  extWriteChannel' (Enrolled (GO (GC (b, tv, (f,_))))) m
+    = do syncBarrierWith (indivRecJust ChannelWrite)
+           (\n -> resetManyToOneTVar tv (pred n, Nothing)) $ Enrolled b
+           -- Subtract one for reader
+         (x, r) <- m
+         (_, Just (_, rtvb)) <- liftIO . atomically $ do
+           tvb <- newTVar False
+           let upd (n, mx) = (pred n, Just $ maybe (x, tvb) (first $ f x) mx)
+           writeManyToOneTVar ((== 0) . fst, return (0, Nothing)) upd tv
+         -- Has to be two separate transactions
+         liftIO $ atomically $ readTVar rtvb >>= flip unless retry
+         return r
+
+instance ReadableChannel ReduceChanin where
+  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
+
+instance Poisonable (Enrolled ReduceChanout a) where
+  poison (Enrolled (GO (GC (b,_,_)))) = poison $ Enrolled b
+  checkForPoison (Enrolled (GO (GC (b,_,_)))) = checkForPoison $ Enrolled b
+
+instance Poisonable (ReduceChanin a) where
+  poison (GI (GC (b,_,_))) = poison $ Enrolled b
+  checkForPoison (GI (GC (b,_,_))) = checkForPoison $ Enrolled b
+
+newReduceChannel :: Monoid a => CHP (ReduceChannel a)
+newReduceChannel = do
+    do b@(Barrier (e, _, _)) <- newBarrier
+       -- Writer is always enrolled:
+       liftIO $ atomically $ enrollEvent e
+       mtv <- liftIO $ atomically $ newManyToOneTVar (0, Nothing)
+       return $ GC (b, mtv, (mappend, mempty))
+
+-- | The reduce channel version of sameChannel.
+-- 
+-- This function was added in version 1.4.0.
+sameReduceChannel :: ReduceChanin a -> ReduceChanout a -> Bool
+sameReduceChannel (GI x) (GO y) = x == y
+
+type ManyToOneChannel = Chan ReduceChanin ReduceChanout
+type ManyToAnyChannel = Chan (Shared ReduceChanin) ReduceChanout
+
+manyToOneChannel :: (Monoid a, MonadCHP m) => m (ManyToOneChannel a)
+manyToOneChannel = do
+    c@(GC (b,_,_)) <- liftCHP newReduceChannel
+    return $ Chan (getBarrierIdentifier b) (GI c) (GO c)
+
+
+manyToAnyChannel :: (Monoid a, MonadCHP m) => m (ManyToAnyChannel a)
+manyToAnyChannel = do
+    m <- newMutex
+    c <- manyToOneChannel
+    return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (writer c)
+
+-- | Added in version 1.5.0.
+-- 
+-- In version 1.5.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 the traces.
+manyToAnyChannel' :: (Monoid a, MonadCHP m) => ChanOpts a -> m (ManyToAnyChannel a)
+manyToAnyChannel' = const manyToAnyChannel --TODO
diff --git a/Control/Concurrent/CHP/Channels/Communication.hs b/Control/Concurrent/CHP/Channels/Communication.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/Communication.hs
@@ -0,0 +1,161 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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.
+
+-- | All the channel-ends in CHP are instances of 'ReadableChannel' (for ends that
+-- you can read from) or 'WriteableChannel' (for ends that you can write to).
+--
+-- The 'readChannel' and 'writeChannel' functions are the standard way to communicate
+-- on a channel.  These functions wait for the other party in the communication
+-- to arrive, then exchange the data, then complete.  In pseudo-code, the semantics
+-- are like this when two parties (shown here as two columns) communicate:
+--
+-- > do sync                          sync
+-- >    x                        <-   return y
+-- >    done                          done
+--
+-- Further options are offered by the 'extReadChannel' and 'extWriteChannel' channels,
+-- which allow either side to perform additional (so-called extended) actions during the communication.
+--  The semantics when both sides are performing extended actions are:
+--
+-- > do sync                          sync
+-- >                                  y <- extWriteAction
+-- >    x                        <-   return y
+-- >    x' <- extReadAction x         done
+-- >    done                          done
+-- >    return x'
+--
+-- Neither end need know that the other is performing an extended action, and any
+-- combination is possible (e.g. a normal 'writeChannel' with an 'extReadChannel').
+module Control.Concurrent.CHP.Channels.Communication (
+  ReadableChannel(..), WriteableChannel(..), writeValue, writeChannelStrict
+  ) where
+
+import Control.Monad
+import Control.Parallel.Strategies
+import Data.Monoid
+
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.CSP
+import Control.Concurrent.CHP.Channels.Base
+import Control.Concurrent.CHP.Guard
+import Control.Concurrent.CHP.Poison
+import Control.Concurrent.CHP.Traces.Base
+
+-- | A class indicating that a channel can be read from.
+class ReadableChannel chanEnd where -- minimal implementation: extReadChannel
+  -- | Reads from the given reading channel-end
+  readChannel :: chanEnd a -> CHP a
+  readChannel c = extReadChannel c return
+  -- | Performs an extended read from the channel, performing the given action
+  -- before freeing the writer
+  extReadChannel :: chanEnd a -> (a -> CHP b) -> CHP b
+
+-- | A class indicating that a channel can be written to.
+class WriteableChannel chanEnd where -- minimal implementation: extWriteChannel
+  -- | Writes from the given writing channel-end
+  writeChannel :: chanEnd a -> a -> CHP ()
+  writeChannel c x = extWriteChannel c (return x) >> return ()
+
+  -- | Starts the communication, then performs the given extended action, then
+  -- sends the result of that down the channel.
+  extWriteChannel :: chanEnd a -> CHP a -> CHP ()
+  extWriteChannel c m = extWriteChannel' c (liftM (flip (,) ()) m)
+
+  -- | Like extWriteChannel, but allows a value to be returned from the inner action.
+  --
+  -- This function was added in version 1.4.0.
+  extWriteChannel' :: chanEnd a -> CHP (a, b) -> CHP b
+  
+
+-- ==========
+-- Functions: 
+-- ==========
+
+-- | A useful synonym for @flip writeChannel@.  Especially useful with 'claim'
+-- so that instead of writing @claim output (flip writeChannel 6)@ you can write
+-- @claim output (writeValue 6)@.
+--
+-- Added in version 1.5.0.
+writeValue :: WriteableChannel chanEnd => a -> chanEnd a -> CHP ()
+writeValue = flip writeChannel
+
+-- | A helper function that uses the parallel strategies library (see the
+-- paper: \"Algorithm + Strategy = Parallelism\", P.W. Trinder et al, JFP
+-- 8(1) 1998,
+-- <http://www.macs.hw.ac.uk/~dsg/gph/papers/html/Strategies/strategies.html>)
+-- to make sure that the value sent down a channel is strictly evaluated
+-- by the sender before transmission.
+--
+-- This is useful when you want to write worker processes that evaluate data
+--  and send it back to some \"harvester\" process.  By default the values sent
+-- back may be unevaluated, and thus the harvester might end up doing the evaluation.
+--  If you use this function, the value is guaranteed to be completely evaluated
+-- before sending.
+--
+-- Added in version 1.0.2.
+writeChannelStrict :: (NFData a, WriteableChannel chanEnd) => chanEnd a -> a -> CHP ()
+writeChannelStrict c x = (writeChannel c $| rnf) x
+
+-- ==========
+-- Instances: 
+-- ==========
+
+instance ReadableChannel Chanin where
+  readChannel (Chanin c)
+    = let (e, mdur, mafter) = readChannelC c in
+      buildOnEventPoison (wrapIndiv $ indivRecJust ChannelRead) e
+        (EventActions (const $ return ()) mdur)
+        (liftSTM mafter) >>= checkPoison
+
+  extReadChannel (Chanin c) body
+    = let (e, m) = startReadChannelC c in
+      scopeBlock
+        (buildOnEventPoison (wrapIndiv $ indivRecJust ChannelRead) e mempty (liftSTM m) >>= checkPoison)
+        (\val -> do x <- body val
+                    liftSTM $ endReadChannelC c
+                    return x)
+        (poisonReadC c)
+
+instance WriteableChannel Chanout where
+  writeChannel (Chanout c) x
+    = let (e, mdur, mafter) = writeChannelC c x in
+        buildOnEventPoison (wrapIndiv $ indivRecJust ChannelWrite) e
+          (EventActions (const $ return ()) mdur) (liftSTM mafter)
+        >>= checkPoison
+  extWriteChannel' (Chanout c) body
+    = let (e, m) = startWriteChannelC c in
+      scopeBlock
+        (buildOnEventPoison (wrapIndiv $ indivRecJust ChannelWrite)
+          e mempty (liftSTM m) >>= checkPoison)
+        (const $ do (x, r) <- body
+                    sequence [liftSTM $ sendWriteChannelC c x
+                             ,liftSTM (endWriteChannelC c)]
+                      >>= checkPoison . mergeWithPoison
+                    return r)
+        (poisonWriteC c)
diff --git a/Control/Concurrent/CHP/Channels/Creation.hs b/Control/Concurrent/CHP/Channels/Creation.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/Creation.hs
@@ -0,0 +1,248 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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.
+
+-- | This module contains a proliferation of channel creation methods.
+--
+-- For most uses, 'newChannel' is the only method needed from this module.  This
+-- creates a channel for you to use.  The channel will be automatically destroyed
+-- during garbage collection when it falls out of use, so there is no need to do
+-- anything to destroy it.
+--
+-- It is often possible for the type system to infer which channel you want when
+-- you use 'newChannel'.  If the types of the ends are known by the type system,
+-- the channel-type can be inferred.  So you can usually just write 'newChannel',
+-- and depending on how you use the channel, the type system will figure out
+-- which one you needed.
+--
+-- If this gives a type error along the lines of:
+-- 
+-- >    Ambiguous type variables `r', `w' in the constraint:
+-- >      `Channel r w' arising from a use of `newChannel' at tmp.hs:3:24-33
+-- >    Probable fix: add a type signature that fixes these type variable(s)
+--
+-- Then you must either explicitly type the channel ends you are using, or more
+-- simply, use one of the synonyms in "Control.Concurrent.CHP.Channels.Synonyms"
+-- to indicate which kind of channel you are allocating.
+--
+-- Several other functions in this module, such as 'newChannelWR', 'newChannels'
+-- and 'newChannelList' are helpers built with newChannel to ease dealing with
+-- channel creation.
+--
+-- The remainder of the functions in this module are related to traces (see "Control.Concurrent.CHP.Traces"),
+-- and allowing the channels to show up usefully in traces: see 'newChannel'' and
+-- 'ChanOpts'.
+--
+-- The channel creation methods were refactored in version 1.5.0.  Your code will
+-- only be affected if you were using the trace-related methods (for labelling
+-- the channels in traces).  Instead of using @oneToOneChannelWithLabel "foo"@,
+-- you should use @oneToOneChannel' $ chanLabel "foo"@.
+module Control.Concurrent.CHP.Channels.Creation (
+  Chan, Channel(..), newChannel, ChanOpts(..), defaultChanOpts, chanLabel, newChannelWR, newChannelRW, ChannelTuple(..),
+  newChannelList, newChannelListWithLabels, newChannelListWithStem,
+  labelChannel
+  ) where
+
+import Control.Monad
+import Data.Unique
+
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.Channels.Base
+import Control.Concurrent.CHP.Mutex
+import Control.Concurrent.CHP.Traces.Base
+
+-- | A class used for allocating new channels, and getting the reading and
+-- writing ends.  There is a bijective assocation between the channel, and
+-- its pair of end types.  You can see the types in the list of instances below.
+-- Thus, 'newChannel' may be used, and the compiler will infer which type of
+-- channel is required based on what end-types you get from 'reader' and 'writer'.
+-- Alternatively, if you explicitly type the return of 'newChannel', it will
+-- be definite which ends you will use.  If you do want to fix the type of
+-- the channel you are using when you allocate it, consider using one of the
+-- many 'oneToOneChannel'-like shorthand functions that fix the type.
+class Channel r w where
+  -- | Like 'newChannel' but allows you to specify a way to convert the values
+  -- into Strings in order to display them in the traces, and a label for the traces.  If
+  -- you don't use traces, you can use 'newChannel'.
+  --
+  -- Added in version 1.5.0.
+  newChannel' :: MonadCHP m => ChanOpts a -> m (Chan r w a)
+
+  -- | Determines if two channel-ends refer to the same channel.
+  --
+  -- This function was added in version 1.4.0.
+  sameChannel :: r a -> w a -> Bool
+
+-- | Options for channel creation; a function to show the inner data, and an optional
+-- label (both only affect tracing).  These options can be passed to newChannel'.
+--
+-- Added in version 1.5.0.
+data ChanOpts a = ChanOpts { chanOptsShow :: a -> String, chanOptsLabel :: Maybe String }
+
+-- | The default: don't show anything, don't label anything
+-- 
+-- Added in version 1.5.0.
+defaultChanOpts :: ChanOpts a
+defaultChanOpts = ChanOpts (const "") Nothing
+
+-- | Uses the Show instance for showing the data in traces, and the given label.
+--
+-- Added in version 1.5.0.
+chanLabel :: Show a => String -> ChanOpts a
+chanLabel = ChanOpts show . Just
+
+-- | Allocates a new channel.  Nothing need be done to
+-- destroy\/de-allocate the channel when it is no longer in use.
+--
+-- This function does not add any information to the traces: see newChannel' for
+-- that purpose.
+--
+-- In version 1.5.0, this function was moved out of the 'Channel' class, but that
+-- should only matter if you were declaring your own instances of that class (very
+-- unlikely).
+newChannel :: (MonadCHP m, Channel r w) => m (Chan r w a)
+newChannel = newChannel' defaultChanOpts
+
+-- | A helper class for easily creating several channels of the same type.
+--  The same type refers not only to what type the channel carries, but
+--  also to the type of channel (one-to-one no poison, one-to-any with
+--  poison, etc).  You can write code like this:
+--
+-- > (a, b, c, d, e) <- newChannels
+--
+-- To create five channels of the same type.
+class ChannelTuple t where
+  newChannels :: MonadCHP m => m t
+
+-- | A helper that is like 'newChannel' but returns the reading and writing
+-- end of the channels directly.
+newChannelRW :: (Channel r w, MonadCHP m) => m (r a, w a)
+newChannelRW = do c <- newChannel
+                  return (reader c, writer c)
+
+-- | A helper that is like 'newChannel' but returns the writing and reading
+-- end of the channels directly.
+newChannelWR :: (Channel r w, MonadCHP m) => m (w a, r a)
+newChannelWR = do c <- newChannel
+                  return (writer c, reader c)
+
+-- | Creates a list of channels of the same type with the given length.  If
+-- you need to access some channels by index, use this function.  Otherwise
+-- you may find using 'newChannels' to be easier.
+newChannelList :: (Channel r w, MonadCHP m) => Int -> m [Chan r w a]
+newChannelList n = replicateM n newChannel
+
+-- | A helper that is like 'newChannelList', but labels the channels according
+-- to a pattern.  Given a stem such as foo, it names the channels in the list
+-- foo0, foo1, foo2, etc.
+newChannelListWithStem :: (Channel r w, MonadCHP m) => Int -> String -> m [Chan r w a]
+newChannelListWithStem n s = sequence [newChannel' $ ChanOpts (const "") (Just $ s ++ show i) | i <- [0 .. (n - 1)]]
+
+-- | A helper that is like 'newChannelList', but labels the channels with the
+-- given list.  The number of channels returned is the same as the length of
+-- the list of labels
+newChannelListWithLabels :: (Channel r w, MonadCHP m) => [String] -> m [Chan r w a]
+newChannelListWithLabels = mapM (newChannel' . ChanOpts (const "") . Just)
+
+instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a) where
+  newChannels = do c0 <- newChannel
+                   c1 <- newChannel
+                   return (c0, c1)
+
+instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a) where
+  newChannels = do c0 <- newChannel
+                   c1 <- newChannel
+                   c2 <- newChannel
+                   return (c0, c1, c2)
+
+instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
+  Chan r w a) where
+  newChannels = do c0 <- newChannel
+                   c1 <- newChannel
+                   c2 <- newChannel
+                   c3 <- newChannel
+                   return (c0, c1, c2, c3)
+
+instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
+  Chan r w a, Chan r w a) where
+  newChannels = do c0 <- newChannel
+                   c1 <- newChannel
+                   c2 <- newChannel
+                   c3 <- newChannel
+                   c4 <- newChannel
+                   return (c0, c1, c2, c3, c4)
+
+instance (Channel r w) => ChannelTuple (Chan r w a, Chan r w a, Chan r w a,
+  Chan r w a, Chan r w a, Chan r w a) where
+  newChannels = do c0 <- newChannel
+                   c1 <- newChannel
+                   c2 <- newChannel
+                   c3 <- newChannel
+                   c4 <- newChannel
+                   c5 <- newChannel
+                   return (c0, c1, c2, c3, c4, c5)
+
+-- | Labels a channel in the traces.  It is easiest to do this at creation.
+-- The effect of re-labelling channels after their first use is undefined.
+--
+-- Added in version 1.5.0.
+labelChannel :: MonadCHP m => Chan r w a -> String -> m ()
+labelChannel c = liftCHP . liftPoison . liftTrace . labelUnique (getChannelIdentifier c)
+
+
+instance Channel Chanin Chanout where
+  newChannel' o = do c <- chan (stmChannel $ chanOptsShow o) Chanin Chanout
+                     maybe (return ()) (labelChannel c) (chanOptsLabel o)
+                     return c
+  sameChannel (Chanin x) (Chanout y) = x == y
+
+instance Channel (Shared Chanin) Chanout where
+  newChannel' o = do
+                  m <- newMutex
+                  c <- newChannel' o
+                  return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (writer c)
+  sameChannel (Shared (_, Chanin x)) (Chanout y) = x == y
+
+instance Channel Chanin (Shared Chanout) where
+  newChannel' o = do
+                  m <- newMutex
+                  c <- newChannel' o
+                  return $ Chan (getChannelIdentifier c) (reader c) (Shared (m, writer c))
+  sameChannel (Chanin x) (Shared (_, Chanout y)) = x == y
+
+instance Channel (Shared Chanin) (Shared Chanout) where
+  newChannel' o = do
+                  m <- newMutex
+                  m' <- newMutex
+                  c <- newChannel' o
+                  return $ Chan (getChannelIdentifier c) (Shared (m, reader c)) (Shared (m', writer c))
+  sameChannel (Shared (_, Chanin x)) (Shared (_, Chanout y)) = x == y
+
+chan :: Monad m => m (Unique, c a) -> (c a -> r a) -> (c a -> w a) -> m (Chan r w a)
+chan m r w = do (u, x) <- m
+                return $ Chan u (r x) (w x)
diff --git a/Control/Concurrent/CHP/Channels/Ends.hs b/Control/Concurrent/CHP/Channels/Ends.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/Ends.hs
@@ -0,0 +1,69 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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.
+
+-- | Channels in CHP must be used via their ends.  It is generally these ends that
+-- you pass around to processes that want to communicate on the channel -- thus
+-- it is possible to see from the type ('Chanin'\/'Chanout') whether the process
+-- will use it for reading or writing.  The channel-ends are named from the perspective
+-- of processes: a Chanin is a channel-end that a process may input values from,
+-- whereas a Chanout is a channel-end that a process may output values to.
+module Control.Concurrent.CHP.Channels.Ends (
+  Chanin, Chanout, Shared,
+  reader, writer, readers, writers,
+  claim) where
+
+import Control.Monad.Trans (liftIO)
+
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.CSP
+import Control.Concurrent.CHP.Channels.Base
+import Control.Concurrent.CHP.Mutex
+
+-- | Gets all the reading ends of a list of channels.  A shorthand for @map
+-- reader@.
+readers :: [Chan r w a] -> [r a]
+readers = map reader
+
+-- | Gets all the writing ends of a list of channels.  A shorthand for @map
+-- writer@.
+writers :: [Chan r w a] -> [w a]
+writers = map writer
+
+-- | Claims the given channel-end, executes the given block, then releases
+-- the channel-end and returns the output value.  If poison or an IO
+-- exception is thrown inside the block, the channel is released and the
+-- poison\/exception re-thrown.
+claim :: Shared c a -> (c a -> CHP b) -> CHP b
+claim (Shared (lock, c)) body
+  = scopeBlock
+       (claimMutex lock >> return c)
+       (\y -> do x <- body y
+                 liftIO $ releaseMutex lock
+                 return x)
+       (releaseMutex lock)
diff --git a/Control/Concurrent/CHP/Channels/Synonyms.hs b/Control/Concurrent/CHP/Channels/Synonyms.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/CHP/Channels/Synonyms.hs
@@ -0,0 +1,97 @@
+-- Communicating Haskell Processes.
+-- Copyright (c) 2008--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 some useful type synonyms for dealing with channels.
+--
+-- If you get a type error such as:
+--
+-- >    Ambiguous type variables `r', `w' in the constraint:
+-- >      `Channel r w' arising from a use of `newChannel' at tmp.hs:3:24-33
+-- >    Probable fix: add a type signature that fixes these type variable(s)
+--
+-- Then you may want to substitute your use of 'newChannel' for 'oneToOneChannel'
+-- (if you are not using channel sharing).
+module Control.Concurrent.CHP.Channels.Synonyms (
+  -- * Specific Channel Types
+  -- | All the functions here are equivalent to newChannel (or newChannelWithLabel), but typed.  So for
+  -- example, @oneToOneChannel = newChannel :: MonadCHP m => m OneToOneChannel@.
+  OneToOneChannel, oneToOneChannel, oneToOneChannel',
+  OneToAnyChannel, oneToAnyChannel, oneToAnyChannel',
+  AnyToOneChannel, anyToOneChannel, anyToOneChannel',
+  AnyToAnyChannel, anyToAnyChannel, anyToAnyChannel'
+  ) where
+
+import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.Channels.Creation
+import Control.Concurrent.CHP.Channels.Ends
+
+type OneToOneChannel = Chan Chanin Chanout
+type AnyToOneChannel = Chan (Chanin) (Shared Chanout)
+type OneToAnyChannel = Chan (Shared Chanin) (Chanout)
+type AnyToAnyChannel = Chan (Shared Chanin) (Shared Chanout)
+
+-- | A type-constrained version of newChannel.
+oneToOneChannel :: MonadCHP m => m (OneToOneChannel a)
+oneToOneChannel = newChannel
+
+-- | A type-constrained version of newChannel'.
+--
+-- Added in version 1.5.0.
+oneToOneChannel' :: MonadCHP m => ChanOpts a -> m (OneToOneChannel a)
+oneToOneChannel' = newChannel'
+
+-- | A type-constrained version of newChannel.
+anyToOneChannel :: MonadCHP m => m (AnyToOneChannel a)
+anyToOneChannel = newChannel
+
+-- | A type-constrained version of newChannel.
+oneToAnyChannel :: MonadCHP m => m (OneToAnyChannel a)
+oneToAnyChannel = newChannel
+
+-- | A type-constrained version of newChannel.
+anyToAnyChannel :: MonadCHP m => m (AnyToAnyChannel a)
+anyToAnyChannel = newChannel
+
+-- | A type-constrained version of newChannel'.
+--
+-- Added in version 1.5.0.
+anyToOneChannel' :: MonadCHP m => ChanOpts a -> m (AnyToOneChannel a)
+anyToOneChannel' = newChannel'
+
+-- | A type-constrained version of newChannel'.
+--
+-- Added in version 1.5.0.
+oneToAnyChannel' :: MonadCHP m => ChanOpts a -> m (OneToAnyChannel a)
+oneToAnyChannel' = newChannel'
+
+-- | A type-constrained version of newChannel'.
+--
+-- Added in version 1.5.0.
+anyToAnyChannel' :: MonadCHP m => ChanOpts a -> m (AnyToAnyChannel a)
+anyToAnyChannel' = newChannel'
diff --git a/Control/Concurrent/CHP/Clocks.hs b/Control/Concurrent/CHP/Clocks.hs
--- a/Control/Concurrent/CHP/Clocks.hs
+++ b/Control/Concurrent/CHP/Clocks.hs
@@ -120,7 +120,7 @@
 
 import Control.Concurrent.STM
 import Control.Monad hiding (mapM, mapM_)
-import Control.Monad.State (get)
+import Control.Monad.Reader (ask)
 import Control.Monad.Trans
 import Data.Foldable (mapM_)
 -- Needed for testing:
@@ -327,14 +327,14 @@
          liftSTM (modifyTVar tv $ enrollTimerData $ Just ev)
            >>= checkPoison
          x <- f $ Enrolled tim
-         ts <- liftPoison $ liftTrace $ get
+         ts <- liftPoison $ liftTrace $ ask
          liftSTM (modifyTVar' tv $ checkCompletion u sh ts . resignTimerData True)
            >>= checkPoison
          return x
 
   -- For temporary resignations, we don't touch the event pool
   resign (Enrolled (Clock (tv, u, sh))) m
-    = do ts <- liftPoison $ liftTrace $ get
+    = do ts <- liftPoison $ liftTrace $ ask
          liftSTM (modifyTVar' tv (checkCompletion u sh ts . resignTimerData False))
            >>= checkPoison
          x <- m
@@ -422,7 +422,7 @@
   getCurrentTime (Enrolled (Clock (tv, _, _)))
     = liftSTM (liftM (fmap curTime) $ readTVar tv) >>= checkPoison
   wait c@(Enrolled (Clock (_, u, sh))) mt
-    = do ts <- liftPoison $ liftTrace $ get
+    = do ts <- liftPoison $ liftTrace $ ask
          pid <- liftPoison $ liftTrace $ getProcessId
          waitAct <- liftSTM $ waitClock pid ts c mt
          (t, s) <- liftSTM waitAct >>= checkPoison
diff --git a/Control/Concurrent/CHP/Common.hs b/Control/Concurrent/CHP/Common.hs
--- a/Control/Concurrent/CHP/Common.hs
+++ b/Control/Concurrent/CHP/Common.hs
@@ -99,6 +99,13 @@
 prefix x in_ out = (writeChannel out x >> id in_ out)
   `onPoisonRethrow` (poison in_ >> poison out)
 
+-- | Discards the first value it receives then act likes id.
+--
+-- Added in version 1.5.0.
+tail :: Chanin a -> Chanout a -> CHP ()
+tail input output = do readChannel input `onPoisonRethrow` (poison input >> poison output)
+                       id input output
+
 -- | Forever reads in a value, and then sends out its successor (using 'Prelude.succ').
 succ :: Enum a => Chanin a -> Chanout a -> CHP ()
 succ = map Prelude.succ
@@ -178,7 +185,7 @@
 -- Added in version 1.2.0.
 consumeAlongside :: Chanin a -> CHP b -> CHP b
 consumeAlongside in_ proc
-  = do c <- oneToOneChannelWithLabel "consumeAlongside-Internal"
+  = do c <- oneToOneChannel' $ chanLabel "consumeAlongside-Internal"
        (x,_) <- 
          ((do x <- proc
               writeChannel (writer c) ()
@@ -204,7 +211,8 @@
 -- they are equal or not, etc.
 join :: (a -> b -> c) -> Chanin a -> Chanin b -> Chanout c -> CHP ()
 join f in0 in1 out = (forever $ do
-  (x,y) <- readChannel in0 <||> readChannel in1
+  [Prelude.Left x, Prelude.Right y] <- runParallel
+    [liftM Prelude.Left $ readChannel in0, liftM Prelude.Right $ readChannel in1]
   writeChannel out $ f x y
   ) `onPoisonRethrow` (poison in0 >> poison in1 >> poison out)
 
diff --git a/Control/Concurrent/CHP/Console.hs b/Control/Concurrent/CHP/Console.hs
--- a/Control/Concurrent/CHP/Console.hs
+++ b/Control/Concurrent/CHP/Console.hs
@@ -35,7 +35,7 @@
 import qualified Control.Exception.Extensible as C
 import Control.Monad
 import Control.Monad.Trans
-import Data.Maybe
+--import Data.Maybe
 import System.IO
 
 import Control.Concurrent.CHP
@@ -87,7 +87,11 @@
 
         handlers = [C.Handler (response :: C.IOException -> IO (Maybe a))
                    ,C.Handler (response :: C.AsyncException -> IO (Maybe a))
+#if __GLASGOW_HASKELL__ >= 611
+                   ,C.Handler (response :: C.BlockedIndefinitelyOnSTM -> IO (Maybe a))
+#else
                    ,C.Handler (response :: C.BlockedIndefinitely -> IO (Maybe a))
+#endif
                    ,C.Handler (response :: C.Deadlock -> IO (Maybe a))
                    ]
     
diff --git a/Control/Concurrent/CHP/Event.hs b/Control/Concurrent/CHP/Event.hs
--- a/Control/Concurrent/CHP/Event.hs
+++ b/Control/Concurrent/CHP/Event.hs
@@ -31,7 +31,7 @@
 module Control.Concurrent.CHP.Event (RecordedEventType(..), Event, getEventUnique,
   SignalVar, SignalValue(..), enableEvents, disableEvents,
   newEvent, newEventUnique, enrollEvent, resignEvent, poisonEvent, checkEventForPoison,
-  testAll) where
+  testAll, getEventTypeVal) where
 
 import Control.Arrow
 import Control.Concurrent.STM
@@ -50,16 +50,26 @@
 import Control.Concurrent.CHP.Poison
 import Control.Concurrent.CHP.ProcessId
 
--- | ClockSync was added in version 1.2.0.
+-- | The type of an event in the CSP and VCR traces.
+--
+-- ClockSync was added in version 1.2.0.
+--
+-- The extra parameter on ChannelComm and BarrierSync (which are the result of
+-- showing the value sent and phase ended respectively) was added in version 1.5.0.
 data RecordedEventType
-  = ChannelComm
-  | BarrierSync
+  = ChannelComm String
+  | BarrierSync String
   | ClockSync String deriving (Eq, Ord, Show)
 
+getEventTypeVal :: RecordedEventType -> String
+getEventTypeVal (ChannelComm s) = s
+getEventTypeVal (BarrierSync s) = s
+getEventTypeVal (ClockSync s) = s
+
 -- Not really a CSP event, more like an enrollable poisonable alting barrier!
 newtype Event = Event (
   Unique, -- Event identifier
-  RecordedEventType, -- Event type for trace recording
+  STM RecordedEventType, -- Event type for trace recording
   TVar (WithPoison
     (Int, -- Enrolled count
      Integer, -- Event sequence count
@@ -74,7 +84,7 @@
 
 -- For testing:
 instance Show Event where
-  show (Event (u, t, _tv)) = "Event " ++ show (hashUnique u,t)
+  show (Event (u, _t, _tv)) = "Event " ++ show (hashUnique u)
 
 getEventUnique :: Event -> Unique
 getEventUnique (Event (u,_,_)) = u
@@ -82,7 +92,7 @@
 getEventTVar :: Event -> TVar (WithPoison (Int, Integer, [OfferSet]))
 getEventTVar (Event (_,_,tv)) = tv
 
-getEventType :: Event -> RecordedEventType
+getEventType :: Event -> STM RecordedEventType
 getEventType (Event (_,t,_)) = t
 
 -- The value used to pass information to a waiting process once one of their events
@@ -91,7 +101,7 @@
 newtype SignalValue = Signal (WithPoison Int)
   deriving (Eq, Show)
 
-type SignalVar = TVar (Maybe (SignalValue, Map.Map Unique Integer))
+type SignalVar = TVar (Maybe (SignalValue, Map.Map Unique (Integer, RecordedEventType)))
 
 addPoison :: SignalValue -> SignalValue
 addPoison = const $ Signal PoisonItem
@@ -128,14 +138,14 @@
 allEventsInOffer (OfferSet (_, _, [(_,es)])) = es
 allEventsInOffer (OfferSet (_, _, eventSets)) = unionAll (map snd eventSets)
 
-getAndIncCounter :: Event -> a -> STM (WithPoison Integer)
-getAndIncCounter e _
+getAndIncCounter :: Event -> (a, b) -> STM (WithPoison (Integer, a))
+getAndIncCounter e (r, _)
   = do x <- readTVar (getEventTVar e)
        case x of
          PoisonItem -> return PoisonItem
          NoPoison (a, !n, c) -> do writeTVar (getEventTVar e) $
                                      NoPoison (a, succ n, c)
-                                   return $ NoPoison n
+                                   return $ NoPoison (n, r)
 
 -- | search is /not/ used for discovering offers.  It is used for looking for possible
 -- resolutions to a collection of offer sets.  It is pure; it performs no STM actions,
@@ -159,7 +169,7 @@
           -- out by not being chosen in another part of the search, and it cannot
           -- be chosen by any future parts of the search.  Should be empty when first called from the outside.
           -> Maybe ( [(SignalVar, SignalValue, STM ())]
-                   , Map.Map Event (RecordedEventType, Set.Set ProcessId)
+                   , Map.Map Event (STM RecordedEventType, Set.Set ProcessId)
                    )
              -- ^ The list of tvars involved with the completion and the signal
              -- value for them, and the map with information about the completed events.
@@ -195,7 +205,7 @@
 
         tryAll :: [((SignalValue, STM ()), Map.Map Event ())]
           -> Maybe ( [(SignalVar, SignalValue, STM ())]
-                   , Map.Map Event (RecordedEventType, Set.Set ProcessId)
+                   , Map.Map Event (STM RecordedEventType, Set.Set ProcessId)
                    )
         tryAll [] = Nothing
         tryAll ((ns, es):next)
@@ -241,15 +251,19 @@
   = do let (offers', _) = trim (allOffers, events)
            (act, ret) = fromMaybe ([], Map.empty) $
              search (map addNullOffer $ sortOffers offers') Map.empty
-       eventCounts <- T.sequence $ Map.mapWithKey getAndIncCounter ret
+       -- The associated event-action must come first as that puts the values in the channels:
+       mapM_ (\(_, _, m) -> m) act
+       -- These values are then read by these on-completion bits:
+       ret' <- T.mapM (\(m,y) -> do x <- m
+                                    return (x, y)) ret
+       eventCounts <- T.sequence $ Map.mapWithKey getAndIncCounter ret'
        let NoPoison uniqCounts = T.sequence $ Map.mapKeysMonotonic getEventUnique eventCounts
-       mapM_ (\(tv, x, m) -> writeTVar tv (Just (x, uniqCounts)) >> m
-             ) act
+       mapM_ (\(tv, x, _) -> writeTVar tv (Just (x, uniqCounts))) act
        -- do the retractions for all involved processes once the choice is made:
        -- TODO optimise:
        retractOffers $ zip (map fst3 act)
                            (repeat $ unionAll $ map allEventsInOffer allOffers)
-       return (Map.mapKeysMonotonic getEventUnique ret)
+       return (Map.mapKeysMonotonic getEventUnique ret')
   where
     fst3 (x, _, _) = x
     -- Don't add the null offer for the newest process, and null offer should be
@@ -387,7 +401,7 @@
              Left (OfferSet (tv, _, _)) -> Just tv
              _ -> Nothing
 
-newEvent :: RecordedEventType -> Int -> IO Event
+newEvent :: STM RecordedEventType -> Int -> IO Event
 newEvent t n
   = do u <- newUnique
        atomically $ do tv <- newTVar (NoPoison (n, 0, []))
@@ -473,7 +487,7 @@
                   -- of the value of this flag.  However, if there no events ready,
                   -- passing True will leave the offers there, but False will retract
                   -- the offers.
-                -> STM (Maybe ((SignalValue, Map.Map Unique Integer), [((RecordedEventType, Unique), Set.Set ProcessId)]))
+                -> STM (Maybe ((SignalValue, Map.Map Unique (Integer, RecordedEventType)), [((RecordedEventType, Unique), Set.Set ProcessId)]))
 enableEvents tvNotify pid events canCommitToWait
   = do let offer = OfferSet (tvNotify, pid, [(nid, Map.fromList (zip es (repeat ()))) | (nid, es) <- events])
        -- First add our offer to all the events:
@@ -503,7 +517,8 @@
 -- has been signalled (i.e. has a Just value), that is returned and nothing is done, if the variable
 -- has not been signalled (i.e. is Nothing), the events are disabled and Nothing
 -- is returned.
-disableEvents :: SignalVar -> [Event] -> STM (Maybe (SignalValue, Map.Map Unique Integer))
+disableEvents :: SignalVar -> [Event] -> STM (Maybe (SignalValue, Map.Map Unique (Integer,
+  RecordedEventType)))
 disableEvents tv events
   = do x <- readTVar tv
        -- Since the transaction will be atomic, we know
@@ -706,7 +721,7 @@
             -- Middle list is one-per-offer
             -- Inner list is a conjunction of events
 makeTestEvents eventCounts offerSets
-      = do events <- mapM (\n -> newEvent ChannelComm $ case n of
+      = do events <- mapM (\n -> newEvent (return $ ChannelComm "") $ case n of
              NoPoison n' -> n'
              PoisonItem -> 0) eventCounts
            -- Poison all the events marked as poisoned:
@@ -792,10 +807,10 @@
     test' testName eventCounts offerSets poisoned = do
            (events, realOffers) <- makeTestEvents (map fst eventCounts) offerSets
 
-           actualResult <- atomically $ discoverAndResolve $ Left $ head realOffers
+           actualResult <- liftM (liftM (fmap snd)) $ atomically $ discoverAndResolve $ Left $ head realOffers
            let expectedResult = if poisoned then PoisonItem else NoPoison $
-                                Map.fromList [ (getEventUnique e, (ChannelComm,
-                                               Set.fromList $ map (testProcessId . (*1000) . fst) is))
+                                Map.fromList [ (getEventUnique e,
+                                               Set.fromList $ map (testProcessId . (*1000) . fst) is)
                                              | (e, Left is) <- zip events (map snd eventCounts)]
            when (expectedResult /= actualResult) $
              assertFailure $ testName ++ " failed on direct result, expected: "
diff --git a/Control/Concurrent/CHP/Guard.hs b/Control/Concurrent/CHP/Guard.hs
--- a/Control/Concurrent/CHP/Guard.hs
+++ b/Control/Concurrent/CHP/Guard.hs
@@ -31,6 +31,7 @@
 
 import Control.Concurrent.STM
 import Control.Monad.Trans
+import qualified Data.Map as Map
 import Data.Monoid
 import Data.Unique
 import System.IO
@@ -44,14 +45,15 @@
              | StopGuard
              -- The STM item is an action to take in the same transaction as
              -- completing the event (before it is completed).
-             | EventGuard ((Unique -> Integer) -> [RecordedIndivEvent Unique]) EventActions [Event]
+             | EventGuard ((Unique -> (Integer, RecordedEventType)) -> [RecordedIndivEvent Unique]) EventActions [Event]
 
-data EventActions = EventActions { actWhenLast :: STM ()
+data EventActions = EventActions { actWhenLast :: Map.Map Unique Int -> STM ()
                                  , actAlways :: STM () }
 
 instance Monoid EventActions where
-  mempty = EventActions (return ()) (return ())
-  mappend (EventActions a a') (EventActions b b') = EventActions (a>>b) (a'>>b')
+  mempty = EventActions (const $ return ()) (return ())
+  mappend (EventActions a a') (EventActions b b')
+    = EventActions (\n -> a n >> b n) (a' >> b')
 
 skipGuard :: Guard
 skipGuard = SkipGuard
diff --git a/Control/Concurrent/CHP/Monad.hs b/Control/Concurrent/CHP/Monad.hs
--- a/Control/Concurrent/CHP/Monad.hs
+++ b/Control/Concurrent/CHP/Monad.hs
@@ -44,6 +44,7 @@
    ) where
 
 import Control.Concurrent
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Trans
 import Data.Unique
@@ -85,8 +86,8 @@
 
 -- | A helper like embedCHP for callbacks that take an argument
 embedCHP1 :: (a -> CHP b) -> CHP (a -> IO (Maybe b))
-embedCHP1 f = do t <- liftPoison $ liftTrace get
-                 return $ liftM fst . runCHPProgramWith t (const ()) . f
+embedCHP1 f = do t <- liftPoison $ liftTrace ask
+                 return $ runCHPProgramWith t . f
 
 -- | A convenient version of embedCHP1 that ignores the result
 embedCHP1_ :: (a -> CHP b) -> CHP (a -> IO ())
diff --git a/Control/Concurrent/CHP/Mutex.hs b/Control/Concurrent/CHP/Mutex.hs
--- a/Control/Concurrent/CHP/Mutex.hs
+++ b/Control/Concurrent/CHP/Mutex.hs
@@ -42,3 +42,7 @@
 
 releaseMutex :: MonadIO m => Mutex -> m ()
 releaseMutex m = liftIO $ putMVar m ()
+
+-- | A wrapper (usually around a channel-end) indicating that the inner item
+-- is shared.  Use the 'claim' function to use this type.
+data Shared c a = Shared (Mutex, c a)
diff --git a/Control/Concurrent/CHP/Parallel.hs b/Control/Concurrent/CHP/Parallel.hs
--- a/Control/Concurrent/CHP/Parallel.hs
+++ b/Control/Concurrent/CHP/Parallel.hs
@@ -33,13 +33,11 @@
 import Control.Concurrent
 import Control.Concurrent.STM
 import qualified Control.Exception.Extensible as C
-import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.List
 import Data.Maybe
 import Data.Ord
-import System.IO
 
 import Control.Concurrent.CHP.Base
 import Control.Concurrent.CHP.Traces.Base
@@ -93,61 +91,29 @@
 -- Doesn't really matter for this operator:
 infixr <|*|>
 
-
-wrapProcess :: CHP a -> (CHP' (Either PoisonError a) -> IO (Either PoisonError
-  a, st)) -> IO (Maybe (Either st (a, st)))
-wrapProcess (PoisonT proc) unwrapInner
-  = do let inner = runErrorT proc
-       x <- liftM Just (unwrapInner inner) `C.catches` allHandlers
-       case x of
-         Nothing -> return Nothing
-         Just (Left _, st) -> return $ Just $ Left st
-         Just (Right y, st) -> return $ Just $ Right (y, st)
-  where
-    response :: C.Exception e => e -> IO (Maybe a)
-    response x = liftIO (hPutStrLn stderr $ "Thread terminated with: " ++ show x)
-                   >> return Nothing
-
-    allHandlers = [C.Handler (response :: C.IOException -> IO (Maybe a))
-                  ,C.Handler (response :: C.AsyncException -> IO (Maybe a))
-                  ,C.Handler (response :: C.NonTermination -> IO (Maybe a))
-                  ,C.Handler (response :: C.BlockedIndefinitely -> IO (Maybe a))
-                  ,C.Handler (response :: C.Deadlock -> IO (Maybe a))
-                  ]
-
 -- | Runs all the processes in parallel and returns their results once they
 -- have all finished.  The length and ordering of the results reflects the
 -- length and ordering of the input
 runParallelPoison :: forall a. [CHP a] -> CHP [a]
 runParallelPoison processes
-  = do (final, intermed) <- liftIO $ atomically $ do
-         a <- newResultsVar
-         b <- newResultsVar
-         return (a, b)
-       trace <- PoisonT $ lift $ liftTrace get
+  = do resultVar <- liftIO $ atomically $ newManyToOneTVar []
+       trace <- PoisonT $ lift $ liftTrace ask
        blanks <- liftIO $ blankTraces trace (length processes)
        liftIO $ 
-         mapM_ forkIO [do y <- wrapProcess p $ flip runStateT btr . pullOutStandard
+         mapM_ forkIO [do y <- wrapProcess p $ flip runReaderT btr . pullOutStandard
                           C.block $ atomically $
-                            do ys <- readTVar intermed
-                               writeTVar
-                                 (if length ys == length processes - 1 then final else intermed)
-                                 $ (case y of
-                                 Nothing -> (n, (Nothing, Nothing))
-                                 Just (Right (x,t)) -> (n, (Just x, Just t))
-                                 Just (Left t) -> (n, (Nothing, Just t))
-                                 ) : ys
-                      | (p, btr, n) <- zip3 processes blanks [0..]]
-       results <- liftIO $ atomically $ do xs <- readTVar final
-                                           if length xs == length processes
-                                             then return xs
-                                             else retry
+                            writeManyToOneTVar ((== length processes) . length, return []) 
+                             ((:) (case y of
+                                 Nothing -> (n, Nothing)
+                                 Just (Right x) -> (n, Just x)
+                                 Just (Left _) -> (n, Nothing)
+                                 )) resultVar
+                             >> return ()
+                      | (p, btr, n) <- zip3 processes blanks [(0::Int)..]]
+       results <- liftIO $ atomically $ readManyToOneTVar resultVar
        let sortedResults = map snd $ sortBy (comparing fst) results
-       PoisonT $ lift $ liftTrace $ mergeSubProcessTraces (mapMaybe snd sortedResults)
-       mapM (maybe throwPoison return . fst) sortedResults
-  where
-    newResultsVar :: STM (TVar [(Integer, (Maybe a, Maybe TraceStore))])
-    newResultsVar = newTVar []
+       PoisonT $ lift $ liftTrace $ mergeSubProcessTraces blanks
+       mapM (maybe throwPoison return) sortedResults
 
 -- | A monad transformer used for introducing forking blocks.
 newtype (Monad m, MonadCHP m) => ForkingT m a = Forking (ReaderT (TVar (Bool,
@@ -185,10 +151,10 @@
               liftIO $ atomically $ do
                 (pa, n) <- readTVar b
                 writeTVar b (pa, n + 1)
-              trace <- liftCHP $ PoisonT $ lift $ liftTrace get
+              trace <- liftCHP $ PoisonT $ lift $ liftTrace ask
               [blank] <- liftIO $ blankTraces trace 1
               liftIO $ forkIO $ do
-                r <- wrapProcess p $ flip runStateT blank . pullOutStandard
+                r <- wrapProcess p $ flip runReaderT blank . pullOutStandard
                 C.block $ atomically $ do
                   (poisonedAlready, n) <- readTVar b
                   writeTVar b $ (poisonedAlready || isNothing r, n - 1)
diff --git a/Control/Concurrent/CHP/Test.hs b/Control/Concurrent/CHP/Test.hs
--- a/Control/Concurrent/CHP/Test.hs
+++ b/Control/Concurrent/CHP/Test.hs
@@ -31,23 +31,80 @@
 -- the QuickCheck 2 framework and using HUnit.
 --
 -- This whole module was added in version 1.4.0.
-module Control.Concurrent.CHP.Test where
+module Control.Concurrent.CHP.Test (QuickCheckCHP, qcCHP, qcCHP', propCHPInOut, testCHP, testCHPInOut,
+  testCHP', CHPTestResult(..), (=*=), CHPTest, withCheck, assertCHP, assertCHP',
+    assertCHPEqual, assertCHPEqual') where
 
+import Control.Arrow
 import Control.Monad
+import Control.Monad.Error (ErrorT, runErrorT, throwError)
+import Control.Monad.Trans (MonadIO)
 import Data.Maybe
-import Test.HUnit (assertBool, Test(..))
-import Test.QuickCheck (Gen, Property)
-import Test.QuickCheck.Monadic (assert, forAllM, monadicIO, run)
+import Data.Monoid
+import Data.Unique
+import Test.HUnit (assertFailure, Test(..))
+import Test.QuickCheck (Gen, forAll)
+import Test.QuickCheck.Property (Property, Result(..), Testable(..), failed, succeeded, liftIOResult)
+import Text.PrettyPrint.HughesPJ
 
 import Control.Concurrent.CHP
+import Control.Concurrent.CHP.Traces
 
--- | Takes a CHP program that returns a Bool (True = test passed, False = test
--- failed) and forms it into a Property that QuickCheck can test.
+-- | A wrapper around the CHP type that supports some QuickCheck 'Testable' instances.
+--  See 'qcCHP' and 'qcCHP''.
 --
--- Note that if the program exits with poison, this is counted as a test failure.
-propCHP :: CHP Bool -> Property
-propCHP = monadicIO . (>>= assert . fromMaybe False) . run . runCHP
+-- Added in version 1.5.0.
+newtype QuickCheckCHP a = QCCHP (IO (Maybe a, Doc))
 
+-- | Turns a CHP program into a 'QuickCheckCHP' for use with 'Testable' instances.
+--
+-- Equivalent to @qcCHP' . runCHP_CSPTrace@.
+--
+-- Added in version 1.5.0.
+qcCHP :: CHP a -> QuickCheckCHP a
+qcCHP = qcCHP' . runCHP_CSPTrace
+
+-- | Takes the command that runs a CHP program and gives back a 'QuickCheckCHP'
+-- item for use with 'Testable' instances.
+--
+-- You use this function like:
+--
+-- > qcCHP' (runCHP_CSPTrace p)
+--
+-- To test process @p@ with a CSP trace if it fails.  To turn off the display of
+-- tracing when a test fails, use:
+--
+-- > qcCHP' (runCHP_TraceOff p)
+--
+-- Added in version 1.5.0.
+qcCHP' :: Trace t => IO (Maybe a, t Unique) -> QuickCheckCHP a
+qcCHP' = QCCHP . liftM (second prettyPrint)
+
+qcResult :: IO (Maybe Result, Doc) -> Property
+qcResult m = liftIOResult $
+             do (mr, t) <- m
+                case mr of
+                  Just r -> return $ r { reason = reason r ++ "; trace: " ++ show t }
+                  Nothing -> return $ failed { reason = "QuickCheckCHP Failure (deadlock/uncaught poison); trace: " ++ show t }
+
+chpToQC :: CHPTestResult -> Result
+chpToQC (CHPTestPass) = succeeded
+chpToQC (CHPTestFail msg) = failed { reason = msg }
+
+boolToResult :: Bool -> Result
+boolToResult b = if b then succeeded else failed
+
+instance Testable (QuickCheckCHP Bool) where
+  property (QCCHP x) = qcResult $ liftM (first $ fmap boolToResult) x
+
+instance Testable (QuickCheckCHP Result) where
+  property (QCCHP x) = qcResult x
+
+instance Testable (QuickCheckCHP CHPTestResult) where
+  property (QCCHP x) = qcResult $ liftM (first $ fmap chpToQC) x
+
+
+
 -- | Tests a process that takes a single input and produces a single output, using
 -- QuickCheck.
 --
@@ -71,7 +128,7 @@
 -- something like the Common.filter process), the test will deadlock.
 propCHPInOut :: Show a => (a -> b -> Bool) -> (Chanin a -> Chanout b -> CHP ()) -> Gen a -> Property
 propCHPInOut f p gen
-  = monadicIO $ forAllM gen $ \x -> run (runCHP $
+  = forAll gen $ \x -> qcCHP $
               do c <- oneToOneChannel
                  d <- oneToOneChannel
                  (_,r) <- (p (reader c) (writer d)
@@ -81,15 +138,152 @@
                              poison (writer c) >> poison (reader d)
                              return $ f x y
                          ) `onPoisonTrap` return False)
-                 return r) >>= assert . fromMaybe False
+                 return r
 
 -- | Takes a CHP program that returns a Bool (True = test passed, False = test
 -- failed) and forms it into an HUnit test.
 --
 -- Note that if the program exits with poison, this is counted as a test failure.
 testCHP :: CHP Bool -> Test
-testCHP = TestCase . (>>= assertBool "testCHP failure" . fromMaybe False) . runCHP
+testCHP = TestCase . (>>= assertWithTrace) . runCHPAndTrace
+  where
+    assertWithTrace :: (Maybe Bool, CSPTrace Unique) -> IO ()
+    assertWithTrace (Just True, _) = return ()
+    assertWithTrace (Just False, t) = assertFailure $ "testCHP Failure; trace: " ++ show (prettyPrint t)
+    assertWithTrace (Nothing, t) = assertFailure $ "testCHP Failure (deadlock/uncaught poison); trace: " ++ show (prettyPrint t)
 
+-- | A helper type for describing a more detailed result of a CHP test.  You can
+-- construct these values manually, or using the '(=*=)' operator.
+--
+-- Added in version 1.5.0.
+data CHPTestResult = CHPTestPass | CHPTestFail String
+
+instance Monoid CHPTestResult where
+  mempty = CHPTestPass
+  mappend CHPTestPass y = y
+  mappend x _ = x
+
+-- | Checks if two things are equal; passes the test if they are, otherwise fails
+-- and gives an error that shows the two things in question.
+--
+-- Added in version 1.5.0.
+(=*=) :: (Eq a, Show a) => a -> a -> CHPTestResult
+(=*=) expected act
+  | expected == act = CHPTestPass
+  | otherwise = CHPTestFail $ "Expected: " ++ show expected ++ "; Actual: " ++ show act
+
+-- | Like 'testCHP' but allows you to return the more descriptive 'CHPTestResult'
+-- type, rather than a plain Bool.
+--
+-- Added in version 1.5.0.
+testCHP' :: CHP CHPTestResult -> Test
+testCHP' p = TestCase $ do (r, t) <- runCHP_CSPTrace p
+                           case r of
+                             Just CHPTestPass -> return ()
+                             Just (CHPTestFail s) -> assertFailure $
+                               s ++ "; trace: " ++ show t
+                             Nothing -> assertFailure $ "testCHP' Failure (deadlock/uncaught poison); trace: "
+                               ++ show t
+
+-- | See withCheck.  Added in version 1.5.0.
+newtype CHPTest a = CHPTest (ErrorT String CHP a)
+  deriving (Monad, MonadIO, MonadCHP)
+
+-- | A helper function that allows you to create CHP tests in an assertion style, either
+-- for use with HUnit or QuickCheck 2.
+--
+-- Any poison thrown by the first argument (the left-hand side when this function
+-- is used infix) is trapped and ignored.  Poison thrown by the second argument
+-- (the right-hand side when used infix) is counted as a test failure.
+--
+-- As an example, imagine that you have a process that should repeatedly
+-- output the same value (42), called @myProc@.  There are several ways to test
+-- this, but for the purposes of illustration we will start by testing the
+-- first two values:
+--
+-- > myTest :: Test
+-- > myTest = testCHP' $ do
+-- >   c <- oneToOneChannel
+-- >   myProc (writer c)
+-- >     `withCheck` do x0 <- liftCHP $ readChannel (reader c)
+-- >                    assertCHPEqual (poison (reader c)) "First value" 42 x0
+-- >                    x1 <- liftCHP $ readChannel (reader c)
+-- >                    poison (reader c) -- Shutdown myProc
+-- >                    assertCHPEqual' "Second value" 42 x1
+--
+-- This demonstrates the typical pattern: a do block with some initialisation to
+-- begin with (creating channels, enrolling on barriers), then a withCheck call
+-- with the thing you want to test on the left-hand side, and the part doing the
+-- testing with the asserts on the right-hand side.  Most CHP actions must be surrounded
+-- by 'liftCHP', and assertions can then be made about the values.
+--
+-- Poison is used twice in our example.  The assertCHPEqual function takes as a
+-- first argument the command to execute if the assertion fails.  The problem
+-- is that if the assertion fails, the right-hand side will finish.  But it is
+-- composed in parallel with the left-hand side, which does not know to finish
+-- (deadlock!).  Thus we must pass a command to execute if the assertion fails
+-- that will shutdown the right-hand side.  The second assertion doesn't need
+-- this, because by the time we make the assertion, we have already inserted
+-- the poison.  Don't forget that you must poison to shut down the left-hand
+-- side if your test is successful or else you will again get deadlock.
+--
+-- A better way to test this process is of course to read in a much larger number
+-- of samples and check they are all the same, for example:
+--
+-- > myTest :: Test
+-- > myTest = testCHP' $ do
+-- >   c <- oneToOneChannel
+-- >   myProc (writer c)
+-- >     `withCheck` do xs <- liftCHP $ replicateM 1000 $ readChannel (reader c)
+-- >                    poison (reader c) -- Shutdown myProc
+-- >                    assertCHPEqual' "1000 values" xs (replicate 1000 42)
+--
+-- Added in version 1.5.0.
+withCheck :: CHP a -> CHPTest () -> CHP CHPTestResult
+withCheck p (CHPTest t) = liftM snd $ (p `onPoisonTrap` return undefined) <||> do
+  er <- runErrorT t
+  case er of
+    Left msg -> return $ CHPTestFail msg
+    Right _ -> return CHPTestPass
+
+-- | Checks that the given Bool is True.  If it is, the assertion passes and the
+-- test continues.  If it is False, the given command is run (which should shut
+-- down the left-hand side of withCheck) and the test finishes, failing with the
+-- given String.
+--
+-- Added in version 1.5.0.
+assertCHP :: CHP () -> String -> Bool -> CHPTest ()
+assertCHP comp msg passed
+  | passed = return ()
+  | otherwise = liftCHP comp >> CHPTest (throwError msg)
+
+-- | Checks that the given values are equal (first is the expected value of the
+-- test, second is the actual value).  If they are equal, the assertion passes and the
+-- test continues.  If they are not equal, the given command is run (which should shut
+-- down the left-hand side of withCheck) and the test finishes, failing with the
+-- a message formed of the given String, and describing the two values.
+--
+-- Added in version 1.5.0.
+assertCHPEqual :: (Eq a, Show a) => CHP () -> String -> a -> a -> CHPTest ()
+assertCHPEqual comp msg expected act
+  = assertCHP comp
+              (msg ++ "; expected: " ++ show expected ++ "; actual: " ++ show act)
+              (expected == act)
+
+-- | Like 'assertCHP' but issues no shutdown command.  You should only use this
+-- function if you are sure that the left-hand side of withCheck has already completed.
+--
+-- Added in version 1.5.0.
+assertCHP' :: String -> Bool -> CHPTest ()
+assertCHP' = assertCHP (return ())
+
+-- | Like 'assertCHPEqual' but issues no shutdown command.  You should only use this
+-- function if you are sure that the left-hand side of withCheck has already completed.
+--
+-- Added in version 1.5.0.
+assertCHPEqual' :: (Eq a, Show a) => String -> a -> a -> CHPTest ()
+assertCHPEqual' = assertCHPEqual (return ())
+
 -- | Tests a process that takes a single input and produces a single output, using
 -- HUnit.
 --
@@ -128,4 +322,4 @@
                              return $ f x y
                          ) `onPoisonTrap` return False)
 
--- TODO add some better HUnit facilities
+
diff --git a/Control/Concurrent/CHP/Traces.hs b/Control/Concurrent/CHP/Traces.hs
--- a/Control/Concurrent/CHP/Traces.hs
+++ b/Control/Concurrent/CHP/Traces.hs
@@ -69,12 +69,181 @@
   ,recordedIndivEventLabel
   ,recordedIndivEventSeq
   ,Trace(..)
+  ,vcrToCSP
+  ,structuralToCSP
+  ,structuralToVCR
   ) where
 
+import Control.Arrow
+--import Control.Monad.Cont
+--import Control.Monad.State
+import qualified Data.Foldable as F
+import Data.List
+import qualified Data.Map as Map
+import Data.Monoid
+import qualified Data.Set as Set
+
 import Control.Concurrent.CHP.Base
 import Control.Concurrent.CHP.Event
+import Control.Concurrent.CHP.ProcessId
 import Control.Concurrent.CHP.Traces.Base
 import Control.Concurrent.CHP.Traces.CSP
 import Control.Concurrent.CHP.Traces.Structural
 import Control.Concurrent.CHP.Traces.TraceOff
 import Control.Concurrent.CHP.Traces.VCR
+
+-- | Takes a VCR trace and forms all the possible CSP traces (without
+-- duplicates) that could have arisen from the same execution.
+--
+-- This is done by taking all permutations of each set in the VCR trace (which
+-- is a list of sets) and concatenating them with the results of the same process
+-- on the rest of the trace.  Thus the maximum size of the returned set of CSP traces
+-- is the product of the sizes of all the non-empty sets in the VCR trace.
+--
+-- This function was added in version 1.5.0.
+vcrToCSP :: Eq u => VCRTrace u -> [CSPTrace u]
+vcrToCSP (VCRTrace (ls, sets)) = [CSPTrace (ls, es) | es <- nub $ process sets]
+  where
+    process :: [Set.Set a] -> [[a]]
+    process [] = [[]]
+    process (s:ss)
+      | Set.null s = process ss
+      | otherwise = [a ++ b | a <- chp_permutations (Set.toList s), b <- process ss]
+
+--type SeqId = Integer
+--type CM eventId = ContT (EventMap eventId) (State (Seq.Seq (Set.Set (RecordedEvent eventId))))
+
+type EventMap eventId = Map.Map (RecordedIndivEvent eventId) (Set.Set ProcessId)
+
+combine :: Ord u => [EventMap u] -> EventMap u
+combine = foldl (Map.unionWith Set.union) Map.empty
+
+participants :: Ord u => EventHierarchy (RecordedIndivEvent u)
+             -> Map.Map (RecordedIndivEvent u) Int
+{-participants (SingleEvent e)
+  = Map.singleton (recordedIndivEventLabel e, recordedIndivEventSeq e) 1
+participants (StructuralSequence _ ss)
+  = combine $ map participants ss
+participants (StructuralParallel ps)
+  = combine $ map participants ps
+-}
+participants = F.foldr
+ (\e -> Map.insertWith (+) e 1)
+ Map.empty
+
+single :: RecordedIndivEvent u -> ProcessId -> EventMap u
+single k v = Map.singleton k (Set.singleton v)
+
+data Cont u = Cont (EventMap u) ([RecordedIndivEvent u] -> Cont u)
+            | ContDone
+
+instance Monoid (Cont u) where
+  mempty = ContDone
+  mappend ContDone r = r
+  mappend (Cont m f) r = Cont m (\e -> f e `mappend` r)
+
+makeCont :: Ord u => EventHierarchy (RecordedIndivEvent u) -> ProcessId -> Cont u
+makeCont (SingleEvent e) pid = c
+  where
+    c = Cont (single e pid) wait
+    wait e'
+      | e `elem` e' = ContDone
+      | otherwise = c
+makeCont (StructuralSequence 0 _) _ = ContDone
+makeCont (StructuralSequence n es) pid
+  = mconcat (map (uncurry makeCont) $ zip es pidsPlusOne)
+      `mappend` makeCont (StructuralSequence (n-1) es) (last pidsPlusOne)
+  where
+    pidsPlusOne = take (1 + length es) $ iterate incPid pid
+
+    incPid (ProcessId ps) = ProcessId $ init ps ++ [ParSeq p (succ s)]
+      where
+        ParSeq p s = last ps
+makeCont (StructuralParallel es) pid
+  = mergePar (map (uncurry makeCont) $ zip es (parPids pid))
+  where
+    parPids (ProcessId ps) = [ProcessId $ ps ++ [ParSeq i 0] | i <- [0..]]
+
+mergePar :: Ord u => [Cont u] -> Cont u
+mergePar cs = case [ m | Cont m _f <- cs] of
+                [] -> ContDone
+                ms -> Cont (combine ms) (\e -> mergePar [f e | Cont _m f <- cs])
+
+-- | Takes a structural trace and forms all the possible VCR traces (without
+-- duplicates) that could have arisen from the same execution.
+--
+-- This is done -- roughly speaking -- by replaying the structural trace in all
+-- possible execution orderings and pulling out the VCR trace for each ordering.
+--
+-- This function was added in version 1.5.0.
+structuralToVCR :: Ord u => StructuralTrace u -> [VCRTrace u]
+structuralToVCR (StructuralTrace (ls, Nothing)) = [VCRTrace (ls, [])]
+structuralToVCR (StructuralTrace (ls, Just str))
+  = nubBy eq [VCRTrace (ls, map (Set.map snd) $ reverse $ toVCR $ reverse tr) | tr <- flattenStructural str]
+  where
+    eq (VCRTrace (_, a)) (VCRTrace (_, b)) = a == b
+
+toVCR :: Ord u => [(RecordedEvent u, Set.Set ProcessId)]
+      -> [(Set.Set (Set.Set ProcessId, RecordedEvent u))]
+toVCR [] = []
+toVCR ((e, pids) : rest)
+  = prependVCR (toVCR rest) pids [(pids, e)]
+
+-- | Takes a structural trace and forms all the possible CSP traces (without
+-- duplicates) that could have arisen from the same execution.
+--
+-- This is done -- roughly speaking -- by replaying the structural trace in all
+-- possible execution orderings and pulling out the CSP trace for each ordering.
+--
+-- It should be the case for all structural traces @t@ that do not use conjunction ('every' and
+-- '(\<&\>)'):
+-- 
+-- > structuralToCSP t =~= (concatMap vcrToCSP . structuralToVCR) t
+-- >   where a =~= b = or [a' == b' | a' <- permutations a, b' <- permutations  b]
+--
+-- This function was added in version 1.5.0.
+structuralToCSP :: Ord u => StructuralTrace u -> [CSPTrace u]
+structuralToCSP (StructuralTrace (ls, Nothing)) = [CSPTrace (ls, [])]
+structuralToCSP (StructuralTrace (ls, Just str))
+  = [CSPTrace (ls, map fst tr) | tr <- flattenStructural str]
+
+flattenStructural :: forall u. Ord u => EventHierarchy (RecordedIndivEvent u) -> [[(RecordedEvent u, Set.Set ProcessId)]]
+flattenStructural tr
+  = process $ makeCont tr rootProcessId
+  where
+    ps = participants tr
+
+    process :: Cont u -> [[(RecordedEvent u, Set.Set ProcessId)]]
+    process ContDone = [[]]
+    process (Cont m f)
+      = concat [map ((e, pids) :) $ process (f ie)
+               | (e,(ie,pids)) <- Map.toAscList eventsWithAllParticipants]
+      where
+        indivEventsWithAllParticipants :: Map.Map (RecordedIndivEvent u) (Set.Set ProcessId)
+        indivEventsWithAllParticipants = Map.map fst $ Map.filter (\(s, n) -> Set.size s == n) (Map.intersectionWith (,) m ps)
+
+        eventsWithAllParticipants :: Map.Map (RecordedEvent u) ([RecordedIndivEvent u], Set.Set ProcessId)
+        eventsWithAllParticipants
+          = Map.map snd $
+              Map.filterWithKey fixEvents $
+              Map.mapKeysWith mergeVals toWhole $
+              Map.map ((,) False . first (:[])) $
+              Map.mapWithKey (,) $
+              indivEventsWithAllParticipants
+          where
+            mergeVals :: (Bool, ([RecordedIndivEvent u], Set.Set ProcessId))
+                      -> (Bool, ([RecordedIndivEvent u], Set.Set ProcessId))
+                      -> (Bool, ([RecordedIndivEvent u], Set.Set ProcessId))
+            mergeVals (_, (es, pids)) (_, (es', pids'))
+              = (True, (es ++ es', Set.union pids pids'))
+
+    fixEvents :: RecordedEvent a -> (Bool, b) -> Bool
+    fixEvents (ChannelComm _, _) (b, _) = b -- Channel comms need to have both sides
+    fixEvents _ _ = True
+
+    toWhole :: RecordedIndivEvent a -> RecordedEvent a
+    toWhole (ChannelWrite x _ s) = (ChannelComm s, x)
+    toWhole (ChannelRead x _ s) = (ChannelComm s, x)
+    toWhole (BarrierSyncIndiv x _ s) = (BarrierSync s, x)
+    toWhole (ClockSyncIndiv x _ t) = (ClockSync t, x)
+    
diff --git a/Control/Concurrent/CHP/Traces/Base.hs b/Control/Concurrent/CHP/Traces/Base.hs
--- a/Control/Concurrent/CHP/Traces/Base.hs
+++ b/Control/Concurrent/CHP/Traces/Base.hs
@@ -30,7 +30,9 @@
 module Control.Concurrent.CHP.Traces.Base where
 
 import Control.Concurrent.STM
+import Control.Monad.Reader
 import Control.Monad.State
+import Data.IORef
 import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -58,37 +60,45 @@
 -- never have the same Unique as each other, but do not rely on this
 -- behaviour.
 --
+-- The type u item is the unique identifier of the channel/barrier/clock, and the
+-- Integer is a sequence identifier for that channel/barrier/clock (first sync
+-- is 0, second sync is 1, etc), and finally the String shows the value-sent/phase-ended/time
+-- involved.
+--
 -- ClockSyncIndiv was added in version 1.2.0.
 --
 -- The type became parameterised, and the Show and Read instances were added in version 1.3.0.
+--
+-- The String parameters on ChannelWrite, ChannelRead and BarrierSyncIndiv were
+-- added in version 1.5.0.
 data RecordedIndivEvent u = 
-  ChannelWrite u Integer
-  | ChannelRead u Integer
-  | BarrierSyncIndiv u Integer
+  ChannelWrite u Integer String
+  | ChannelRead u Integer String
+  | BarrierSyncIndiv u Integer String
   | ClockSyncIndiv u Integer String
   deriving (Eq, Ord, Read, Show)
 
 -- | Added in version 1.3.0.
 recordedIndivEventLabel :: RecordedIndivEvent u -> u
-recordedIndivEventLabel (ChannelWrite x _) = x
-recordedIndivEventLabel (ChannelRead x _) = x
-recordedIndivEventLabel (BarrierSyncIndiv x _) = x
+recordedIndivEventLabel (ChannelWrite x _ _) = x
+recordedIndivEventLabel (ChannelRead x _ _) = x
+recordedIndivEventLabel (BarrierSyncIndiv x _ _) = x
 recordedIndivEventLabel (ClockSyncIndiv x _ _) = x
 
 -- | Added in version 1.3.0.
 recordedIndivEventSeq :: RecordedIndivEvent u -> Integer
-recordedIndivEventSeq (ChannelWrite _ n) = n
-recordedIndivEventSeq (ChannelRead _ n) = n
-recordedIndivEventSeq (BarrierSyncIndiv _ n) = n
+recordedIndivEventSeq (ChannelWrite _ n _) = n
+recordedIndivEventSeq (ChannelRead _ n _) = n
+recordedIndivEventSeq (BarrierSyncIndiv _ n _) = n
 recordedIndivEventSeq (ClockSyncIndiv _ n _) = n
 
-indivRec :: (u -> Integer -> RecordedIndivEvent u)
-            -> u -> (u -> Integer) -> (RecordedIndivEvent u)
+indivRec :: (u -> Integer -> String -> RecordedIndivEvent u)
+            -> u -> (u -> Integer) -> String -> (RecordedIndivEvent u)
 indivRec r u f = r u (f u)
 
-indivRecJust :: (u -> Integer -> RecordedIndivEvent u)
-                -> u -> (u -> Integer) -> Maybe (RecordedIndivEvent u)
-indivRecJust r u f = Just $ indivRec r u f
+indivRecJust :: (u -> Integer -> String -> RecordedIndivEvent u)
+                -> u -> (u -> Integer) -> String -> [RecordedIndivEvent u]
+indivRecJust r u f x = [indivRec r u f x]
 
 type RecEvents = ([RecordedEvent Unique], [RecordedIndivEvent Unique])
 
@@ -105,8 +115,8 @@
 nameEvent (t, c) = liftM (++ suffix) $ getName prefix c
   where
     (prefix, suffix) = case t of
-      ChannelComm -> ("_c","")
-      BarrierSync -> ("_b","")
+      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)
@@ -114,47 +124,47 @@
                        return (t, c' ++ suffix)
   where
     (prefix, suffix) = case t of
-      ChannelComm -> ("_c","")
-      BarrierSync -> ("_b","")
+      ChannelComm _ -> ("_c", "")
+      BarrierSync _ -> ("_b", "")
       ClockSync st -> ("_t", ':' : st)
 
 
 nameIndivEvent :: Ord u => RecordedIndivEvent u -> State (Map.Map u String) String
-nameIndivEvent (ChannelWrite c n) = do c' <- getName "_c" c
-                                       return $ c' ++ "![" ++ show n ++ "]"
-nameIndivEvent (ChannelRead c n) = do c' <- getName "_c" c
-                                      return $ c' ++ "?[" ++ show n ++ "]"
-nameIndivEvent (BarrierSyncIndiv c n) = do c' <- getName "_b" c
-                                           return $ c' ++ "[" ++ show n ++ "]"
+nameIndivEvent (ChannelWrite c n _) = do c' <- getName "_c" c
+                                         return $ c' ++ "![" ++ show n ++ "]"
+nameIndivEvent (ChannelRead c n _) = do c' <- getName "_c" c
+                                        return $ c' ++ "?[" ++ show n ++ "]"
+nameIndivEvent (BarrierSyncIndiv c n _) = do c' <- getName "_b" c
+                                             return $ c' ++ "[" ++ show n ++ "]"
 nameIndivEvent (ClockSyncIndiv c n t) = do c' <- getName "_t" c
                                            return $ c' ++ ":" ++ t
                                              ++ "[" ++ show n ++ "]"
 
 nameIndivEvent' :: Ord u => RecordedIndivEvent u -> State (Map.Map u String) (RecordedIndivEvent String)
-nameIndivEvent' (ChannelWrite c n) = do c' <- getName "_c" c
-                                        return $ ChannelWrite c' n
-nameIndivEvent' (ChannelRead c n) = do c' <- getName "_c" c
-                                       return $ ChannelRead c' n
-nameIndivEvent' (BarrierSyncIndiv c n) = do c' <- getName "_b" c
-                                            return $ BarrierSyncIndiv c' n
+nameIndivEvent' (ChannelWrite c n x) = do c' <- getName "_c" c
+                                          return $ ChannelWrite c' n x
+nameIndivEvent' (ChannelRead c n x) = do c' <- getName "_c" c
+                                         return $ ChannelRead c' n x
+nameIndivEvent' (BarrierSyncIndiv c n x) = do c' <- getName "_b" c
+                                              return $ BarrierSyncIndiv c' n x
 nameIndivEvent' (ClockSyncIndiv c n t) = do c' <- getName "_t" c
                                             return $ ClockSyncIndiv c' n t
 
 
-type TraceT = StateT TraceStore
+type TraceT = ReaderT TraceStore
 
 data TraceStore =
-  NoTrace
+  NoTrace ProcessId
   | Trace (ProcessId, TVar (ChannelLabels Unique), SubTraceStore)
 
-mapSubTrace :: (SubTraceStore -> SubTraceStore) -> TraceStore -> TraceStore
-mapSubTrace _ NoTrace = NoTrace
-mapSubTrace f (Trace (pid, tv, s)) = Trace (pid, tv, f s)
+mapSubTrace :: Monad m => (SubTraceStore -> m ()) -> TraceStore -> m ()
+mapSubTrace _ (NoTrace {}) = return ()
+mapSubTrace f (Trace (_pid, _tv, s)) = f s
 
 type ChannelLabels u = Map.Map u String
 
 data SubTraceStore =
-  Hierarchy (Structured (RecordedIndivEvent Unique))
+  Hierarchy (IORef (Structured (RecordedIndivEvent Unique)))
   | CSPTraceRev (TVar [(Int, [RecordedEvent Unique])])
   | VCRTraceRev (TVar [Set.Set (Set.Set ProcessId, RecordedEvent Unique)])
 
@@ -173,33 +183,45 @@
                        writeTVar tv $! foldl (flip addRLE) t (map fst news)
                   Trace (pid, _, VCRTraceRev tv) -> do
                     t <- readTVar tv
-                    let pidSet = (foldl Set.union (Set.singleton pid) $ map snd news)
-                        news' = map (\(a,b) -> (b,a)) news
-                        t' = case t of
-                                -- Trace previously empty:
-                               [] -> [Set.fromList news']
-                               (z:zs) | shouldMakeNewSetVCR pidSet z
-                                         -> Set.fromList news' : t
-                                      | otherwise
-                                          -> foldl (flip Set.insert) z news' : zs
+                    let news' = map (\(a,b) -> (b,a)) news
+                        pidSet = (foldl Set.union (Set.singleton pid) $ map fst news')
+                        t' = prependVCR t pidSet news'
                     writeTVar tv $! t'
                   _ -> return ()
 
+prependVCR :: Ord u =>
+             [Set.Set (Set.Set ProcessId, RecordedEvent u)]
+          -> Set.Set ProcessId
+          -> [(Set.Set ProcessId, RecordedEvent u)]
+          -> [Set.Set (Set.Set ProcessId, RecordedEvent u)]
+prependVCR t pidSet news'
+  = case t of
+      -- Trace previously empty:
+      [] -> [Set.fromList news']
+      (z:zs) | shouldMakeNewSetVCR pidSet z
+                 -> Set.fromList news' : t
+             | otherwise
+                 -> foldl (flip Set.insert) z news' : zs
+
 -- | Records an event where you were one of the people involved
 recordEvent :: [RecordedIndivEvent Unique] -> TraceT IO ()
-recordEvent e = modify $ mapSubTrace $ \(Hierarchy es) ->
-                  Hierarchy (addParEventsH (map StrEvent e) es)
+recordEvent e = ask >>= lift . mapSubTrace rec
+  where
+    rec (Hierarchy es) = modifyIORef es (addParEventsH (map StrEvent e))
+    rec _ = return ()
 
 mergeSubProcessTraces :: [TraceStore] -> TraceT IO ()
 mergeSubProcessTraces ts
-  = modify $ mapSubTrace $ \(Hierarchy es) -> Hierarchy (addParEventsH ts' es)
+  = ask >>= lift . mapSubTrace merge
   where
-    ts' = [t | Trace (_,_,Hierarchy t) <- ts]
+    ts' = mapM readIORef [t | Trace (_,_,Hierarchy t) <- ts]
+    merge (Hierarchy es) = ts' >>= modifyIORef es . addParEventsH
+    merge _ = return ()
 
-shouldMakeNewSetVCR :: Set.Set ProcessId -> Set.Set (Set.Set ProcessId, RecordedEvent Unique)
+shouldMakeNewSetVCR :: Ord u => Set.Set ProcessId -> Set.Set (Set.Set ProcessId, RecordedEvent u)
   -> Bool
-shouldMakeNewSetVCR newIds existingSet
-  = exists existingSet $ \(bigP,_) -> exists bigP $ \p -> exists newIds $ \q ->
+shouldMakeNewSetVCR newpids existingSet
+  = exists existingSet $ \(bigP,_) -> exists bigP $ \p -> exists newpids $ \q ->
       p `pidLessThanOrEqual` q
   where
     -- Like the any function (flipped), but for sets:
@@ -255,38 +277,49 @@
 addRLE x nes = (1,[x]):nes
 
 
-labelEvent :: Event -> String -> StateT TraceStore IO ()
+labelEvent :: Event -> String -> TraceT IO ()
 labelEvent e l
   = labelUnique (getEventUnique e) l
 
-labelUnique :: Unique -> String -> StateT TraceStore IO ()
+labelUnique :: Unique -> String -> TraceT IO ()
 labelUnique u l
-  = do t <- get
+  = do t <- ask
        case t of
-         NoTrace -> return ()
+         NoTrace {} -> return ()
          Trace (_,tvls,_) -> add tvls
   where
-    add :: TVar (Map.Map Unique String) -> StateT TraceStore IO ()
+    add :: TVar (Map.Map Unique String) -> TraceT IO ()
     add tv = liftIO $ atomically $ do
       m <- readTVar tv
       writeTVar tv $ Map.insert u l m
 
+newIds :: Int -> ProcessId -> [ProcessId]
+newIds n pid = let ProcessId parts = pid in
+  [ProcessId $ parts ++ [ParSeq i 0] | i <- [0 .. (n - 1)]]
 
 blankTraces :: TraceStore -> Int -> IO [TraceStore]
-blankTraces NoTrace n = return $ replicate n NoTrace
+blankTraces (NoTrace pid) n = return $ map NoTrace $ newIds n pid
 blankTraces (Trace (pid, tvls, subT)) n =
-  return [Trace (newId, tvls, newSubT) | newId <- newIds]
+  sequence [liftM (\s -> Trace (newId, tvls, s)) newSubT | newId <- newIds n pid]
   where
-    newIds :: [ProcessId]
-    newIds = let ProcessId parts = pid in
-      [ProcessId $ parts ++ [ParSeq i 0] | i <- [0 .. (n - 1)]]
-
-    newSubT :: SubTraceStore
+    newSubT :: IO SubTraceStore
     newSubT = case subT of
-      Hierarchy {} -> Hierarchy $ RevSeq []
-      _ -> subT
-
+      Hierarchy {} -> liftM Hierarchy $ newIORef $ RevSeq []
+      _ -> return subT
 
+-- Taken from base-4, as we only require base-3:
+chp_permutations            :: [b] -> [[b]]
+chp_permutations xs0        =  xs0 : perms xs0 []
+        where
+          perms []     _  = []
+          perms (t:ts) is = foldr interleave (perms ts (t:is)) (chp_permutations is)
+            where
+                interleave    xs     r = let (_,zs) = interleave' id xs r in zs
+                interleave' _ []     r = (ts, r)
+                interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+                                         in (y:us, f (t:y:us) : zs)
 
+bagsEq :: Eq a => [a] -> [a] -> Bool
+bagsEq a b = or [a' == b' | a' <- chp_permutations a, b' <- chp_permutations b]
 
         
diff --git a/Control/Concurrent/CHP/Traces/CSP.hs b/Control/Concurrent/CHP/Traces/CSP.hs
--- a/Control/Concurrent/CHP/Traces/CSP.hs
+++ b/Control/Concurrent/CHP/Traces/CSP.hs
@@ -29,7 +29,7 @@
 
 -- | This module contains support for CSP-style tracing.  A CSP trace is simply
 -- a flat list of events in the order in which they occurred.
-module Control.Concurrent.CHP.Traces.CSP (CSPTrace(..), runCHP_CSPTrace, runCHP_CSPTraceAndPrint) where
+module Control.Concurrent.CHP.Traces.CSP (CSPTrace(..), getCSPPlain, runCHP_CSPTrace, runCHP_CSPTraceAndPrint) where
 
 import Control.Concurrent.STM
 import Control.Monad.State
@@ -50,7 +50,8 @@
 instance Trace CSPTrace where
   emptyTrace = CSPTrace (Map.empty, [])
   runCHPAndTrace p = do tv <- atomically $ newTVar []
-                        runCHPProgramWith' (CSPTraceRev tv) toPublic p
+                        let st = CSPTraceRev tv
+                        runCHPProgramWith' st (flip toPublic st) p
 
   prettyPrint (CSPTrace (labels, events))
     = char '<' <+> (sep $ punctuate (char ',') $ evalState (mapM (liftM text . nameEvent) events) labels) <+> char '>'
@@ -63,6 +64,15 @@
   = do list <- atomically $ readTVar tv
        return $ CSPTrace (l, concatMap (\(n,es) -> concat $ replicate n $ reverse es) $ reverse list)
 toPublic _ _ = error "Error in CSP trace -- tracing type got switched"
+
+-- | A helper function for pulling out the interesting bit from a CSP trace processed
+-- by labelAll.
+--
+-- Added in version 1.5.0.
+getCSPPlain :: CSPTrace String -> [RecordedEvent String]
+getCSPPlain (CSPTrace (ls, t))
+  | Map.null ls = t
+  | otherwise = error "getCSPPlain: remaining unused labels"
 
 runCHP_CSPTrace :: CHP a -> IO (Maybe a, CSPTrace Unique)
 runCHP_CSPTrace = runCHPAndTrace
diff --git a/Control/Concurrent/CHP/Traces/Structural.hs b/Control/Concurrent/CHP/Traces/Structural.hs
--- a/Control/Concurrent/CHP/Traces/Structural.hs
+++ b/Control/Concurrent/CHP/Traces/Structural.hs
@@ -34,12 +34,13 @@
 -- sequentially and parallel-composed traces.  Note that in this tracing
 -- style, unlike CSP and VCR, events are recorded by /every/ process
 -- involved in them, not just once per occurrence.
-module Control.Concurrent.CHP.Traces.Structural (StructuralTrace(..), EventHierarchy(..), runCHP_StructuralTrace, runCHP_StructuralTraceAndPrint,
+module Control.Concurrent.CHP.Traces.Structural (StructuralTrace(..), EventHierarchy(..), getStructuralPlain, runCHP_StructuralTrace, runCHP_StructuralTraceAndPrint,
   getAllEventsInHierarchy) where
 
 import Control.Applicative hiding (empty)
 import Control.Monad.State
 import qualified Data.Foldable as F
+import Data.IORef
 import Data.List
 import qualified Data.Map as Map
 import Data.Maybe
@@ -54,12 +55,27 @@
 -- count is a replicator count for that list of sequential items.
 --
 -- The Show, Read, Foldable and Traversable instances were added in version 1.3.0.
+--
+-- The Eq instance was added in version 1.5.0.
 data EventHierarchy a =
   SingleEvent a
   | StructuralSequence Int [EventHierarchy a]
   | StructuralParallel [EventHierarchy a]
   deriving (Show, Read)
 
+instance Eq a => Eq (EventHierarchy a) where
+  (SingleEvent x) == (SingleEvent y) = x == y
+  (StructuralSequence m es) == (StructuralSequence m' es')
+    = concat (replicate m es) == concat (replicate m' es')
+  (StructuralParallel es) == (StructuralParallel es')
+    = es `bagsEq` es'
+
+  (StructuralSequence 1 [x]) == y = x == y
+  x == (StructuralSequence 1 [y]) = x == y
+  (StructuralParallel [x]) == y = x == y
+  x == (StructuralParallel [y]) = x == y
+  _ == _ = False
+
 instance Functor EventHierarchy where
   fmap f (SingleEvent x) = SingleEvent $ f x
   fmap f (StructuralSequence n es) = StructuralSequence n $ map (fmap f) es
@@ -93,7 +109,9 @@
 
 instance Trace StructuralTrace where
   emptyTrace = StructuralTrace (Map.empty, Nothing)
-  runCHPAndTrace p = runCHPProgramWith' (Hierarchy $ RevSeq []) toPublic p
+  runCHPAndTrace p = do trV <- newIORef $ RevSeq []
+                        let st = (Hierarchy trV)
+                        runCHPProgramWith' st (flip toPublic st) p
 
   prettyPrint (StructuralTrace (_,Nothing)) = empty
   prettyPrint (StructuralTrace (labels, Just h))
@@ -114,8 +132,9 @@
     = StructuralTrace (Map.empty, Just $ evalState (T.mapM nameIndivEvent' h) labels)
 
 toPublic :: ChannelLabels Unique -> SubTraceStore -> IO (StructuralTrace Unique)
-toPublic l (Hierarchy h)
-  = return $ StructuralTrace (l, conv h)
+toPublic l (Hierarchy hv)
+  = do h <- readIORef hv
+       return $ StructuralTrace (l, conv h)
   where
     nonEmptyListToMaybe :: ([a] -> b) -> [a] -> Maybe b
     nonEmptyListToMaybe _ [] = Nothing
@@ -136,6 +155,15 @@
         trans = mapToMaybe (StructuralSequence 1) (\(n,s) -> mapToMaybe (StructuralSequence n) conv $
           reverse s) rev
 toPublic _ _ = error "Error in Structural trace -- tracing type got switched"
+
+-- | A helper function for pulling out the interesting bit from a Structural trace processed
+-- by labelAll.
+--
+-- Added in version 1.5.0.
+getStructuralPlain :: StructuralTrace String -> Maybe (EventHierarchy (RecordedIndivEvent String))
+getStructuralPlain (StructuralTrace (ls, t))
+  | Map.null ls = t
+  | otherwise = error "getStructuralPlain: remaining unused labels"
 
 runCHP_StructuralTrace :: CHP a -> IO (Maybe a, StructuralTrace Unique)
 runCHP_StructuralTrace = runCHPAndTrace
diff --git a/Control/Concurrent/CHP/Traces/TraceOff.hs b/Control/Concurrent/CHP/Traces/TraceOff.hs
--- a/Control/Concurrent/CHP/Traces/TraceOff.hs
+++ b/Control/Concurrent/CHP/Traces/TraceOff.hs
@@ -30,13 +30,18 @@
 -- This module contains a trace-type that does not record anything.  This is
 -- generally not needed (just use runCSP without tracing) but is included in
 -- the library for completeness.
-module Control.Concurrent.CHP.Traces.TraceOff (TraceOff) where
+module Control.Concurrent.CHP.Traces.TraceOff (TraceOff, runCHP_TraceOff) where
 
+import Control.Monad
+import Data.Unique
+import Text.PrettyPrint.HughesPJ
+
 import Control.Concurrent.CHP.Base
+import Control.Concurrent.CHP.ProcessId
 import Control.Concurrent.CHP.Traces.Base
 
-import Text.PrettyPrint.HughesPJ
 
+
 -- | A trace type that does not record anything.
 newtype TraceOff a = TraceOff ()
 
@@ -44,9 +49,14 @@
   show = const ""
 
 instance Trace TraceOff where
-  runCHPAndTrace = runCHPProgramWith NoTrace (const $ TraceOff ())
+  runCHPAndTrace = liftM (flip (,) (TraceOff ())) . runCHPProgramWith (NoTrace rootProcessId)
   emptyTrace = TraceOff ()
   prettyPrint = const empty
   labelAll = const emptyTrace
 
 
+-- | A type-constrained version of 'runCHPAndTrace'.  This is semantically identical
+-- to 'runCHP', but this function is useful with the 'qcCHP'' function in the testing
+-- module.
+runCHP_TraceOff :: CHP a -> IO (Maybe a, TraceOff Unique)
+runCHP_TraceOff = runCHPAndTrace
diff --git a/Control/Concurrent/CHP/Traces/VCR.hs b/Control/Concurrent/CHP/Traces/VCR.hs
--- a/Control/Concurrent/CHP/Traces/VCR.hs
+++ b/Control/Concurrent/CHP/Traces/VCR.hs
@@ -31,7 +31,7 @@
 -- reasnoning trace is a list of sets of events.  Each set contains independent
 -- events that have no causal relationship between them.  Hopefully we will
 -- publish a paper explaining all this in detail soon.
-module Control.Concurrent.CHP.Traces.VCR (VCRTrace(..), runCHP_VCRTrace, runCHP_VCRTraceAndPrint) where
+module Control.Concurrent.CHP.Traces.VCR (VCRTrace(..), getVCRPlain, runCHP_VCRTrace, runCHP_VCRTraceAndPrint) where
 
 import Control.Concurrent.STM
 import Control.Monad.State
@@ -57,7 +57,8 @@
 instance Trace VCRTrace where
   emptyTrace = VCRTrace (Map.empty, [])
   runCHPAndTrace p = do tv <- atomically $ newTVar []
-                        runCHPProgramWith' (VCRTraceRev tv) toPublic p
+                        let st = VCRTraceRev tv
+                        runCHPProgramWith' st (flip toPublic st) p
 
   prettyPrint (VCRTrace (labels, eventSets))
     = char '<' <+> (sep $ punctuate (char ',') $ map (braces . sep . punctuate (char ',')) ropes) <+> char '>'
@@ -82,6 +83,14 @@
 nameVCR' :: Ord u => Set.Set (RecordedEvent u) -> State (ChannelLabels u) (Set.Set (RecordedEvent String))
 nameVCR' = liftM Set.fromList . mapM nameEvent' . Set.toList
 
+-- | A helper function for pulling out the interesting bit from a VCR trace processed
+-- by labelAll.
+--
+-- Added in version 1.5.0.
+getVCRPlain :: VCRTrace String -> [Set.Set (RecordedEvent String)]
+getVCRPlain (VCRTrace (ls, t))
+  | Map.null ls = t
+  | otherwise = error "getVCRPlain: remaining unused labels"
 
 runCHP_VCRTrace :: CHP a -> IO (Maybe a, VCRTrace Unique)
 runCHP_VCRTrace = runCHPAndTrace
diff --git a/Control/Concurrent/CHP/Utils.hs b/Control/Concurrent/CHP/Utils.hs
--- a/Control/Concurrent/CHP/Utils.hs
+++ b/Control/Concurrent/CHP/Utils.hs
@@ -156,6 +156,15 @@
 (|->|) p q x y = do c <- oneToOneChannel
                     runParallel_ [p x (writer c), q (reader c) y]
 
+-- | Like (|->|), but labels the channel and uses show for the traces.
+--
+-- Added in version 1.5.0.
+(|->|^) :: Show b => (a -> Chanout b ->  CHP ()) -> (String, Chanin b -> c -> CHP ()) ->
+  (a -> c -> CHP ())
+(|->|^) p (l, q) x y
+  = do c <- oneToOneChannel' $ chanLabel l
+       runParallel_ [p x (writer c), q (reader c) y]
+
 -- | Process composition that works with processes that connect with a channel in both
 -- directions.  Like (|->|), but connects a channel in each direction.
 --
@@ -208,4 +217,45 @@
 (<->|) p q x = do c <- oneToOneChannel
                   d <- oneToOneChannel
                   runParallel_ [p (reader d, writer c), q (reader c, writer d) x]
-                   
+
+{-
+-- Like runParallel, but offers a choice between the leading event of each
+-- parallel branch such that if any leading event of a parallel branch is
+-- poisoned, any siblings still waiting for their leading event will also be
+-- poisoned.  Note however that any handlers in the sibling branches will not
+-- execute, as technically they did not encounter poison.
+--
+-- If all the branches have just one event (e.g. a readChannel), this ensures that
+-- the parallel composition will not deadlock in the presence of poison.
+--
+-- Added in version 1.5.0.
+runParallelPoison :: [CHP a] -> CHP [a]
+runParallelPoison ps
+  = do b <- newBarrierWithLabel "runParallelPoison"
+       -- The barrier can never sync properly, but it can be poisoned:
+       enroll b $ const $ enrollList (replicate (length ps) b) $
+         \ebs -> runParallel $ zipWith useBar ebs ps
+  where
+    useBar :: EnrolledBarrier -> CHP a -> CHP a
+    useBar b p = (p <-> (syncBarrier b >> throwPoison)) `onPoisonRethrow` (poison b)
+
+-- Like runParallel_, but offers a choice between the leading event of each
+-- parallel branch such that if any leading event of a parallel branch is
+-- poisoned, any siblings still waiting for their leading event will also be
+-- poisoned.  Note however that any handlers in the sibling branches will not
+-- execute, as technically they did not encounter poison.
+--
+-- If all the branches have just one event (e.g. a readChannel), this ensures that
+-- the parallel composition will not deadlock in the presence of poison.
+--
+-- Added in version 1.5.0.
+runParallelPoison_ :: [CHP a] -> CHP ()
+runParallelPoison_ ps
+  = do b <- newBarrierWithLabel "runParallelPoison"
+       -- The barrier can never sync properly, but it can be poisoned:
+       enroll b $ const $ enrollList (replicate (length ps) b) $
+         \ebs -> runParallel_ $ zipWith useBar ebs ps
+  where
+    useBar :: EnrolledBarrier -> CHP a -> CHP a
+    useBar b p = (p <-> (syncBarrier b >> throwPoison)) `onPoisonRethrow` (poison b)
+-}
diff --git a/chp.cabal b/chp.cabal
--- a/chp.cabal
+++ b/chp.cabal
@@ -1,5 +1,5 @@
 Name:            chp
-Version:         1.4.0
+Version:         1.5.0
 Synopsis:        An implementation of concurrency ideas from Communicating Sequential Processes
 License:         BSD3
 License-file:    LICENSE
@@ -30,6 +30,11 @@
                  Control.Concurrent.CHP.BroadcastChannels
                  Control.Concurrent.CHP.Buffers
                  Control.Concurrent.CHP.Channels
+                 Control.Concurrent.CHP.Channels.BroadcastReduce
+                 Control.Concurrent.CHP.Channels.Communication
+                 Control.Concurrent.CHP.Channels.Creation
+                 Control.Concurrent.CHP.Channels.Ends
+                 Control.Concurrent.CHP.Channels.Synonyms
                  Control.Concurrent.CHP.Clocks
                  Control.Concurrent.CHP.Common
                  Control.Concurrent.CHP.Console
@@ -45,7 +50,8 @@
                  Control.Concurrent.CHP.Utils
 
 Other-modules:   Control.Concurrent.CHP.Base
-                 Control.Concurrent.CHP.CSP
+                 Control.Concurrent.CHP.Channels.Base
+                 Control.Concurrent.CHP.CSP                 
                  Control.Concurrent.CHP.Event
                  Control.Concurrent.CHP.Guard
                  Control.Concurrent.CHP.Mutex