diff --git a/Control/Concurrent/STM.hs b/Control/Concurrent/STM.hs
--- a/Control/Concurrent/STM.hs
+++ b/Control/Concurrent/STM.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE CPP #-}
 
-#if __GLASGOW_HASKELL__ >= 701
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
 #endif
 
@@ -9,7 +11,7 @@
 -- Module      :  Control.Concurrent.STM
 -- Copyright   :  (c) The University of Glasgow 2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
@@ -18,20 +20,22 @@
 -- abstraction.  See
 --
 --  * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon
---    Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles
---    and Practice of Parallel Programming/ 2005.
---    <http://research.microsoft.com/Users/simonpj/papers/stm/index.htm>
+--    Peyton Jones, and Maurice Herlihy, in
+--    /ACM Conference on Principles and Practice of Parallel Programming/ 2005.
+--    <https://www.microsoft.com/en-us/research/publication/composable-memory-transactions/>
 --
 -----------------------------------------------------------------------------
 
 module Control.Concurrent.STM (
-	module Control.Monad.STM,
-	module Control.Concurrent.STM.TVar,
+        module Control.Monad.STM,
+        module Control.Concurrent.STM.TVar,
 #ifdef __GLASGOW_HASKELL__
-	module Control.Concurrent.STM.TMVar,
-	module Control.Concurrent.STM.TChan,
+        module Control.Concurrent.STM.TMVar,
+        module Control.Concurrent.STM.TChan,
+        module Control.Concurrent.STM.TQueue,
+        module Control.Concurrent.STM.TBQueue,
 #endif
-	module Control.Concurrent.STM.TArray
+        module Control.Concurrent.STM.TArray
   ) where
 
 import Control.Monad.STM
@@ -41,3 +45,5 @@
 import Control.Concurrent.STM.TChan
 #endif
 import Control.Concurrent.STM.TArray
+import Control.Concurrent.STM.TQueue
+import Control.Concurrent.STM.TBQueue
diff --git a/Control/Concurrent/STM/TArray.hs b/Control/Concurrent/STM/TArray.hs
--- a/Control/Concurrent/STM/TArray.hs
+++ b/Control/Concurrent/STM/TArray.hs
@@ -4,17 +4,25 @@
 {-# LANGUAGE Trustworthy #-}
 #endif
 
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 904
+#define HAS_UNLIFTED_ARRAY 1
+#endif
+
+#if defined(HAS_UNLIFTED_ARRAY)
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Concurrent.STM.TArray
 -- Copyright   :  (c) The University of Glasgow 2005
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
 --
--- TArrays: transactional arrays, for use in the STM monad
+-- TArrays: transactional arrays, for use in the STM monad.
 --
 -----------------------------------------------------------------------------
 
@@ -22,41 +30,99 @@
     TArray
 ) where
 
-import Data.Array (Array, bounds)
-import Data.Array.Base (listArray, arrEleBottom, unsafeAt, MArray(..),
-                        IArray(numElements))
-import Data.Ix (rangeSize)
+import Control.Monad.STM (STM, atomically)
 import Data.Typeable (Typeable)
-import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar)
-#ifdef __GLASGOW_HASKELL__
-import GHC.Conc (STM)
+#if defined(HAS_UNLIFTED_ARRAY)
+import Control.Concurrent.STM.TVar (readTVar, readTVarIO, writeTVar)
+import Data.Array.Base (safeRangeSize, MArray(..))
+import Data.Ix (Ix)
+import GHC.Conc (STM(..), TVar(..))
+import GHC.Exts
+import GHC.IO (IO(..))
 #else
-import Control.Sequential.STM (STM)
+import Control.Concurrent.STM.TVar (TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar)
+import Data.Array (Array, bounds, listArray)
+import Data.Array.Base (safeRangeSize, unsafeAt, MArray(..), IArray(numElements))
 #endif
 
--- |TArray is a transactional array, supporting the usual 'MArray'
+-- | 'TArray' is a transactional array, supporting the usual 'MArray'
 -- interface for mutable arrays.
 --
--- It is currently implemented as @Array ix (TVar e)@,
--- but it may be replaced by a more efficient implementation in the future
--- (the interface will remain the same, however).
---
+-- It is conceptually implemented as @Array i (TVar e)@.
+#if defined(HAS_UNLIFTED_ARRAY)
+data TArray i e = TArray
+    !i   -- lower bound
+    !i   -- upper bound
+    !Int -- size
+    (Array# (TVar# RealWorld e))
+    deriving (Typeable)
+
+instance (Eq i, Eq e) => Eq (TArray i e) where
+    (TArray l1 u1 n1 arr1#) == (TArray l2 u2 n2 arr2#) =
+        -- each `TArray` has its own `TVar`s, so it's sufficient to compare the first one
+        if n1 == 0 then n2 == 0 else l1 == l2 && u1 == u2 && isTrue# (sameTVar# (unsafeFirstT arr1#) (unsafeFirstT arr2#))
+      where
+        unsafeFirstT :: Array# (TVar# RealWorld e) -> TVar# RealWorld e
+        unsafeFirstT arr# = case indexArray# arr# 0# of (# e #) -> e
+
+newTArray# :: Ix i => (i, i) -> e -> State# RealWorld -> (# State# RealWorld, TArray i e #)
+newTArray# b@(l, u) e = \s1# ->
+    case safeRangeSize b of
+        n@(I# n#) -> case newTVar# e s1# of
+            (# s2#, initial_tvar# #) -> case newArray# n# initial_tvar# s2# of
+                (# s3#, marr# #) ->
+                    let go i# = \s4# -> case newTVar# e s4# of
+                            (# s5#, tvar# #) -> case writeArray# marr# i# tvar# s5# of
+                                s6# -> if isTrue# (i# ==# n# -# 1#) then s6# else go (i# +# 1#) s6#
+                    in case unsafeFreezeArray# marr# (if n <= 1 then s3# else go 1# s3#) of
+                        (# s7#, arr# #) -> (# s7#, TArray l u n arr# #)
+
+instance MArray TArray e STM where
+    getBounds (TArray l u _ _) = return (l, u)
+    getNumElements (TArray _ _ n _) = return n
+    newArray b e = STM $ newTArray# b e
+    unsafeRead (TArray _ _ _ arr#) (I# i#) = case indexArray# arr# i# of
+        (# tvar# #) -> readTVar (TVar tvar#)
+    unsafeWrite (TArray _ _ _ arr#) (I# i#) e = case indexArray# arr# i# of
+        (# tvar# #) -> writeTVar (TVar tvar#) e
+
+-- | Writes are slow in `IO`.
+instance MArray TArray e IO where
+    getBounds (TArray l u _ _) = return (l, u)
+    getNumElements (TArray _ _ n _) = return n
+    newArray b e = IO $ newTArray# b e
+    unsafeRead (TArray _ _ _ arr#) (I# i#) = case indexArray# arr# i# of
+        (# tvar# #) -> readTVarIO (TVar tvar#)
+    unsafeWrite (TArray _ _ _ arr#) (I# i#) e = case indexArray# arr# i# of
+        (# tvar# #) -> atomically $ writeTVar (TVar tvar#) e
+#else
 newtype TArray i e = TArray (Array i (TVar e)) deriving (Eq, Typeable)
 
 instance MArray TArray e STM where
     getBounds (TArray a) = return (bounds a)
+    getNumElements (TArray a) = return (numElements a)
     newArray b e = do
-        a <- rep (rangeSize b) (newTVar e)
-        return $ TArray (listArray b a)
-    newArray_ b = do
-        a <- rep (rangeSize b) (newTVar arrEleBottom)
+        a <- rep (safeRangeSize b) (newTVar e)
         return $ TArray (listArray b a)
     unsafeRead (TArray a) i = readTVar $ unsafeAt a i
     unsafeWrite (TArray a) i e = writeTVar (unsafeAt a i) e
+
+    {-# INLINE newArray #-}
+
+-- | Writes are slow in `IO`.
+instance MArray TArray e IO where
+    getBounds (TArray a) = return (bounds a)
     getNumElements (TArray a) = return (numElements a)
+    newArray b e = do
+        a <- rep (safeRangeSize b) (newTVarIO e)
+        return $ TArray (listArray b a)
+    unsafeRead (TArray a) i = readTVarIO $ unsafeAt a i
+    unsafeWrite (TArray a) i e = atomically $ writeTVar (unsafeAt a i) e
 
--- | Like 'replicateM' but uses an accumulator to prevent stack overflows.
--- Unlike 'replicateM' the returned list is in reversed order.
+    {-# INLINE newArray #-}
+
+-- | Like 'replicateM', but uses an accumulator to prevent stack overflows.
+-- Unlike 'replicateM', the returned list is in reversed order.
 -- This doesn't matter though since this function is only used to create
 -- arrays with identical elements.
 rep :: Monad m => Int -> m a -> m [a]
@@ -65,4 +131,5 @@
       go 0 xs = return xs
       go i xs = do
           x <- m
-          go (i-1) (x:xs)
+          go (i - 1) (x : xs)
+#endif
diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/STM/TBQueue.hs
@@ -0,0 +1,249 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy        #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.STM.TBQueue
+-- Copyright   :  (c) The University of Glasgow 2012
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires STM)
+--
+-- 'TBQueue' is a bounded version of 'TQueue'. The queue has a maximum
+-- capacity set when it is created.  If the queue already contains the
+-- maximum number of elements, then 'writeTBQueue' retries until an
+-- element is removed from the queue.
+--
+-- The implementation is based on an array to obtain /O(1)/
+-- enqueue and dequeue operations.
+--
+-- @since 2.4
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.STM.TBQueue (
+    -- * TBQueue
+    TBQueue,
+    newTBQueue,
+    newTBQueueIO,
+    readTBQueue,
+    tryReadTBQueue,
+    flushTBQueue,
+    peekTBQueue,
+    tryPeekTBQueue,
+    writeTBQueue,
+    unGetTBQueue,
+    lengthTBQueue,
+    isEmptyTBQueue,
+    isFullTBQueue,
+    capacityTBQueue,
+  ) where
+
+import           Control.Monad   (unless)
+import           Data.Typeable   (Typeable)
+import           GHC.Conc        (STM, TVar, newTVar, newTVarIO, orElse,
+                                  readTVar, retry, writeTVar)
+import           Numeric.Natural (Natural)
+import           Prelude         hiding (read)
+
+-- | 'TBQueue' is an abstract type representing a bounded FIFO channel.
+--
+-- @since 2.4
+data TBQueue a
+   = TBQueue {-# UNPACK #-} !(TVar Natural) -- CR:  read capacity
+             {-# UNPACK #-} !(TVar [a])     -- R:   elements waiting to be read
+             {-# UNPACK #-} !(TVar Natural) -- CW:  write capacity
+             {-# UNPACK #-} !(TVar [a])     -- W:   elements written (head is most recent)
+                            !(Natural)      -- CAP: initial capacity
+  deriving Typeable
+
+instance Eq (TBQueue a) where
+  TBQueue a _ _ _ _ == TBQueue b _ _ _ _ = a == b
+
+-- Total channel capacity remaining is CR + CW. Reads only need to
+-- access CR, writes usually need to access only CW but sometimes need
+-- CR.  So in the common case we avoid contention between CR and CW.
+--
+--   - when removing an element from R:
+--     CR := CR + 1
+--
+--   - when adding an element to W:
+--     if CW is non-zero
+--         then CW := CW - 1
+--         then if CR is non-zero
+--                 then CW := CR - 1; CR := 0
+--                 else **FULL**
+
+-- | Builds and returns a new instance of 'TBQueue'.
+newTBQueue :: Natural   -- ^ maximum number of elements the queue can hold
+           -> STM (TBQueue a)
+newTBQueue size = do
+  read  <- newTVar []
+  write <- newTVar []
+  rsize <- newTVar 0
+  wsize <- newTVar size
+  return (TBQueue rsize read wsize write size)
+
+-- | @IO@ version of 'newTBQueue'.  This is useful for creating top-level
+-- 'TBQueue's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTBQueueIO :: Natural -> IO (TBQueue a)
+newTBQueueIO size = do
+  read  <- newTVarIO []
+  write <- newTVarIO []
+  rsize <- newTVarIO 0
+  wsize <- newTVarIO size
+  return (TBQueue rsize read wsize write size)
+
+-- |Write a value to a 'TBQueue'; blocks if the queue is full.
+writeTBQueue :: TBQueue a -> a -> STM ()
+writeTBQueue (TBQueue rsize _read wsize write _size) a = do
+  w <- readTVar wsize
+  if (w > 0)
+     then do writeTVar wsize $! w - 1
+     else do
+          r <- readTVar rsize
+          if (r > 0)
+             then do writeTVar rsize 0
+                     writeTVar wsize $! r - 1
+             else retry
+  listend <- readTVar write
+  writeTVar write (a:listend)
+
+-- |Read the next value from the 'TBQueue'.
+readTBQueue :: TBQueue a -> STM a
+readTBQueue (TBQueue rsize read _wsize write _size) = do
+  xs <- readTVar read
+  r <- readTVar rsize
+  writeTVar rsize $! r + 1
+  case xs of
+    (x:xs') -> do
+      writeTVar read xs'
+      return x
+    [] -> do
+      ys <- readTVar write
+      case ys of
+        [] -> retry
+        _  -> 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 "readTBQueue: impossible"
+          writeTVar write []
+          writeTVar read zs
+          return z
+
+-- | A version of 'readTBQueue' which does not retry. Instead it
+-- returns @Nothing@ if no value is available.
+tryReadTBQueue :: TBQueue a -> STM (Maybe a)
+tryReadTBQueue q = fmap Just (readTBQueue q) `orElse` return Nothing
+
+-- | Efficiently read the entire contents of a 'TBQueue' into a list. This
+-- function never retries.
+--
+-- @since 2.4.5
+flushTBQueue :: TBQueue a -> STM [a]
+flushTBQueue (TBQueue rsize read wsize write size) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  if null xs && null ys
+    then return []
+    else do
+      unless (null xs) $ writeTVar read []
+      unless (null ys) $ writeTVar write []
+      writeTVar rsize 0
+      writeTVar wsize size
+      return (xs ++ reverse ys)
+
+-- | Get the next value from the @TBQueue@ without removing it,
+-- retrying if the channel is empty.
+peekTBQueue :: TBQueue a -> STM a
+peekTBQueue (TBQueue _ read _ write _) = do
+  xs <- readTVar read
+  case xs of
+    (x:_) -> return x
+    [] -> do
+      ys <- readTVar write
+      case ys of
+        [] -> retry
+        _  -> do
+          let (z:zs) = reverse ys -- NB. lazy: we want the transaction to be
+                                  -- short, otherwise it will conflict
+          writeTVar write []
+          writeTVar read (z:zs)
+          return z
+
+-- | A version of 'peekTBQueue' which does not retry. Instead it
+-- returns @Nothing@ if no value is available.
+tryPeekTBQueue :: TBQueue a -> STM (Maybe a)
+tryPeekTBQueue c = do
+  m <- tryReadTBQueue c
+  case m of
+    Nothing -> return Nothing
+    Just x  -> do
+      unGetTBQueue c x
+      return m
+
+-- | Put a data item back onto a channel, where it will be the next item read.
+-- Blocks if the queue is full.
+unGetTBQueue :: TBQueue a -> a -> STM ()
+unGetTBQueue (TBQueue rsize read wsize _write _size) a = do
+  r <- readTVar rsize
+  if (r > 0)
+     then do writeTVar rsize $! r - 1
+     else do
+          w <- readTVar wsize
+          if (w > 0)
+             then writeTVar wsize $! w - 1
+             else retry
+  xs <- readTVar read
+  writeTVar read (a:xs)
+
+-- | Return the length of a 'TBQueue'.
+--
+-- @since 2.5.0.0
+lengthTBQueue :: TBQueue a -> STM Natural
+lengthTBQueue (TBQueue rsize _read wsize _write size) = do
+  r <- readTVar rsize
+  w <- readTVar wsize
+  return $! size - r - w
+
+-- | Returns 'True' if the supplied 'TBQueue' is empty.
+isEmptyTBQueue :: TBQueue a -> STM Bool
+isEmptyTBQueue (TBQueue _rsize read _wsize write _size) = do
+  xs <- readTVar read
+  case xs of
+    (_:_) -> return False
+    [] -> do ys <- readTVar write
+             case ys of
+               [] -> return True
+               _  -> return False
+
+-- | Returns 'True' if the supplied 'TBQueue' is full.
+--
+-- @since 2.4.3
+isFullTBQueue :: TBQueue a -> STM Bool
+isFullTBQueue (TBQueue rsize _read wsize _write _size) = do
+  w <- readTVar wsize
+  if (w > 0)
+     then return False
+     else do
+         r <- readTVar rsize
+         if (r > 0)
+            then return False
+            else return True
+
+-- | The maximum number of elements the queue can hold.
+--
+-- @since 2.5.2.0
+capacityTBQueue :: TBQueue a -> Natural
+capacityTBQueue (TBQueue _ _ _ _ cap) = fromIntegral cap
diff --git a/Control/Concurrent/STM/TChan.hs b/Control/Concurrent/STM/TChan.hs
--- a/Control/Concurrent/STM/TChan.hs
+++ b/Control/Concurrent/STM/TChan.hs
@@ -10,7 +10,7 @@
 -- Module      :  Control.Concurrent.STM.TChan
 -- Copyright   :  (c) The University of Glasgow 2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
@@ -22,18 +22,25 @@
 
 module Control.Concurrent.STM.TChan (
 #ifdef __GLASGOW_HASKELL__
-	-- * TChans
-	TChan,
-	newTChan,
-	newTChanIO,
-	readTChan,
-	tryReadTChan,
-	peekTChan,
-	tryPeekTChan,
-	writeTChan,
-	dupTChan,
-	unGetTChan,
-	isEmptyTChan
+        -- * TChans
+        TChan,
+
+        -- ** Construction
+        newTChan,
+        newTChanIO,
+        newBroadcastTChan,
+        newBroadcastTChanIO,
+        dupTChan,
+        cloneTChan,
+
+        -- ** Reading and writing
+        readTChan,
+        tryReadTChan,
+        peekTChan,
+        tryPeekTChan,
+        writeTChan,
+        unGetTChan,
+        isEmptyTChan
 #endif
   ) where
 
@@ -42,13 +49,17 @@
 
 import Data.Typeable (Typeable)
 
+#define _UPK_(x) {-# UNPACK #-} !(x)
+
 -- | 'TChan' is an abstract type representing an unbounded FIFO channel.
-data TChan a = TChan (TVar (TVarList a)) (TVar (TVarList a)) deriving Typeable
+data TChan a = TChan _UPK_(TVar (TVarList a))
+                     _UPK_(TVar (TVarList a))
+  deriving (Eq, Typeable)
 
 type TVarList a = TVar (TList a)
-data TList a = TNil | TCons a (TVarList a)
+data TList a = TNil | TCons a _UPK_(TVarList a)
 
--- |Build and returns a new instance of 'TChan'
+-- |Build and return a new instance of 'TChan'
 newTChan :: STM (TChan a)
 newTChan = do
   hole <- newTVar TNil
@@ -67,6 +78,42 @@
   write <- newTVarIO hole
   return (TChan read write)
 
+-- | Create a write-only 'TChan'.  More precisely, 'readTChan' will 'retry'
+-- even after items have been written to the channel.  The only way to read
+-- a broadcast channel is to duplicate it with 'dupTChan'.
+--
+-- Consider a server that broadcasts messages to clients:
+--
+-- >serve :: TChan Message -> Client -> IO loop
+-- >serve broadcastChan client = do
+-- >    myChan <- dupTChan broadcastChan
+-- >    forever $ do
+-- >        message <- readTChan myChan
+-- >        send client message
+--
+-- The problem with using 'newTChan' to create the broadcast channel is that if
+-- it is only written to and never read, items will pile up in memory.  By
+-- using 'newBroadcastTChan' to create the broadcast channel, items can be
+-- garbage collected after clients have seen them.
+--
+-- @since 2.4
+newBroadcastTChan :: STM (TChan a)
+newBroadcastTChan = do
+    write_hole <- newTVar TNil
+    read <- newTVar (error "reading from a TChan created by newBroadcastTChan; use dupTChan first")
+    write <- newTVar write_hole
+    return (TChan read write)
+
+-- | @IO@ version of 'newBroadcastTChan'.
+--
+-- @since 2.4
+newBroadcastTChanIO :: IO (TChan a)
+newBroadcastTChanIO = do
+    write_hole <- newTVarIO TNil
+    read <- newTVarIO (error "reading from a TChan created by newBroadcastTChanIO; use dupTChan first")
+    write <- newTVarIO write_hole
+    return (TChan read write)
+
 -- |Write a value to a 'TChan'.
 writeTChan :: TChan a -> a -> STM ()
 writeTChan (TChan _read write) a = do
@@ -83,11 +130,13 @@
   case head of
     TNil -> retry
     TCons a tail -> do
-	writeTVar read tail
-	return a
+        writeTVar read tail
+        return a
 
 -- | A version of 'readTChan' which does not retry. Instead it
 -- returns @Nothing@ if no value is available.
+--
+-- @since 2.3
 tryReadTChan :: TChan a -> STM (Maybe a)
 tryReadTChan (TChan read _write) = do
   listhead <- readTVar read
@@ -100,6 +149,8 @@
 
 -- | Get the next value from the @TChan@ without removing it,
 -- retrying if the channel is empty.
+--
+-- @since 2.3
 peekTChan :: TChan a -> STM a
 peekTChan (TChan read _write) = do
   listhead <- readTVar read
@@ -110,6 +161,8 @@
 
 -- | A version of 'peekTChan' which does not retry. Instead it
 -- returns @Nothing@ if no value is available.
+--
+-- @since 2.3
 tryPeekTChan :: TChan a -> STM (Maybe a)
 tryPeekTChan (TChan read _write) = do
   listhead <- readTVar read
@@ -124,7 +177,7 @@
 -- everyone else.
 dupTChan :: TChan a -> STM (TChan a)
 dupTChan (TChan _read write) = do
-  hole <- readTVar write  
+  hole <- readTVar write
   new_read <- newTVar hole
   return (TChan new_read write)
 
@@ -143,4 +196,14 @@
   case head of
     TNil -> return True
     TCons _ _ -> return False
+
+-- |Clone a 'TChan': similar to dupTChan, but the cloned channel starts with the
+-- same content available as the original channel.
+--
+-- @since 2.4
+cloneTChan :: TChan a -> STM (TChan a)
+cloneTChan (TChan read write) = do
+  readpos <- readTVar read
+  new_read <- newTVar readpos
+  return (TChan new_read write)
 #endif
diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs
--- a/Control/Concurrent/STM/TMVar.hs
+++ b/Control/Concurrent/STM/TMVar.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
@@ -9,7 +9,7 @@
 -- Module      :  Control.Concurrent.STM.TMVar
 -- Copyright   :  (c) The University of Glasgow 2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
@@ -21,25 +21,29 @@
 
 module Control.Concurrent.STM.TMVar (
 #ifdef __GLASGOW_HASKELL__
-	-- * TMVars
-	TMVar,
-	newTMVar,
-	newEmptyTMVar,
-	newTMVarIO,
-	newEmptyTMVarIO,
-	takeTMVar,
-	putTMVar,
-	readTMVar,	
-	tryReadTMVar,
-	swapTMVar,
-	tryTakeTMVar,
-	tryPutTMVar,
-	isEmptyTMVar
+        -- * TMVars
+        TMVar,
+        newTMVar,
+        newEmptyTMVar,
+        newTMVarIO,
+        newEmptyTMVarIO,
+        takeTMVar,
+        putTMVar,
+        readTMVar,
+        writeTMVar,
+        tryReadTMVar,
+        swapTMVar,
+        tryTakeTMVar,
+        tryPutTMVar,
+        isEmptyTMVar,
+        mkWeakTMVar
 #endif
   ) where
 
 #ifdef __GLASGOW_HASKELL__
+import GHC.Base
 import GHC.Conc
+import GHC.Weak
 
 import Data.Typeable (Typeable)
 
@@ -81,7 +85,7 @@
   return (TMVar t)
 
 -- |Return the contents of the 'TMVar'.  If the 'TMVar' is currently
--- empty, the transaction will 'retry'.  After a 'takeTMVar', 
+-- empty, the transaction will 'retry'.  After a 'takeTMVar',
 -- the 'TMVar' is left empty.
 takeTMVar :: TMVar a -> STM a
 takeTMVar (TMVar t) = do
@@ -132,6 +136,8 @@
 
 -- | A version of 'readTMVar' which does not retry. Instead it
 -- returns @Nothing@ if no value is available.
+--
+-- @since 2.3
 tryReadTMVar :: TMVar a -> STM (Maybe a)
 tryReadTMVar (TMVar t) = readTVar t
 
@@ -143,6 +149,13 @@
     Nothing -> retry
     Just old -> do writeTVar t (Just new); return old
 
+-- | Non-blocking write of a new value to a 'TMVar'
+-- Puts if empty. Replaces if populated.
+--
+-- @since 2.5.1
+writeTMVar :: TMVar a -> a -> STM ()
+writeTMVar (TMVar t) new = writeTVar t (Just new)
+
 -- |Check whether a given 'TMVar' is empty.
 isEmptyTMVar :: TMVar a -> STM Bool
 isEmptyTMVar (TMVar t) = do
@@ -150,4 +163,12 @@
   case m of
     Nothing -> return True
     Just _  -> return False
+
+-- | Make a 'Weak' pointer to a 'TMVar', using the second argument as
+-- a finalizer to run when the 'TMVar' is garbage-collected.
+--
+-- @since 2.4.4
+mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a))
+mkWeakTMVar tmv@(TMVar (TVar t#)) (IO finalizer) = IO $ \s ->
+    case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #)
 #endif
diff --git a/Control/Concurrent/STM/TQueue.hs b/Control/Concurrent/STM/TQueue.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/STM/TQueue.hs
@@ -0,0 +1,167 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.STM.TQueue
+-- Copyright   :  (c) The University of Glasgow 2012
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires STM)
+--
+-- A 'TQueue' is like a 'TChan', with two important differences:
+--
+--  * it has faster throughput than both 'TChan' and 'Chan' (although
+--    the costs are amortised, so the cost of individual operations
+--    can vary a lot).
+--
+--  * it does /not/ provide equivalents of the 'dupTChan' and
+--    'cloneTChan' operations.
+--
+-- The implementation is based on the traditional purely-functional
+-- queue representation that uses two lists to obtain amortised /O(1)/
+-- enqueue and dequeue operations.
+--
+-- @since 2.4
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.STM.TQueue (
+        -- * TQueue
+        TQueue,
+        newTQueue,
+        newTQueueIO,
+        readTQueue,
+        tryReadTQueue,
+        flushTQueue,
+        peekTQueue,
+        tryPeekTQueue,
+        writeTQueue,
+        unGetTQueue,
+        isEmptyTQueue,
+  ) where
+
+import GHC.Conc
+import Control.Monad (unless)
+import Data.Typeable (Typeable)
+
+-- | 'TQueue' is an abstract type representing an unbounded FIFO channel.
+--
+-- @since 2.4
+data TQueue a = TQueue {-# UNPACK #-} !(TVar [a])
+                       {-# UNPACK #-} !(TVar [a])
+  deriving Typeable
+
+instance Eq (TQueue a) where
+  TQueue a _ == TQueue b _ = a == b
+
+-- |Build and returns a new instance of 'TQueue'
+newTQueue :: STM (TQueue a)
+newTQueue = do
+  read  <- newTVar []
+  write <- newTVar []
+  return (TQueue read write)
+
+-- |@IO@ version of 'newTQueue'.  This is useful for creating top-level
+-- 'TQueue's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTQueueIO :: IO (TQueue a)
+newTQueueIO = do
+  read  <- newTVarIO []
+  write <- newTVarIO []
+  return (TQueue read write)
+
+-- |Write a value to a 'TQueue'.
+writeTQueue :: TQueue a -> a -> STM ()
+writeTQueue (TQueue _read write) a = do
+  listend <- readTVar write
+  writeTVar write (a:listend)
+
+-- |Read the next value from the 'TQueue'.
+readTQueue :: TQueue a -> STM a
+readTQueue (TQueue read write) = do
+  xs <- readTVar read
+  case xs of
+    (x:xs') -> do
+      writeTVar read xs'
+      return x
+    [] -> do
+      ys <- readTVar write
+      case ys of
+        [] -> retry
+        _  -> do
+          let (z:zs) = reverse ys -- NB. lazy: we want the transaction to be
+                                  -- short, otherwise it will conflict
+          writeTVar write []
+          writeTVar read zs
+          return z
+
+-- | A version of 'readTQueue' which does not retry. Instead it
+-- returns @Nothing@ if no value is available.
+tryReadTQueue :: TQueue a -> STM (Maybe a)
+tryReadTQueue c = fmap Just (readTQueue c) `orElse` return Nothing
+
+-- | Efficiently read the entire contents of a 'TQueue' into a list. This
+-- function never retries.
+--
+-- @since 2.4.5
+flushTQueue :: TQueue a -> STM [a]
+flushTQueue (TQueue read write) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  unless (null xs) $ writeTVar read []
+  unless (null ys) $ writeTVar write []
+  return (xs ++ reverse ys)
+
+-- | Get the next value from the @TQueue@ without removing it,
+-- retrying if the channel is empty.
+peekTQueue :: TQueue a -> STM a
+peekTQueue (TQueue read write) = do
+  xs <- readTVar read
+  case xs of
+    (x:_) -> return x
+    [] -> do
+      ys <- readTVar write
+      case ys of
+        [] -> retry
+        _  -> do
+          let (z:zs) = reverse ys -- NB. lazy: we want the transaction to be
+                                  -- short, otherwise it will conflict
+          writeTVar write []
+          writeTVar read (z:zs)
+          return z
+
+-- | A version of 'peekTQueue' which does not retry. Instead it
+-- returns @Nothing@ if no value is available.
+tryPeekTQueue :: TQueue a -> STM (Maybe a)
+tryPeekTQueue c = do
+  m <- tryReadTQueue c
+  case m of
+    Nothing -> return Nothing
+    Just x  -> do
+      unGetTQueue c x
+      return m
+
+-- |Put a data item back onto a channel, where it will be the next item read.
+unGetTQueue :: TQueue a -> a -> STM ()
+unGetTQueue (TQueue read _write) a = do
+  xs <- readTVar read
+  writeTVar read (a:xs)
+
+-- |Returns 'True' if the supplied 'TQueue' is empty.
+isEmptyTQueue :: TQueue a -> STM Bool
+isEmptyTQueue (TQueue read write) = do
+  xs <- readTVar read
+  case xs of
+    (_:_) -> return False
+    [] -> do ys <- readTVar write
+             case ys of
+               [] -> return True
+               _  -> return False
diff --git a/Control/Concurrent/STM/TSem.hs b/Control/Concurrent/STM/TSem.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/STM/TSem.hs
@@ -0,0 +1,107 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.STM.TSem
+-- Copyright   :  (c) The University of Glasgow 2012
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires STM)
+--
+-- 'TSem': transactional semaphores.
+--
+-- @since 2.4.2
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+module Control.Concurrent.STM.TSem
+  ( TSem
+  , newTSem
+
+  , waitTSem
+
+  , signalTSem
+  , signalTSemN
+  ) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Typeable
+import Numeric.Natural
+
+-- | 'TSem' is a transactional semaphore.  It holds a certain number
+-- of units, and units may be acquired or released by 'waitTSem' and
+-- 'signalTSem' respectively.  When the 'TSem' is empty, 'waitTSem'
+-- blocks.
+--
+-- Note that 'TSem' has no concept of fairness, and there is no
+-- guarantee that threads blocked in `waitTSem` will be unblocked in
+-- the same order; in fact they will all be unblocked at the same time
+-- and will fight over the 'TSem'.  Hence 'TSem' is not suitable if
+-- you expect there to be a high number of threads contending for the
+-- resource.  However, like other STM abstractions, 'TSem' is
+-- composable.
+--
+-- @since 2.4.2
+newtype TSem = TSem (TVar Integer)
+  deriving (Eq, Typeable)
+
+-- | Construct new 'TSem' with an initial counter value.
+--
+-- A positive initial counter value denotes availability of
+-- units 'waitTSem' can acquire.
+--
+-- The initial counter value can be negative which denotes a resource
+-- \"debt\" that requires a respective amount of 'signalTSem'
+-- operations to counter-balance.
+--
+-- @since 2.4.2
+newTSem :: Integer -> STM TSem
+newTSem i = fmap TSem (newTVar $! i)
+
+-- NOTE: we can't expose a good `TSem -> STM Int' operation as blocked
+-- 'waitTSem' aren't reliably reflected in a negative counter value.
+
+-- | Wait on 'TSem' (aka __P__ operation).
+--
+-- This operation acquires a unit from the semaphore (i.e. decreases
+-- the internal counter) and blocks (via 'retry') if no units are
+-- available (i.e. if the counter is /not/ positive).
+--
+-- @since 2.4.2
+waitTSem :: TSem -> STM ()
+waitTSem (TSem t) = do
+  i <- readTVar t
+  when (i <= 0) retry
+  writeTVar t $! (i-1)
+
+
+-- Alternatively, the implementation could block (via 'retry') when
+-- the next increment would overflow, i.e. testing for 'maxBound'
+
+-- | Signal a 'TSem' (aka __V__ operation).
+--
+-- This operation adds\/releases a unit back to the semaphore
+-- (i.e. increments the internal counter).
+--
+-- @since 2.4.2
+signalTSem :: TSem -> STM ()
+signalTSem (TSem t) = do
+  i <- readTVar t
+  writeTVar t $! i+1
+
+
+-- | Multi-signal a 'TSem'
+--
+-- This operation adds\/releases multiple units back to the semaphore
+-- (i.e. increments the internal counter).
+--
+-- > signalTSem == signalTSemN 1
+--
+-- @since 2.4.5
+signalTSemN :: Natural -> TSem -> STM ()
+signalTSemN 0 _ = return ()
+signalTSemN 1 s = signalTSem s
+signalTSemN n (TSem t) = do
+  i <- readTVar t
+  writeTVar t $! i+(toInteger n)
diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs
--- a/Control/Concurrent/STM/TVar.hs
+++ b/Control/Concurrent/STM/TVar.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
@@ -9,7 +9,7 @@
 -- Module      :  Control.Concurrent.STM.TVar
 -- Copyright   :  (c) The University of Glasgow 2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
@@ -19,35 +19,36 @@
 -----------------------------------------------------------------------------
 
 module Control.Concurrent.STM.TVar (
-	-- * TVars
-	TVar,
-	newTVar,
-	newTVarIO,
-	readTVar,
-	readTVarIO,
-	writeTVar,
-	modifyTVar,
-	modifyTVar',
-	swapTVar,
+        -- * TVars
+        TVar,
+        newTVar,
+        newTVarIO,
+        readTVar,
+        readTVarIO,
+        writeTVar,
+        modifyTVar,
+        modifyTVar',
+        stateTVar,
+        swapTVar,
 #ifdef __GLASGOW_HASKELL__
-	registerDelay
+        registerDelay,
 #endif
+        mkWeakTVar
   ) where
 
 #ifdef __GLASGOW_HASKELL__
+import GHC.Base
 import GHC.Conc
+import GHC.Weak
 #else
 import Control.Sequential.STM
 #endif
 
-#if ! (MIN_VERSION_base(4,2,0))
-readTVarIO = atomically . readTVar
-#endif
-
-
 -- Like 'modifyIORef' but for 'TVar'.
 -- | Mutate the contents of a 'TVar'. /N.B./, this version is
 -- non-strict.
+--
+-- @since 2.3
 modifyTVar :: TVar a -> (a -> a) -> STM ()
 modifyTVar var f = do
     x <- readTVar var
@@ -56,6 +57,8 @@
 
 
 -- | Strict version of 'modifyTVar'.
+--
+-- @since 2.3
 modifyTVar' :: TVar a -> (a -> a) -> STM ()
 modifyTVar' var f = do
     x <- readTVar var
@@ -63,8 +66,23 @@
 {-# INLINE modifyTVar' #-}
 
 
+-- | Like 'modifyTVar'' but the function is a simple state transition that can
+-- return a side value which is passed on as the result of the 'STM'.
+--
+-- @since 2.5.0
+stateTVar :: TVar s -> (s -> (a, s)) -> STM a
+stateTVar var f = do
+   s <- readTVar var
+   let !(a, s') = f s
+   writeTVar var s'
+   return a
+{-# INLINE stateTVar #-}
+
+
 -- Like 'swapTMVar' but for 'TVar'.
 -- | Swap the contents of a 'TVar' for a new value.
+--
+-- @since 2.3
 swapTVar :: TVar a -> a -> STM a
 swapTVar var new = do
     old <- readTVar var
@@ -72,3 +90,11 @@
     return old
 {-# INLINE swapTVar #-}
 
+
+-- | Make a 'Weak' pointer to a 'TVar', using the second argument as
+-- a finalizer to run when 'TVar' is garbage-collected
+--
+-- @since 2.4.3
+mkWeakTVar :: TVar a -> IO () -> IO (Weak (TVar a))
+mkWeakTVar t@(TVar t#) (IO finalizer) = IO $ \s ->
+    case mkWeak# t# t finalizer s of (# s1, w #) -> (# s1, Weak w #)
diff --git a/Control/Monad/STM.hs b/Control/Monad/STM.hs
--- a/Control/Monad/STM.hs
+++ b/Control/Monad/STM.hs
@@ -10,7 +10,7 @@
 -- Module      :  Control.Monad.STM
 -- Copyright   :  (c) The University of Glasgow 2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
+--
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable (requires STM)
@@ -19,23 +19,29 @@
 -- abstraction.  See
 --
 --  * /Composable memory transactions/, by Tim Harris, Simon Marlow, Simon
---    Peyton Jones, and Maurice Herlihy, in /ACM Conference on Principles
---    and Practice of Parallel Programming/ 2005.
---    <http://research.microsoft.com/Users/simonpj/papers/stm/index.htm>
+--    Peyton Jones, and Maurice Herlihy, in
+--    /ACM Conference on Principles and Practice of Parallel Programming/ 2005.
+--    <https://www.microsoft.com/en-us/research/publication/composable-memory-transactions/>
 --
--- This module only defines the 'STM' monad; you probably want to 
+-- This module only defines the 'STM' monad; you probably want to
 -- import "Control.Concurrent.STM" (which exports "Control.Monad.STM").
+--
+-- Note that invariant checking (namely the @always@ and @alwaysSucceeds@
+-- functions) has been removed. See ticket [#14324](https://ghc.haskell.org/trac/ghc/ticket/14324) and
+-- the [removal proposal](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0011-deprecate-stm-invariants.rst).
+-- Existing users are encouraged to encapsulate their STM operations in safe
+-- abstractions which can perform the invariant checking without help from the
+-- runtime system.
+
 -----------------------------------------------------------------------------
 
 module Control.Monad.STM (
-  	STM,
-	atomically,
+        STM,
+        atomically,
 #ifdef __GLASGOW_HASKELL__
-        always,
-        alwaysSucceeds,
-	retry,
-	orElse,
-	check,
+        retry,
+        orElse,
+        check,
 #endif
         throwSTM,
         catchSTM
@@ -57,13 +63,44 @@
 
 #ifdef __GLASGOW_HASKELL__
 #if ! (MIN_VERSION_base(4,3,0))
+import Control.Applicative
+import Control.Monad (ap)
+#endif
+#endif
+
+#if !MIN_VERSION_base(4,17,0)
+import Control.Monad (liftM2)
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup (Semigroup (..))
+#endif
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid (Monoid (..))
+#endif
+#endif
+
+
+#ifdef __GLASGOW_HASKELL__
+#if ! (MIN_VERSION_base(4,3,0))
 instance MonadPlus STM where
   mzero = retry
   mplus = orElse
+
+instance Applicative STM where
+  pure = return
+  (<*>) = ap
+
+instance Alternative STM where
+  empty = retry
+  (<|>) = orElse
 #endif
 
-check :: Bool -> STM a
-check b = if b then return undefined else retry
+-- | Check that the boolean condition is true and, if not, 'retry'.
+--
+-- In other words, @check b = unless b retry@.
+--
+-- @since 2.1.1
+check :: Bool -> STM ()
+check b = if b then return () else retry
 #endif
 
 #if ! (MIN_VERSION_base(4,3,0))
@@ -78,7 +115,8 @@
 -- | A variant of 'throw' that can only be used within the 'STM' monad.
 --
 -- Throwing an exception in @STM@ aborts the transaction and propagates the
--- exception.
+-- exception. (Note: Allocation effects, such as  'newTVar' are not rolled back
+-- when this happens. All other effects are discarded. See <https://gitlab.haskell.org/ghc/ghc/-/issues/18453 ghc#18453.>)
 --
 -- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
 -- two functions are subtly different:
@@ -103,8 +141,20 @@
 liftSTM :: STM a -> State# RealWorld -> STMret a
 liftSTM (STM m) = \s -> case m s of (# s', r #) -> STMret s' r
 
+-- | @since 2.3
 instance MonadFix STM where
   mfix k = STM $ \s ->
     let ans        = liftSTM (k r) s
         STMret _ r = ans
     in case ans of STMret s' x -> (# s', x #)
+
+#if !MIN_VERSION_base(4,17,0)
+instance Semigroup a => Semigroup (STM a) where
+    (<>) = liftM2 (<>)
+
+instance Monoid a => Monoid (STM a) where
+    mempty = return mempty
+#if !MIN_VERSION_base(4,13,0)
+    mappend = liftM2 mappend
+#endif
+#endif
diff --git a/Control/Sequential/STM.hs b/Control/Sequential/STM.hs
--- a/Control/Sequential/STM.hs
+++ b/Control/Sequential/STM.hs
@@ -4,18 +4,24 @@
 
 {-# LANGUAGE CPP #-}
 
-#if __GLASGOW_HASKELL__ >= 701
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#elif __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE Trustworthy #-}
 #endif
 
 -- #hide
 module Control.Sequential.STM (
-	STM, atomically, throwSTM, catchSTM,
-	TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar
+        STM, atomically, throwSTM, catchSTM,
+        TVar, newTVar, newTVarIO, readTVar, readTVarIO, writeTVar
     ) where
 
+#if __GLASGOW_HASKELL__ < 705
 import Prelude hiding (catch)
+#endif
+#if __GLASGOW_HASKELL__ < 709
 import Control.Applicative (Applicative(pure, (<*>)))
+#endif
 import Control.Exception
 import Data.IORef
 
@@ -35,51 +41,34 @@
 instance Monad STM where
     return = pure
     STM m >>= k = STM $ \ r -> do
-	x <- m r
-	unSTM (k x) r
+        x <- m r
+        unSTM (k x) r
 
-#ifdef BASE4
 atomically :: STM a -> IO a
 atomically (STM m) = do
     r <- newIORef (return ())
     m r `onException` do
-	rollback <- readIORef r
-	rollback
-#else
-atomically :: STM a -> IO a
-atomically (STM m) = do
-    r <- newIORef (return ())
-    m r `catch` \ ex -> do
-	rollback <- readIORef r
-	rollback
-	throw ex
-#endif
+        rollback <- readIORef r
+        rollback
 
-#ifdef BASE4
+-- | @since 2.2.0
 throwSTM :: Exception e => e -> STM a
-#else
-throwSTM :: Exception -> STM a
-#endif
 throwSTM = STM . const . throwIO
 
-#ifdef BASE4
 catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
-#else
-catchSTM :: STM a -> (Exception -> STM a) -> STM a
-#endif
 catchSTM (STM m) h = STM $ \ r -> do
     old_rollback <- readIORef r
     writeIORef r (return ())
     res <- try (m r)
     rollback_m <- readIORef r
     case res of
-	Left ex -> do
-	    rollback_m
-	    writeIORef r old_rollback
-	    unSTM (h ex) r
-	Right a -> do
-	    writeIORef r (rollback_m >> old_rollback)
-	    return a
+        Left ex -> do
+            rollback_m
+            writeIORef r old_rollback
+            unSTM (h ex) r
+        Right a -> do
+            writeIORef r (rollback_m >> old_rollback)
+            return a
 
 newtype TVar a = TVar (IORef a)
     deriving (Eq)
@@ -95,6 +84,7 @@
 readTVar :: TVar a -> STM a
 readTVar (TVar ref) = STM (const (readIORef ref))
 
+-- | @since 2.1.2
 readTVarIO :: TVar a -> IO a
 readTVarIO (TVar ref) = readIORef ref
 
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+The `stm` Package [![Build Status](https://travis-ci.org/haskell/stm.svg?branch=master)](https://travis-ci.org/haskell/stm)
+=================
+
+See [`stm` on Hackage](http://hackage.haskell.org/package/stm) for more information.
diff --git a/changelog.md b/changelog.md
new file mode 100644
--- /dev/null
+++ b/changelog.md
@@ -0,0 +1,128 @@
+# Changelog for [`stm` package](http://hackage.haskell.org/package/stm)
+
+## 2.5.3.1 *November 2023*
+
+  * Drop unused testcase inadvertently introduced in previous reversion
+
+## 2.5.3.0 *November 2023*
+
+  * Revert array-based reimplementation of `TBQueue` due to [#76](https://github.com/haskell/stm/issues/76)
+
+## 2.5.2.1 *September 2023*
+
+  * Eliminate reliance on undefined CPP behavior ([#75](https://github.com/haskell/stm/issues/75))
+
+## 2.5.2.0 *September 2023*
+
+  * Fix strictness of `stateTVar` ([#30](https://github.com/haskell/stm/ssues/30))
+  * Rewrite `TBQueue` to use a more-efficient array-based representation ([#65](https://github.com/haskell/stm/issues/65))
+  * `newTBQueue 0` now fails as one would expect ([#28](https://github.com/haskell/stm/issues/28))
+  * Add `capacityTBQueue` ([#61](https://github.com/haskell/stm/issues/61))
+  * Add `MArray TArray e IO` instance
+  * Use unlifted `Array#` for `TArray` ([#66](https://github.com/haskell/stm/pull/66))
+
+## 2.5.1.0 *Aug 2022*
+
+  * Teach `flushTBQueue` to only flush queue when necessary
+  * Introduce `Control.Concurrent.STM.TMVar.writeTMVar`
+  * Add `Semigroup` and `Monoid` instances for `STM`
+
+## 2.5.0.2 *Dec 2021*
+
+  * Fix non-exhaustive patterns warning (#49)
+
+  * Document particulars of effect-rollback of `Control.Monad.STM.throwSTM` (#32)
+
+## 2.5.0.1 *May 2020*
+
+  * Optimise implementation of `peekTQueue` and `peekTBQueue` to reduce
+    probability of transaction conflicts.
+
+## 2.5.0.0 *Sep 2018*
+
+  * Removed `alwaysSucceeds` and `always`, GHC's invariant checking primitives. (GHC #14324)
+
+  * Add `lengthTBQueue` to `Control.Concurrent.STM.TBQueue` (gh-9)
+
+  * Add `stateTVar :: TVar s -> (s -> (a, s)) -> STM a` combinator (gh-14)
+
+  * Switched `newTBQueue` and `newTBQueueIO` to accept `Natural` as size (gh-17)
+
+  * Switched `signalTSemN` and `newTSem` to accept `Natural` and `Integer` respectively (gh-17)
+
+----
+
+#### 2.4.5.1 *Sep 2018*
+
+  * Fix incorrect bookkeeping of write capacity in `flushTBQueue` (gh-9)
+
+  * Avoid redundant `writeTVar`s in `flushTQueue` to avoid unnecessarily
+    invalidating other transactions (gh-6)
+
+### 2.4.5.0 *Feb 2018*
+
+  * Fix space leak in `TBQueue` (gh-2, GHC#14494)
+
+  * Make `signalTSem` resilient against `Int` overflows (gh-4)
+
+  * Make definition of `readTQueue` consistent with `readTBQueue` (gh-3, GHC#9539)
+
+  * Add `flushTQueue` to `Control.Concurrent.STM.TQueue` (gh-1)
+
+  * Add `flushTBQueue` to `Control.Concurrent.STM.TBQueue` (gh-1)
+
+  * Add `signalTSemN` operation (gh-5)
+
+
+#### 2.4.4.1  *Dec 2015*
+
+  * Add support for `base-4.9.0.0`
+
+  * Drop support for GHC 6.12 / `base-4.2`
+
+### 2.4.4  *Dec 2014*
+
+  * Add support for `base-4.8.0.0`
+
+  * Tighten Safe Haskell bounds
+
+  * Add `mkWeakTMVar` to `Control.Concurrent.STM.TMVar`
+
+  * Add `@since`-annotations
+
+### 2.4.3  *Mar 2014*
+
+  * Update behaviour of `newBroadcastTChanIO` to match
+    `newBroadcastTChan` in causing an error on a read from the
+    broadcast channel
+
+  * Add `mkWeakTVar`
+
+  * Add `isFullTBQueue`
+
+  * Fix `TChan` created via `newBroadcastTChanIO` to throw same
+    exception on a `readTChan` as when created via `newBroadcastTChan`
+
+  * Update to Cabal 1.10 format
+
+### 2.4.2  *Nov 2012*
+
+  * Add `Control.Concurrent.STM.TSem` (transactional semaphore)
+
+  * Add Applicative/Alternative instances of STM for GHC <7.0
+
+  * Throw proper exception when `readTChan` called on a broadcast `TChan`
+
+## 2.4  *Jul 2012*
+
+  * Add `Control.Concurrent.STM.TQueue` (a faster `TChan`)
+
+  * Add `Control.Concurrent.STM.TBQueue` (a bounded channel based on `TQueue`)
+
+  * Add `Eq` instance for `TChan`
+
+  * Add `newBroadcastTChan` and `newBroadcastTChanIO`
+
+  * Some performance improvements for `TChan`
+
+  * Add `cloneTChan`
diff --git a/stm.cabal b/stm.cabal
--- a/stm.cabal
+++ b/stm.cabal
@@ -1,35 +1,72 @@
-name:		stm
-version:        2.3
-license:	BSD3
-license-file:	LICENSE
-maintainer:	libraries@haskell.org
-synopsis:	Software Transactional Memory
+cabal-version:  >=1.10
+name:           stm
+version:        2.5.3.1
+-- don't forget to update changelog.md file!
+
+license:        BSD3
+license-file:   LICENSE
+maintainer:     libraries@haskell.org
+homepage:       https://wiki.haskell.org/Software_transactional_memory
+bug-reports:    https://github.com/haskell/stm/issues
+synopsis:       Software Transactional Memory
 category:       Concurrency
-description:	A modular composable concurrency abstraction.
 build-type:     Simple
-cabal-version:  >=1.6
+tested-with:    GHC==9.6.2, GHC==9.4.7, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2
+description:
+    Software Transactional Memory, or STM, is an abstraction for
+    concurrent communication. The main benefits of STM are
+    /composability/ and /modularity/. That is, using STM you can write
+    concurrent abstractions that can be easily composed with any other
+    abstraction built using STM, without exposing the details of how
+    your abstraction ensures safety. This is typically not the case
+    with other forms of concurrent communication, such as locks or
+    'MVar's.
 
+extra-source-files:
+    changelog.md
+    README.md
+    testsuite/src/*.hs
+    testsuite/testsuite.cabal
+
 source-repository head
     type:     git
-    location: http://darcs.haskell.org/packages/stm.git/
-
-flag base4
+    location: https://github.com/haskell/stm.git
 
 library
-  exposed-modules:
-    Control.Concurrent.STM
-    Control.Concurrent.STM.TArray
-    Control.Concurrent.STM.TVar
-    Control.Concurrent.STM.TChan
-    Control.Concurrent.STM.TMVar
-    Control.Monad.STM
-  other-modules:
-    Control.Sequential.STM
-  build-depends: base < 5, array
-  if flag(base4)
-    build-depends: base >=4
-    cpp-options:   -DBASE4
-  else
-    build-depends: base <4
-  if impl(ghc >= 6.10)
-    build-depends: base >=4
+    default-language: Haskell2010
+    other-extensions:
+        CPP
+        DeriveDataTypeable
+        FlexibleInstances
+        MagicHash
+        MultiParamTypeClasses
+        UnboxedTuples
+    if impl(ghc >= 7.2)
+        other-extensions: Trustworthy
+    if impl(ghc >= 7.9)
+        other-extensions: Safe
+
+    if !impl(ghc >= 7.10)
+        build-depends: nats (>= 0.1.3 && < 0.3) || (>= 1 && < 1.2)
+
+    if !impl(ghc >= 8.0)
+        build-depends: semigroups >=0.18.6 && <0.21
+
+    build-depends:
+        base  >= 4.4 && < 4.21,
+        array >= 0.3 && < 0.6
+
+    exposed-modules:
+        Control.Concurrent.STM
+        Control.Concurrent.STM.TArray
+        Control.Concurrent.STM.TVar
+        Control.Concurrent.STM.TChan
+        Control.Concurrent.STM.TMVar
+        Control.Concurrent.STM.TQueue
+        Control.Concurrent.STM.TBQueue
+        Control.Concurrent.STM.TSem
+        Control.Monad.STM
+    other-modules:
+        Control.Sequential.STM
+
+    ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates
diff --git a/testsuite/src/Issue17.hs b/testsuite/src/Issue17.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Issue17.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE CPP #-}
+
+-- see https://github.com/haskell/stm/pull/19
+--
+-- Test-case contributed by Alexey Kuleshevich <alexey@kukeshevi.ch>
+--
+-- This bug is observable in all versions with TBQueue from `stm-2.4` to
+-- `stm-2.4.5.1` inclusive.
+
+module Issue17 (main) where
+
+import           Control.Concurrent.STM
+import           Test.HUnit.Base        (assertBool, assertEqual)
+
+main :: IO ()
+main = do
+  -- New queue capacity is set to 0
+  queueIO <- newTBQueueIO 0
+  assertNoCapacityTBQueue queueIO
+
+  -- Same as above, except created within STM
+  queueSTM <- atomically $ newTBQueue 0
+  assertNoCapacityTBQueue queueSTM
+
+#if !MIN_VERSION_stm(2,5,0)
+  -- NB: below are expected failures
+
+  -- New queue capacity is set to a negative numer
+  queueIO' <- newTBQueueIO (-1 :: Int)
+  assertNoCapacityTBQueue queueIO'
+
+  -- Same as above, except created within STM and different negative number
+  queueSTM' <- atomically $ newTBQueue (minBound :: Int)
+  assertNoCapacityTBQueue queueSTM'
+#endif
+
+assertNoCapacityTBQueue :: TBQueue Int -> IO ()
+assertNoCapacityTBQueue queue = do
+  assertEmptyTBQueue queue
+  assertFullTBQueue queue
+
+  -- Attempt to write into the queue.
+  eValWrite <- atomically $ orElse (fmap Left (writeTBQueue queue 217))
+                                   (fmap Right (tryReadTBQueue queue))
+  assertEqual "Expected queue with no capacity: writeTBQueue" eValWrite (Right Nothing)
+  eValUnGet <- atomically $ orElse (fmap Left (unGetTBQueue queue 218))
+                                   (fmap Right (tryReadTBQueue queue))
+  assertEqual "Expected queue with no capacity: unGetTBQueue" eValUnGet (Right Nothing)
+
+  -- Make sure that attempt to write didn't affect the queue
+  assertEmptyTBQueue queue
+  assertFullTBQueue queue
+
+
+assertEmptyTBQueue :: TBQueue Int -> IO ()
+assertEmptyTBQueue queue = do
+  atomically (isEmptyTBQueue queue) >>=
+    assertBool "Expected empty: isEmptyTBQueue should return True"
+
+  atomically (tryReadTBQueue queue) >>=
+    assertEqual "Expected empty: tryReadTBQueue should return Nothing" Nothing
+
+  atomically (tryPeekTBQueue queue) >>=
+    assertEqual "Expected empty: tryPeekTBQueue should return Nothing" Nothing
+
+  atomically (flushTBQueue queue) >>=
+    assertEqual "Expected empty: flushTBQueue should return []" []
+
+
+assertFullTBQueue :: TBQueue Int -> IO ()
+assertFullTBQueue queue = do
+  atomically (isFullTBQueue queue) >>=
+    assertBool "Expected full: isFullTBQueue shoule return True"
diff --git a/testsuite/src/Issue9.hs b/testsuite/src/Issue9.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Issue9.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE CPP #-}
+
+-- see https://github.com/haskell/stm/pull/9
+--
+-- Test-case contributed by Mitchell Rosen <mitchellwrosen@gmail.com>
+--
+-- This bug is observable in version `stm-2.4.5.0`
+
+module Issue9 (main) where
+
+import           Control.Concurrent.STM
+import           Data.Foldable
+
+main :: IO ()
+#if MIN_VERSION_stm(2,4,5)
+main = do
+  -- New queue with capacity 5
+  queue <- newTBQueueIO 5
+
+  -- Fill it up with [1..5]
+  for_ [1..5] $ \i ->
+    atomically (writeTBQueue queue (i :: Int))
+
+  -- Read 1
+  1 <- atomically (readTBQueue queue)
+
+  -- Flush [2..5]
+  [2,3,4,5] <- atomically (flushTBQueue queue)
+
+  -- The bug: now the queue capacity is 4, not 5.
+  -- To trigger it, first fill up [1..4]...
+  for_ [1..4] $ \i ->
+    atomically (writeTBQueue queue i)
+
+  -- ... then observe that writing a 5th element will fail
+  -- with "thread blocked indefinitely in an STM transaction"
+  atomically (writeTBQueue queue 5)
+#else
+-- test-case not applicable; `flushTBQueue` was only added in 2.4.5.0
+main = return ()
+#endif
diff --git a/testsuite/src/Main.hs b/testsuite/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Main.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import           Test.Framework                 (defaultMain, testGroup)
+import           Test.Framework.Providers.HUnit
+
+import qualified Issue9
+import qualified Issue17
+import qualified Stm052
+import qualified Stm064
+import qualified Stm065
+
+main :: IO ()
+main = do
+    putStrLn ("'stm' version under test: " ++ VERSION_stm)
+    defaultMain tests
+  where
+    tests = [
+      testGroup "regression"
+        [ testCase "issue #9" Issue9.main
+        , testCase "issue #17" Issue17.main
+        , testCase "stm052" Stm052.main
+        , testCase "stm064" Stm064.main
+        , testCase "stm065" Stm065.main
+        ]
+      ]
+
diff --git a/testsuite/src/Stm052.hs b/testsuite/src/Stm052.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Stm052.hs
@@ -0,0 +1,70 @@
+-- STM stress test
+
+module Stm052 (main) where
+
+import           Control.Concurrent
+import           Control.Exception
+import           Control.Monad      (mapM_, when)
+import           Data.Array
+import           Data.List
+import           Foreign
+import           Foreign.C
+import           GHC.Conc
+import           GHC.Conc           (unsafeIOToSTM)
+import           System.Environment
+import           System.IO
+import           System.IO.Unsafe
+import           System.Random
+
+-- | The number of array elements
+n_elems :: Int
+n_elems = 20
+
+-- | The number of threads swapping elements
+n_threads :: Int
+n_threads = 2
+
+-- | The number of swaps for each thread to perform
+iterations :: Int
+iterations = 20000
+
+type Elements = Array Int (TVar Int)
+
+thread :: TVar Int -> Elements -> IO ()
+thread done elements = loop iterations
+ where loop 0 = atomically $ do x <- readTVar done; writeTVar done (x+1)
+       loop n = do
+          i1 <- randomRIO (1,n_elems)
+          i2 <- randomRIO (1,n_elems)
+          let e1 = elements ! i1
+          let e2 = elements ! i2
+          atomically $ do
+            e1_v <- readTVar e1
+            e2_v <- readTVar e2
+            writeTVar e1 e2_v
+            writeTVar e2 e1_v
+          loop (n-1)
+
+await_end :: TVar Int -> IO ()
+await_end done = atomically $ do x <- readTVar done
+                                 if (x == n_threads)  then return () else retry
+
+main :: IO ()
+main = do
+  _ <- Foreign.newStablePtr stdout
+  setStdGen (read "526454551 6356")
+  let init_vals = [1..n_elems] -- take n_elems
+  tvars <- atomically $ mapM newTVar init_vals
+  let elements = listArray (1,n_elems) tvars
+  done <- atomically (newTVar 0)
+  _ <- sequence [ forkIO (thread done elements) | _id <- [1..n_threads] ]
+  await_end done
+  fin_vals <- mapM (\t -> atomically $ readTVar t) (elems elements)
+
+  when (sort fin_vals /= init_vals) $ do
+    putStr("Before: ")
+    mapM_ (\v -> putStr ((show v) ++ " " )) init_vals
+    putStr("\nAfter: ")
+    mapM_ (\v -> putStr ((show v) ++ " " )) (sort fin_vals)
+    putStr("\n")
+    fail "mismatch"
diff --git a/testsuite/src/Stm064.hs b/testsuite/src/Stm064.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Stm064.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE CPP #-}
+
+{- NB: This one fails for GHC < 7.6 which had a bug exposed via
+       nested uses of `orElse` in `stmCommitNestedTransaction`
+
+This was fixed in GHC via
+ f184d9caffa09750ef6a374a7987b9213d6db28e
+-}
+
+module Stm064 (main) where
+
+import           Control.Concurrent.STM
+import           Control.Monad          (unless)
+
+main :: IO ()
+#if __GLASGOW_HASKELL__ >= 706 && !defined(GHC_7_6_1)
+main = do
+  x <- atomically $ do
+         t <- newTVar (1 :: Integer)
+         writeTVar t 2
+         ((readTVar t >> retry) `orElse` return ()) `orElse` return ()
+         readTVar t
+
+  unless (x == 2) $
+    fail (show x)
+#else
+main = putStrLn "Warning: test disabled for GHC < 7.6"
+#endif
diff --git a/testsuite/src/Stm065.hs b/testsuite/src/Stm065.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/src/Stm065.hs
@@ -0,0 +1,15 @@
+module Stm065 (main) where
+
+import           Control.Concurrent.STM
+import           Control.Monad          (unless)
+
+main :: IO ()
+main = do
+  x <- atomically $ do
+         r <- newTVar []
+         writeTVar r [2 :: Integer]
+         writeTVar r [] `orElse` return ()
+         readTVar r
+
+  unless (null x) $ do
+    fail (show x)
diff --git a/testsuite/testsuite.cabal b/testsuite/testsuite.cabal
new file mode 100644
--- /dev/null
+++ b/testsuite/testsuite.cabal
@@ -0,0 +1,58 @@
+cabal-version:       2.2
+name:                testsuite
+version:             0
+
+synopsis:            External testsuite for stm package
+category:            Testing
+license:             BSD-3-Clause
+maintainer:          hvr@gnu.org
+tested-with:         GHC==9.6.2, GHC==9.4.7, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2
+description:
+  This testsuite is intended to be compatible with different versions
+  of `stm` (via use of @CPP@ if needed) in order to more easily
+  verify regression tests.
+  .
+  See also @README.md@ for more information.
+
+test-suite stm
+  hs-source-dirs: src
+
+  main-is: Main.hs
+  other-modules:
+    Issue9
+    Issue17
+    Stm052
+    Stm064
+    Stm065
+
+  type: exitcode-stdio-1.0
+
+  default-language: Haskell2010
+  other-extensions: CPP
+
+  -- IUT
+  build-depends:
+    , stm  >= 2.4 && < 2.6
+
+  --
+  build-depends:
+    , base                   >= 4.4 && < 4.20
+    , test-framework        ^>= 0.8.2.0
+    , test-framework-hunit  ^>= 0.3.0.2
+    , HUnit                 ^>= 1.6.0.0
+    -- Testing with GHC < 7.4 requires 'HUnit-1.3.1.2' which didn't depend on 'call-stack' (which requires GHC >= 7.4)
+                         || ^>= 1.3.1.2
+
+    -- some tests need 'array' & 'random'
+    , array ^>= 0.3.0.2 || ^>= 0.4.0.0 || ^>= 0.5.0.0
+    , random ^>= 1.1
+
+  -- The __GLASGOW_HASKELL_PATCHLEVEL1__ macro wasn't available until GHC 7.10.1,
+  -- so we must use the .cabal file to detect if we're compiling with GHC 7.6.1
+  -- in particular. See the comments in Stm065 for more information about why we
+  -- must single out this version of GHC.
+  if impl(ghc==7.6.1)
+    cpp-options: "-DGHC_7_6_1"
+
+  ghc-options: -Wall -fno-warn-unused-imports
+  ghc-options: -threaded