diff --git a/Control/Concurrent/CML.hs b/Control/Concurrent/CML.hs
--- a/Control/Concurrent/CML.hs
+++ b/Control/Concurrent/CML.hs
@@ -3,7 +3,7 @@
 -- Module      :  Control.Concurrent.CML
 -- Copyright   :  Avik Chaudhuri 2009 (avik@cs.ucsc.edu)
 -- License     :  BSD3
--- 
+--
 -- Maintainer  :  ben.franksen@online.de
 -- Stability   :  provisional
 -- Portability :  portable
@@ -32,23 +32,26 @@
   spawn
 ) where
 
-import Control.Concurrent(ThreadId, forkIO)
 import Control.Concurrent.MVar(MVar, newEmptyMVar, putMVar, takeMVar)
-import Data.Maybe(isJust)
-import Control.Monad(foldM)
+import Control.Concurrent(ThreadId, forkIO)
 import Control.Monad.Fix(fix)
+import Control.Monad(foldM, forever)
+import Data.Maybe(isJust)
 
 --------------------------------------------------------------------------------
 
 type Commit = MVar Bool
 type Decision = MVar (Maybe Commit)
 type Candidate = MVar (Maybe Decision)
-type In a = MVar (Candidate, a -> Bool)
-type Out a = MVar (Candidate, a)
+type In a = MVar (Candidate, a -> Bool, Synchronizer)
+type Out a = MVar (Candidate, a, Synchronizer)
 
 -- | Values of type @a@ can be transported over channels of type @Channel a@.
 data Channel a = Channel (In a) (Out a) (MVar a)
 
+instance Eq (Channel a) where
+    Channel _ _ m1 == Channel _ _ m2 = m1 == m2
+
 type Point = MVar ()
 type Name = MVar [Point]
 type Abort = MVar ([Point], IO ())
@@ -69,74 +72,72 @@
 --------------------------------------------------------------------------------
 
 atchan :: In a -> Out a -> IO ()
-atchan i o = do {
-  (ei,patt) <- takeMVar i;
-  (eo,y) <- takeMVar o;
-  if (patt y) then do {
-    si <- newEmptyMVar;
-    putMVar ei (Just si);
-    ki <- takeMVar si;
-    so <- newEmptyMVar;
-    putMVar eo (Just so);
-    ko <- takeMVar so;
-    maybe (return ()) (\ci -> putMVar ci (isJust ko)) ki;
-    maybe (return ()) (\co -> putMVar co (isJust ki)) ko
-  }
-  else do {
-    putMVar ei Nothing;
-    putMVar eo Nothing;
-    atchan i o
-  }
-}
+atchan i o = do
+  (cand_i,patt,si) <- takeMVar i
+  (cand_o,y,so) <- takeMVar o
+  if (patt y && si /= so)
+    then do
+      dec_i <- newEmptyMVar
+      putMVar cand_i (Just dec_i)
+      ki <- takeMVar dec_i
+      dec_o <- newEmptyMVar
+      putMVar cand_o (Just dec_o)
+      ko <- takeMVar dec_o
+      maybe (return ()) (\ci -> putMVar ci (isJust ko)) ki
+      maybe (return ()) (\co -> putMVar co (isJust ki)) ko
+    else do
+      putMVar cand_i Nothing
+      putMVar cand_o Nothing
+      atchan i o
 
 atsync :: Synchronizer -> Abort -> IO () -> IO ()
-atsync r a x = do {
-  (t,s) <- takeMVar r;
-  forkIO $ fix $ \z -> do {
-    (t',s') <- takeMVar r;
-    forkIO z;
+atsync r a x = do
+  (t,s) <- takeMVar r
+  forkIO $ fix $ \z -> do
+    (_,s') <- takeMVar r
+    forkIO z
     putMVar s' Nothing
-  };
-  c <- newEmptyMVar;
-  putMVar s (Just c);
-  b <- takeMVar c;
-  if b then do {
-    putMVar t ();
-    fix $ \z -> do {
-      (tL,f) <- takeMVar a;
-      forkIO z;
-      if elem t tL then return ()
-      else f
-    }
-  }
-  else x
-}
+  c <- newEmptyMVar
+  putMVar s (Just c)
+  b <- takeMVar c
+  if b
+    then do
+      putMVar t ()
+      fix $ \z -> do
+        (tL,f) <- takeMVar a
+        forkIO z
+        if elem t tL
+          then return ()
+          else f
+    else x
 
 atpointI :: Synchronizer -> Point -> In a -> (a -> Bool) -> IO a -> IO a
-atpointI r t i patt x = do {
-  e <- newEmptyMVar;
-  putMVar i (e,patt);
-  ms <- takeMVar e;
-  maybe (atpointI r t i patt x) (\s -> do {
-      putMVar r (t,s);
-      takeMVar t;
-      x
-    }
-  ) ms
-}
+atpointI r t i patt x = do
+  e <- newEmptyMVar
+  putMVar i (e,patt,r)
+  ms <- takeMVar e
+  maybe
+    (atpointI r t i patt x)
+    (\s -> do
+       putMVar r (t,s)
+       takeMVar t
+       x
+    )
+    ms
 
 atpointO :: Synchronizer -> Point -> Out a -> a -> IO () -> IO ()
-atpointO r t o y x = do {
-  e <- newEmptyMVar;
-  putMVar o (e,y);
-  ms <- takeMVar e;
-  maybe (atpointO r t o y x) (\s -> do {
-      putMVar r (t,s);
-      takeMVar t;
-      x
-    }
-  ) ms
-}
+atpointO r t o y x = do
+  e <- newEmptyMVar
+  putMVar o (e,y,r)
+  ms <- takeMVar e
+  maybe
+    (atpointO r t o y x)
+    (\s -> do
+       putMVar r (t,s)
+       takeMVar t
+       x
+    )
+    ms
 
 --------------------------------------------------------------------------------
 
@@ -151,9 +152,7 @@
 channel = do
   i <- newEmptyMVar
   o <- newEmptyMVar
-  forkIO $ fix $ \z -> do
-    atchan i o
-    z
+  forkIO $ forever $ atchan i o
   m <- newEmptyMVar
   return (Channel i o m)
 
@@ -164,8 +163,8 @@
 -- event is eligible for synchronization with a @transmit c m@ only if @cond m@
 -- is true.
 receive :: Channel a -> (a -> Bool) -> Event a
-receive (Channel i o m) patt = Event efun where
-  efun r a n = do
+receive (Channel i _ m) patt = Event efun where
+  efun r _ n = do
     t <- newEmptyMVar
     forkIO (putMVar n [t])
     atpointI r t i patt (takeMVar m)
@@ -176,8 +175,8 @@
 -- sends the message @m@ on channel @c@ and returns @()@. Such an event must
 -- synchronize with @receive c@.
 transmit :: Channel a -> a -> Event ()
-transmit (Channel i o m) y = Event efun where
-  efun r a n = do
+transmit (Channel _ o m) y = Event efun where
+  efun r _ n = do
     t <- newEmptyMVar
     forkIO (putMVar n [t])
     atpointO r t o y (putMVar m y)
@@ -197,9 +196,7 @@
     j <- newEmptyMVar
     tL <- foldM (\tL -> \(Event v) -> do
         n' <- newEmptyMVar
-        forkIO $ do
-          x <- v r a n'
-          putMVar j x
+        forkIO $ v r a n' >>= putMVar j
         tL' <- takeMVar n'
         putMVar n' tL'
         return (tL' ++ tL)
@@ -214,9 +211,7 @@
 -- applied to the result.
 wrap :: Event a -> (a -> IO b) -> Event b
 wrap (Event v) f = Event efun where
-  efun r a n = do
-    x <- v r a n
-    f x
+  efun r a n = v r a n >>= f
 
 -- | Specify a pre-synchronization action.
 --
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -28,4 +28,3 @@
 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.
-
diff --git a/Log.hs b/Log.hs
new file mode 100644
--- /dev/null
+++ b/Log.hs
@@ -0,0 +1,49 @@
+module Log (logMsg, logFlush) where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TChan
+import Control.Monad
+import System.IO
+import System.IO.Unsafe
+
+{-# NOINLINE msgQ #-}
+{-# OPTIONS_GHC -fno-cse #-}
+
+msgQ :: MVar (Maybe (TChan (ThreadId,String)))
+msgQ = unsafePerformIO (newMVar Nothing)
+
+logMsg :: String -> IO ()
+logMsg msg = do
+  msgs <- maybeStart
+  mytid <- myThreadId
+  atomically $ writeTChan msgs (mytid, msg)
+
+logFlush :: IO ()
+logFlush = do
+  mq <- readMVar msgQ
+  case mq of
+    Nothing -> return ()
+    Just q  -> loop
+      where
+        loop = do
+          e <- atomically $ isEmptyTChan q
+          unless e $ do
+            threadDelay 1000000
+            loop
+
+maybeStart :: IO (TChan (ThreadId, String))
+maybeStart = modifyMVar msgQ maybeStart'
+  where
+    maybeStart' Nothing = do
+      msgs <- atomically newTChan
+      forkIO (logThread msgs)
+      return (Just msgs,msgs)
+    maybeStart' x@(Just msgs) = return (x,msgs)
+
+    logThread msgs = forever $ do
+      (tid,msg) <- atomically $ readTChan msgs
+      hPutStrLn stderr $ "["++show tid++"] "++msg
+
+test :: IO ()
+test = logMsg "message" >> threadDelay 100000 >> logFlush
diff --git a/cml.cabal b/cml.cabal
--- a/cml.cabal
+++ b/cml.cabal
@@ -1,17 +1,28 @@
-name:               cml
-version:            0.1.1
-synopsis:           Events and Channels as in Concurrent ML
+name:                cml
+version:             0.1.3
+synopsis:            Events and Channels as in Concurrent ML
 description:
     Implementation of Events and Channels as in CML
     (extended with communication guards).
     See /A Concurrent ML Library in Concurrent Haskell/ by Avik Chaudhuri
     (avik\@cs.umd.edu) for details. The original code as well as the papers can
     be found at <http://www.cs.umd.edu/~avik/projects/cmllch/>.
-category:           Concurrency
-license:            BSD3
-license-file:       LICENSE
-author:             Avik Chaudhuri
-maintainer:         ben.franksen@online.de
-build-depends:      base
-build-type:         Simple
-exposed-modules:    Control.Concurrent.CML
+category:            Concurrency
+license:             BSD3
+license-file:        LICENSE
+author:              Avik Chaudhuri
+maintainer:          ben.franksen@online.de
+homepage:            http://code.haskell.org/cml/
+cabal-version:       >= 1.6
+build-type:          Simple
+
+extra-source-files:  Log.hs,test.hs
+
+library
+    exposed-modules: Control.Concurrent.CML
+    build-depends:   base >= 3 && < 5
+    ghc-options:     -Wall
+
+source-repository head
+    type:            darcs
+    location:        http://code.haskell.org/cml/
diff --git a/test.hs b/test.hs
new file mode 100644
--- /dev/null
+++ b/test.hs
@@ -0,0 +1,59 @@
+module Main where
+
+import System.Environment (getArgs)
+
+import Control.Concurrent.CML
+
+import Log
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let n = case args of (arg:_) -> read arg; _ -> 1
+  mapM_ test ([1..n] :: [Integer])
+  getChar >> return ()
+
+test :: Integer -> IO ()
+test n = do
+  x <- channel
+  y <- channel
+  z <- channel
+
+  let abortTx = logMsgTest n "Aborted transmit on x"
+      abortRx = logMsgTest n "Aborted receive on x"
+      abortTy = logMsgTest n "Aborted transmit on y"
+      abortRy = logMsgTest n "Aborted receive on y"
+      abortTz = logMsgTest n "Aborted transmit on z"
+      abortRz = logMsgTest n "Aborted receive on z"
+      guardTx = logMsgTest n "Trying transmit on x"
+      guardRx = logMsgTest n "Trying receive on x"
+      guardTy = logMsgTest n "Trying transmit on y"
+      guardRy = logMsgTest n "Trying receive on y"
+      guardTz = logMsgTest n "Trying transmit on z"
+      guardRz = logMsgTest n "Trying receive on z"
+
+  let wrapTx _ = logMsgTest n "Done transmit on x"
+      wrapRx _ = logMsgTest n "Done receive on x"
+      wrapTy _ = logMsgTest n "Done transmit on y"
+      wrapRy _ = logMsgTest n "Done receive on y"
+      wrapTz _ = logMsgTest n "Done transmit on z"
+      wrapRz _ = logMsgTest n "Done receive on z"
+
+  spawn $ sync $ choose
+    [ guard (guardTx >> return (wrapabort abortTx (wrap (transmit x "Mx") wrapTx)))
+    , guard (guardTy >> return (wrapabort abortTy (wrap (transmit y "My") wrapTy)))
+    ]
+
+  spawn $ sync $ choose
+    [ guard (guardRy >> return (wrapabort abortRy (wrap (receive y (const True)) wrapRy)))
+    , guard (guardRx >> return (wrapabort abortRx (wrap (receive x (const True)) wrapRx)))
+    ]
+
+  spawn $ sync $ guard
+    (guardRz >> return (wrapabort abortRz (wrap (receive z (const True)) wrapRz)))
+
+  sync $ guard
+    (guardTz >> return (wrapabort abortTz (wrap (transmit z "Mz") wrapTz)))
+
+logMsgTest :: Integer -> String -> IO ()
+logMsgTest n s = logMsg $ "Test " ++ show n ++ ": " ++ s