Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8b2c72c0 by L0neGamer at 2025-09-04T06:32:03-04:00 Add Control.Monad.thenM and Control.Applicative.thenA - - - - - 11 changed files: - compiler/GHC/Data/IOEnv.hs - libraries/base/changelog.md - libraries/base/src/Control/Applicative.hs - libraries/base/src/Control/Monad.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/profiling/should_run/callstack001.stdout Changes: ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -45,7 +45,7 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, atomicModifyIORef, atomicModifyIORef' ) import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) -import Control.Monad +import Control.Monad ( MonadPlus ) import Control.Monad.Trans.Reader import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import GHC.Utils.Monad ===================================== libraries/base/changelog.md ===================================== @@ -6,6 +6,7 @@ * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332)) * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) + * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351)) * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339)) * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335) ===================================== libraries/base/src/Control/Applicative.hs ===================================== @@ -49,6 +49,7 @@ module Control.Applicative ( liftA, liftA3, optional, asum, + thenA, ) where import GHC.Internal.Control.Category hiding ((.), id) ===================================== libraries/base/src/Control/Monad.hs ===================================== @@ -57,6 +57,7 @@ module Control.Monad liftM4, liftM5, ap, + thenM, -- ** Strict monadic functions (<$!>) ) where ===================================== libraries/ghc-internal/src/GHC/Internal/Base.hs ===================================== @@ -1223,6 +1223,9 @@ class Functor f => Applicative f where -- -- As such this function may be used to implement a `Functor` instance from an `Applicative` one. -- +-- This function can be used to define `fmap = liftA`, if `Applicative` is already +-- defined for a data type. +-- -- ==== __Examples__ -- Using the Applicative instance for Lists: -- @@ -1233,7 +1236,6 @@ class Functor f => Applicative f where -- -- >>> liftA (+1) (Just 3) -- Just 4 - liftA :: Applicative f => (a -> b) -> f a -> f b liftA f a = pure f <*> a -- Caution: since this may be used for `fmap`, we can't use the obvious @@ -1253,6 +1255,18 @@ liftA3 f a b c = liftA2 f a b <*> c {-# SPECIALISE liftA3 :: (a1->a2->a3->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-} +-- | Sequence two `Applicative` actions, discarding the result of the first one. +-- +-- Defined as `thenA fa fb = (id <$ fa) <*> fb`. +-- +-- This can be used to explicitly define `(*>) = thenA`, which is the default +-- definition. +-- +-- @since 4.23.0.0 +thenA :: Applicative f => f a -> f b -> f b +thenA fa fb = (id <$ fa) <*> fb +{-# INLINEABLE thenA #-} + -- | The 'join' function is the conventional monad join operator. It -- is used to remove one level of monadic structure, projecting its -- bound argument into the outer level. @@ -1453,12 +1467,18 @@ similar problems in nofib. -- | Promote a function to a monad. -- This is equivalent to 'fmap' but specialised to Monads. +-- +-- This function can be used to define `fmap = liftM`, if `Monad` is already +-- defined for a data type. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right. -- +-- This function can be used to define `liftA2 = liftM2`, if `Monad` is already +-- defined for a data type. +-- -- ==== __Examples__ -- -- >>> liftM2 (+) [0,1] [0,2] @@ -1514,6 +1534,9 @@ is equivalent to
liftM<n> f x1 x2 ... xn
+This function can be used to define `(<*>) = ap`, if `Monad` is already +defined for a data type. + ==== __Examples__
pure (\x y z -> x + y * z) `ap` Just 1 `ap` Just 5 `ap` Just 10 @@ -1527,6 +1550,17 @@ ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } {-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-} {-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-}
+-- | Sequence two monadic actions, discarding the result of the first one. +-- +-- Defined as `thenM ma mb = ma >>= const mb`. +-- +-- This can be used to define `(*>) = thenM`. +-- +-- @since 4.23.0.0 +thenM :: (Monad m) => m a -> m b -> m b +thenM ma mb = ma >>= const mb +{-# INLINEABLE thenM #-} + -- instances for Prelude types -- | @since base-2.01 ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs ===================================== @@ -71,6 +71,8 @@ module GHC.Internal.Control.Monad , ap + , thenM + -- ** Strict monadic functions , (<$!>) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -34,6 +34,7 @@ module Control.Applicative where liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a) + thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b module Control.Arrow where -- Safety: Safe @@ -483,6 +484,7 @@ module Control.Monad where replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m () sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a) sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m () + thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () void :: forall (f :: * -> *) a. Functor f => f a -> f () when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -34,6 +34,7 @@ module Control.Applicative where liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a) + thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b module Control.Arrow where -- Safety: Safe @@ -483,6 +484,7 @@ module Control.Monad where replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m () sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a) sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m () + thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () void :: forall (f :: * -> *) a. Functor f => f a -> f () when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -34,6 +34,7 @@ module Control.Applicative where liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a) + thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b module Control.Arrow where -- Safety: Safe @@ -483,6 +484,7 @@ module Control.Monad where replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m () sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a) sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m () + thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () void :: forall (f :: * -> *) a. Functor f => f a -> f () when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -34,6 +34,7 @@ module Control.Applicative where liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a) + thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b module Control.Arrow where -- Safety: Safe @@ -483,6 +484,7 @@ module Control.Monad where replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m () sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a) sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m () + thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () void :: forall (f :: * -> *) a. Functor f => f a -> f () when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f () ===================================== testsuite/tests/profiling/should_run/callstack001.stdout ===================================== @@ -1,2 +1,2 @@ -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1350:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1350:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1364:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1364:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b2c72c039ddf3eaa292e32556a29184... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b2c72c039ddf3eaa292e32556a29184... You're receiving this email because of your account on gitlab.haskell.org.