[Git][ghc/ghc][master] 2 commits: Speed up stimes in instance Semigroup Endo
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Nov 20 23:53:45 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
5a6c49d4 by David Feuer at 2023-11-20T18:53:18-05:00
Speed up stimes in instance Semigroup Endo
As discussed at
https://github.com/haskell/core-libraries-committee/issues/4
- - - - -
cf9da4b3 by Andrew Lelechenko at 2023-11-20T18:53:18-05:00
base: reflect latest changes in the changelog
- - - - -
5 changed files:
- libraries/base/changelog.md
- libraries/base/src/Data/Semigroup/Internal.hs
- libraries/base/tests/all.T
- + libraries/base/tests/stimesEndo.hs
- + libraries/base/tests/stimesEndo.stdout
Changes:
=====================================
libraries/base/changelog.md
=====================================
@@ -3,7 +3,9 @@
## 4.20.0.0 *TBA*
* Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
* Add `permutations` and `permutations1` to `Data.List.NonEmpty` ([CLC proposal #68](https://github.com/haskell/core-libraries-committee/issues/68))
- * Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #174](https://github.com/haskell/core-libraries-committee/issues/175))
+ * Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #175](https://github.com/haskell/core-libraries-committee/issues/175))
+ * Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4))
+ * 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/).
* Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`
@@ -29,6 +31,8 @@
constructors in scope and the levity of `t` is statically known,
then the constraint `DataToTag t` can always be solved.
+ ([CLC proposal #104](https://github.com/haskell/core-libraries-committee/issues/104))
+
## 4.19.0.0 *October 2023*
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.
Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it.
=====================================
libraries/base/src/Data/Semigroup/Internal.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
@@ -134,8 +135,46 @@ newtype Endo a = Endo { appEndo :: a -> a }
-- | @since 4.9.0.0
instance Semigroup (Endo a) where
- (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
- stimes = stimesMonoid
+ (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
+
+ -- See Note [stimes Endo]
+ stimes !n0 (Endo e) = Endo (\a0 ->
+ -- We check separately for 0 and 1 per
+ -- https://github.com/haskell/core-libraries-committee/issues/4#issuecomment-955605592
+ -- We are explicitly strict in the number so strictness is calculated
+ -- correctly even without specialization.
+ case n0 of
+ _ | n0 < 0 -> stimesEndoError
+ 0 -> a0
+ 1 -> e a0
+ _ -> go n0 a0)
+ where
+ go !0 a = a
+ go n a = e (go (n - 1) a)
+
+{-# NOINLINE stimesEndoError #-}
+-- There's no reason to put this gunk in the unfolding.
+stimesEndoError :: a
+stimesEndoError = errorWithoutStackTrace "stimes (for Endo): negative multiplier"
+
+-- Note [stimes Endo]
+-- ~~~~~~~~~~~~~~~~~~
+--
+-- We used to use
+--
+-- stimes = stimesMonoid
+--
+-- But this is pretty bad! The function it produces is represented in memory as
+-- a balanced tree of compositions. To actually *apply* that function, it's
+-- necessary to walk the tree. It's much better to just construct a function
+-- that counts out applications.
+--
+-- Why do we break open the `Endo` construction rather than just using `mempty`
+-- and `<>`? We want GHC to infer that `stimes` has an arity of 3. Currently,
+-- it does so by default, but there has been some talk in the past of turning
+-- on -fpedantic-bottoms, which would drop the arity to 2. Indeed, if we were
+-- really careless, we could theoretically get GHC to build a *list* of
+-- compositions, which would be awful.
-- | @since 2.01
instance Monoid (Endo a) where
=====================================
libraries/base/tests/all.T
=====================================
@@ -317,3 +317,4 @@ test('T23697',
[ when(opsys('mingw32'), skip) # header not found
, when(opsys('darwin'), skip) # permission denied
], makefile_test, ['T23697'])
+test('stimesEndo', normal, compile_and_run, [''])
=====================================
libraries/base/tests/stimesEndo.hs
=====================================
@@ -0,0 +1,9 @@
+module Main where
+
+import Data.Semigroup
+
+adder :: Int -> Endo Int
+adder n = stimes n (Endo (+ 1))
+
+main :: IO ()
+main = print $ map (\n -> appEndo (adder n) 0) [0 .. 5]
=====================================
libraries/base/tests/stimesEndo.stdout
=====================================
@@ -0,0 +1 @@
+[0,1,2,3,4,5]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/615441ef8bbdbb09ba1b354e8dc234b4aefb863a...cf9da4b3b2af33218ad315a8b2bfb282fb010104
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/615441ef8bbdbb09ba1b354e8dc234b4aefb863a...cf9da4b3b2af33218ad315a8b2bfb282fb010104
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/20231120/4e15219e/attachment-0001.html>
More information about the ghc-commits
mailing list