Merge branch 'main' into unique-symbol-generation

Author: coot

io-classes/CHANGELOG.md

@@ -1,11 +1,16 @@
 # Revsion history of io-classes
 
-### next release
+## next release
 
+### Breaking changes
+
+### Non-breaking changes
+
+* Improved performance of `tryReadTBQueueDefault`.
 * Added module `Control.Monad.Class.MonadUnique` generalising `Data.Unique`.
 * mtl: Added module `Control.Monad.Class.MonadUnique.Trans` providing monad transformer instances for `MonadUnique`.
 
-### 1.8.0.1
+## 1.8.0.1
 
 * Added support for `ghc-9.2`.
 
@@ -30,13 +35,13 @@
   type classes.
 * Support ghc-9.12
 
-### 1.7.0.0
+## 1.7.0.0
 
 ### Breaking changes
 
 * Renamed `io-classes:io-classes-mtl` as `io-classes:mtl`.
 
-### 1.6.0.0
+## 1.6.0.0
 
 ### Breaking changes
 

io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs

@@ -919,12 +919,15 @@ tryReadTBQueueDefault (TBQueue rsize read _wsize write _size) = do
       return (Just x)
     [] -> do
       ys <- readTVar write
-      case reverse ys of
+      case ys of
         [] -> return Nothing
+        _  -> do
+          -- NB. lazy: we want the transaction to be
+          -- short, otherwise it will conflict
+          let ~(z,zs) = case reverse ys of
+                z':zs' -> (z',zs')
+                _      -> error "tryReadTBQueueDefault: impossible"
 
-        -- NB. lazy: we want the transaction to be
-        -- short, otherwise it will conflict
-        (z:zs)  -> do
           writeTVar write []
           writeTVar read zs
           return (Just z)

io-sim/CHANGELOG.md

@@ -7,8 +7,9 @@
 ### Non-breaking changes
 
 * Added support for unique symbol generation à la `Data.Unique`.
+* Removed a misleading internal comment.
 
-### 1.8.0.1
+## 1.8.0.1
 
 * Added support for `ghc-9.2`.
 

io-sim/src/Control/Monad/IOSim/STM.hs

@@ -148,8 +148,6 @@ tryReadTBQueueDefault (TBQueue queue _size) = do
       case reverse ys of
         [] -> return Nothing
 
-        -- NB. lazy: we want the transaction to be
-        -- short, otherwise it will conflict
         (z:zs) -> do
            writeTVar queue $! (zs, r', [], w)
            return (Just z)