diff --git a/Control/Concurrent/STM/TChan.hs b/Control/Concurrent/STM/TChan.hs
index af06fb4a65a49cf6c2cf058d7eb063fdee22e30f..a8c28c1c9d3685c3d5b8ba432a22a2596e63925e 100644
--- a/Control/Concurrent/STM/TChan.hs
+++ b/Control/Concurrent/STM/TChan.hs
@@ -135,6 +135,8 @@ readTChan (TChan read _write) = do
 
 -- | 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
@@ -147,6 +149,8 @@ tryReadTChan (TChan read _write) = do
 
 -- | 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
@@ -157,6 +161,8 @@ peekTChan (TChan read _write) = do
 
 -- | 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
diff --git a/Control/Concurrent/STM/TMVar.hs b/Control/Concurrent/STM/TMVar.hs
index f3ac30aebfcd58b0120e404bdfb27474af19b92d..4bd4b2123cfcb38d9806af299553ef9f00283ee3 100644
--- a/Control/Concurrent/STM/TMVar.hs
+++ b/Control/Concurrent/STM/TMVar.hs
@@ -135,6 +135,8 @@ readTMVar (TMVar t) = do
 
 -- | 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
 
diff --git a/Control/Concurrent/STM/TVar.hs b/Control/Concurrent/STM/TVar.hs
index 88a6dfb95a4c7d897b93bc2f8fc47b841e93340d..ca8c7fb08dbacb03cf2c1084553b29ba4d6a0c3a 100644
--- a/Control/Concurrent/STM/TVar.hs
+++ b/Control/Concurrent/STM/TVar.hs
@@ -46,6 +46,8 @@ import Control.Sequential.STM
 -- 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
@@ -54,6 +56,8 @@ modifyTVar var f = do
 
 
 -- | Strict version of 'modifyTVar'.
+--
+-- @since 2.3
 modifyTVar' :: TVar a -> (a -> a) -> STM ()
 modifyTVar' var f = do
     x <- readTVar var
@@ -63,6 +67,8 @@ modifyTVar' var f = do
 
 -- 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
diff --git a/Control/Monad/STM.hs b/Control/Monad/STM.hs
index 4887568f7357af790f234fc1473277ad7b245b95..fb21f533cfbeb58527bf3af0b6f447c6b28a95fb 100644
--- a/Control/Monad/STM.hs
+++ b/Control/Monad/STM.hs
@@ -124,6 +124,7 @@ data STMret a = STMret (State# RealWorld) a
 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
diff --git a/Control/Sequential/STM.hs b/Control/Sequential/STM.hs
index e855a6152f890c11f75e9a5aa1ae1db443c2de96..49464f848578e69bf867297d2e0eaf4f7ae85a71 100644
--- a/Control/Sequential/STM.hs
+++ b/Control/Sequential/STM.hs
@@ -51,6 +51,7 @@ atomically (STM m) = do
         rollback <- readIORef r
         rollback
 
+-- | @since 2.2.0
 throwSTM :: Exception e => e -> STM a
 throwSTM = STM . const . throwIO
 
@@ -83,6 +84,7 @@ newTVarIO a = do
 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