Minor tweaks to tryReadTBQueueDefault

io-classes/CHANGELOG.md

@@ -1,5 +1,13 @@
 # Revsion history of io-classes
 
+### next version
+
+### Breaking changes
+
+### Non-breaking changes
+
+* Improved performance of `tryReadTBQueueDefault`.
+
 ### 1.8.0.1
 
 * Added support for `ghc-9.2`.

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

@@ -6,6 +6,8 @@
 
 ### Non-breaking changes
 
+* Removed a misleading internal comment.
+
 ### 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)