Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4262af36 by L0neGamer at 2026-06-30T21:38:56-04:00 generically defines mconcat in terms of internal type's Semigroup instance add changelog entry use simpler definition for mconcat `nonEmpty` isn't available yet; inline branches in case add test case fixup generically defines mconcat in terms of internal type's Semigroup instance add comment on Generically and deriving mishaps swap mconcat to foldr version add some strictness testing for mconcat add to `base` changelog entry - - - - - 9 changed files: - + changelog.d/generically-mconcat - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Generics.hs - + testsuite/tests/generics/T27245.hs - + testsuite/tests/generics/T27245.stdout - testsuite/tests/generics/all.T - 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 Changes: ===================================== changelog.d/generically-mconcat ===================================== @@ -0,0 +1,4 @@ +section: base +synopsis: Add definition for Generically's `mconcat` in terms of the type variable's Semigroup instance instead of using the generically derived version. +issues: #27245 +mrs: !16011 ===================================== libraries/base/changelog.md ===================================== @@ -6,6 +6,7 @@ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409)) * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) + * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) ## 4.23.0.0 *TBA* * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ===================================== libraries/ghc-internal/src/GHC/Internal/Generics.hs ===================================== @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-} - {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} @@ -744,7 +742,7 @@ import GHC.Internal.Types hiding (Any) -- clashes with the Semigroup import GHC.Internal.Ix ( Ix ) import GHC.Internal.Base ( Alternative(..), Applicative(..), Functor(..) , Monad(..), MonadPlus(..), NonEmpty(..), String - , Semigroup(..), Void ) + , Semigroup(..), Void) import GHC.Internal.Err (errorWithoutStackTrace) import GHC.Internal.Classes ( Eq(..), Ord(..) ) import GHC.Internal.Enum ( Bounded, Enum ) @@ -1437,6 +1435,10 @@ class Generic1 (f :: k -> Type) where -- type/ like 'Generically' decouples the instance from the type -- class. -- +-- Note that if you don't generate parent and child instances using the same +-- method, the result may be incongruous; for example, in previous versions +-- `mconcat` didn't use the correct `(<>)`, instead preferring a Generic version. +-- -- @since base-4.17.0.0 newtype Generically a = Generically a @@ -1446,12 +1448,14 @@ instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where Generically a <> Generically b = Generically (to (from a <> from b :: Rep a ())) -- | @since base-4.17.0.0 -instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where +instance (Generic a, Semigroup a, Monoid (Rep a ())) => Monoid (Generically a) where mempty :: Generically a mempty = Generically (to (mempty :: Rep a ())) - mappend :: Generically a -> Generically a -> Generically a - mappend = (<>) + -- https://github.com/haskell/core-libraries-committee/issues/324 + mconcat :: [Generically a] -> Generically a + mconcat = foldr (coerce @(a -> a -> a) (<>)) mempty + {-# INLINE mconcat #-} -- | A type whose instances are defined generically, using the -- 'Generic1' representation. 'Generically1' is a higher-kinded ===================================== testsuite/tests/generics/T27245.hs ===================================== @@ -0,0 +1,87 @@ + +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import GHC.Generics +import Data.Coerce +import Data.Semigroup +import Data.List.NonEmpty qualified as NE +import Control.Exception + +main :: IO () +main = do + let l1 = L [1] + l2 = L [2] + -- check append functions; this is a regression test for later down the line + print ("sappend", l1 <> l2) + print ("mappend", l1 `mappend` l2) + print ("gappend", l1 `gappend` l2) + -- when `mappend` is removed from `Monoid`, `mappend`'s definition will be + -- `mappend = (<>)` at the top level, removing the above `mappend = gappend` issue + + -- check concat functions + -- We have the defined method functions, the generic variants, and the + -- default implementations written out again + let ls = [l1, l2] + lsNE = l1 NE.:| [l2] + print ("sconcat", sconcat lsNE) + print ("mconcat", mconcat ls) + print ("gsconcat", gsconcat lsNE) + print ("gmconcat", gmconcat ls) + print ("dsconcat", dsconcat lsNE) + print ("dmconcatMappend", dmconcatMappend ls) -- uses `mappend` which is incorrect, see above + print ("dmconcatSappend", dmconcatSappend ls) + print ("dmconcatUsingSconcat", dmconcatUsingSconcat ls) + + let undefinedList = l1 : undefined + fOn s f = print ("strictness " <> s, f undefinedList) + (fOn "mconcat" mconcat `finally` -- derived instance is fine, shows + fOn "gmconcat" gmconcat `finally` -- this is too strict - using mappend on lists needs all lists + fOn "dmconcatMappend" dmconcatMappend `finally` -- also too strict for the above + fOn "dmconcatSappend" dmconcatSappend `finally` -- correct strictness, shows + fOn "dmconcatUsingSconcat" dmconcatUsingSconcat -- sconcat is too strict as well + ) `catch` \(_ :: SomeException) -> pure () + +newtype L a = L [a] + deriving (Generic, Show, Eq) + deriving Monoid via (Generically (L a)) + +-- semigroup instance not derived with Generically, so it could be mis-aligned +-- with generic monoid definition +instance Semigroup (L a) where + L [] <> l = l + l <> _ = l + +-- generic (<>) +gappend :: forall a . (Generic a, Semigroup (Rep a ())) => a -> a -> a +gappend a b = to (from a <> from b :: Rep a ()) + +-- generic sconcat +gsconcat :: forall a . (Generic a, Semigroup (Rep a ())) => NE.NonEmpty a -> a +gsconcat = to . sconcat @(Rep a ()) . fmap from + +-- generic mconcat +gmconcat :: forall a . (Generic a, Monoid (Rep a ())) => [a] -> a +gmconcat = to . mconcat @(Rep a ()) . fmap from + +-- default sconcat +dsconcat :: forall a . Semigroup a => NE.NonEmpty a -> a +dsconcat (a NE.:| as) = go a as where + go b (c:cs) = b <> go c cs + go b [] = b + +-- default mconcat using mappend +dmconcatMappend :: Monoid a => [a] -> a +dmconcatMappend = foldr mappend mempty + +-- default mconcat using (<>), also the new generically impl +dmconcatSappend :: Monoid a => [a] -> a +dmconcatSappend = foldr (<>) mempty + +-- incorrect impl, too strict in the spine +dmconcatUsingSconcat :: Monoid a => [a] -> a +dmconcatUsingSconcat as = case as of + [] -> mempty + x : xs -> sconcat (x NE.:| xs) ===================================== testsuite/tests/generics/T27245.stdout ===================================== @@ -0,0 +1,13 @@ +("sappend",L [1]) +("mappend",L [1,2]) +("gappend",L [1,2]) +("sconcat",L [1]) +("mconcat",L [1]) +("gsconcat",L [1,2]) +("gmconcat",L [1,2]) +("dsconcat",L [1]) +("dmconcatMappend",L [1,2]) +("dmconcatSappend",L [1]) +("dmconcatUsingSconcat",L [1]) +("strictness mconcat",L [1]) +("strictness dmconcatSappend",L [1]) ===================================== testsuite/tests/generics/all.T ===================================== @@ -50,3 +50,4 @@ test('T19819', normal, compile_and_run, ['']) test('T21185', normal, compile, ['']) test('T25148a', normal, compile, ['']) test('T25148b', normal, compile, ['']) +test('T27245', normal, compile_and_run, ['']) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -11056,7 +11056,7 @@ instance GHC.Internal.Base.Monoid ghc-internal-10.100.0:GHC.Internal.Event.Inter instance GHC.Internal.Base.Monoid ghc-internal-10.100.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-10.100.0:GHC.Internal.Event.Internal.Types’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -11091,7 +11091,7 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data. instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -11316,7 +11316,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I instance GHC.Internal.Base.Monoid GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4262af3664e29b681753276203dc4474... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4262af3664e29b681753276203dc4474... You're receiving this email because of your account on gitlab.haskell.org.