[Git][ghc/ghc][master] Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
486979b0 by Jade at 2024-02-19T07:12:13-05:00
Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First

Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246
Fixes: #24346

- - - - -


8 changed files:

- libraries/base/changelog.md
- libraries/base/src/Data/Semigroup.hs
- libraries/ghc-internal/src/Data/Monoid.hs
- + testsuite/tests/lib/base/First-Monoid-sconcat.hs
- + testsuite/tests/lib/base/First-Monoid-sconcat.stdout
- + testsuite/tests/lib/base/First-Semigroup-sconcat.hs
- + testsuite/tests/lib/base/First-Semigroup-sconcat.stdout
- testsuite/tests/lib/base/all.T


Changes:

=====================================
libraries/base/changelog.md
=====================================
@@ -7,6 +7,7 @@
   * Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4))
   * Add `startTimeProfileAtStartup` to `GHC.RTS.Flags` to expose new RTS flag
     `--no-automatic-heap-samples` in the Haskell API ([CLC proposal #243](https://github.com/haskell/core-libraries-committee/issues/243)).
+  * Implement `sconcat` for `instance Semigroup Data.Semigroup.First` and `instance Semigroup Data.Monoid.First` explicitly, increasing laziness ([CLC proposal #246](https://github.com/haskell/core-libraries-committee/issues/246))
   * Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
   * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
   * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).


=====================================
libraries/base/src/Data/Semigroup.hs
=====================================
@@ -458,6 +458,7 @@ instance Enum a => Enum (First a) where
 instance Semigroup (First a) where
   a <> _ = a
   stimes = stimesIdempotent
+  sconcat (x :| _) = x
 
 -- | @since 4.9.0.0
 instance Functor First where


=====================================
libraries/ghc-internal/src/Data/Monoid.hs
=====================================
@@ -156,6 +156,10 @@ instance Semigroup (First a) where
         First Nothing <> b = b
         a             <> _ = a
         stimes = stimesIdempotentMonoid
+        sconcat (first@(First m) :| rest)
+          | Nothing <- m = mconcat rest
+          | otherwise    = first
+
 
 -- | @since 2.01
 instance Monoid (First a) where


=====================================
testsuite/tests/lib/base/First-Monoid-sconcat.hs
=====================================
@@ -0,0 +1,10 @@
+module Main where
+
+import Data.Monoid (First(..))
+import Data.Semigroup (sconcat)
+import Data.List.NonEmpty (NonEmpty(..))
+
+main = do
+  print . sconcat $ First Nothing :| First (Just 1) : undefined
+  print . sconcat $ First (Just 2) :| undefined
+  print . sconcat $ First Nothing :| First Nothing : First (Just 3) : []


=====================================
testsuite/tests/lib/base/First-Monoid-sconcat.stdout
=====================================
@@ -0,0 +1,3 @@
+First {getFirst = Just 1}
+First {getFirst = Just 2}
+First {getFirst = Just 3}


=====================================
testsuite/tests/lib/base/First-Semigroup-sconcat.hs
=====================================
@@ -0,0 +1,8 @@
+module Main where
+
+import Data.Semigroup (sconcat, First(..))
+import Data.List.NonEmpty (NonEmpty(..))
+
+main = do
+  print . sconcat $ First 1 :| undefined
+  print . sconcat $ First 1 :| First 2 : []


=====================================
testsuite/tests/lib/base/First-Semigroup-sconcat.stdout
=====================================
@@ -0,0 +1,2 @@
+First {getFirst = 1}
+First {getFirst = 1}


=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -9,3 +9,5 @@ test('T17472', normal, compile_and_run, [''])
 test('T19569b', omit_ghci, compile_and_run, [''])
 test('Monoid_ByteArray', normal, compile_and_run, [''])
 test('Unsnoc', normal, compile_and_run, [''])
+test('First-Semigroup-sconcat', normal, compile_and_run, [''])
+test('First-Monoid-sconcat', normal, compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/486979b011ac8e75bb1998dc9c389753597201e7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/486979b011ac8e75bb1998dc9c389753597201e7
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240219/88c93cbf/attachment-0001.html>