[Git][ghc/ghc][master] Export foldl' from Prelude and bump submodules
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Sep 1 03:53:53 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
f1ec3628 by Bodigrim at 2023-08-31T23:53:30-04:00
Export foldl' from Prelude and bump submodules
See https://github.com/haskell/core-libraries-committee/issues/167 for discussion
Metric Decrease:
T8095
T13386
Metric Increase:
T13386
T8095
T8095 ghc/alloc decreased on x86_64, but increased on aarch64.
T13386 ghc/alloc decreased on x86_64-windows, but increased on other platforms.
Neither has anything to do with `foldl'`, so I conclude that both are flaky.
- - - - -
22 changed files:
- compiler/GHC/Prelude/Basic.hs
- libraries/base/GHC/ResponseFile.hs
- libraries/base/Prelude.hs
- libraries/base/changelog.md
- libraries/binary
- 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_compile/T19894/Array.hs
- testsuite/tests/profiling/should_compile/T19894/Fold.hs
- testsuite/tests/profiling/should_compile/T19894/MArray.hs
- testsuite/tests/profiling/should_compile/T19894/StreamD.hs
- testsuite/tests/profiling/should_compile/T19894/StreamK.hs
- testsuite/tests/rename/should_fail/T11071a.hs
- testsuite/tests/rename/should_fail/T11071a.stderr
- testsuite/tests/rts/T14497.hs
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- utils/ghc-pkg/Main.hs
- utils/hsc2hs
Changes:
=====================================
compiler/GHC/Prelude/Basic.hs
=====================================
@@ -55,9 +55,9 @@ NoImplicitPrelude. There are two motivations for this:
-}
import qualified Prelude
-import Prelude as X hiding ((<>), Applicative(..), head, tail)
+import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail)
import Control.Applicative (Applicative(..))
-import Data.Foldable as X (foldl')
+import Data.Foldable as X (Foldable(elem, foldMap, foldr, foldl, foldl', foldr1, foldl1, maximum, minimum, product, sum, null, length))
import GHC.Stack.Types (HasCallStack)
#if MIN_VERSION_base(4,16,0)
=====================================
libraries/base/GHC/ResponseFile.hs
=====================================
@@ -23,9 +23,10 @@ module GHC.ResponseFile (
expandResponse
) where
+import Prelude hiding (Foldable(..))
import Control.Exception
import Data.Char (isSpace)
-import Data.Foldable (foldl')
+import Data.Foldable (Foldable(..))
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO
=====================================
libraries/base/Prelude.hs
=====================================
@@ -85,7 +85,7 @@ module Prelude (
foldr, -- :: (a -> b -> b) -> b -> t a -> b
-- foldr', -- :: (a -> b -> b) -> b -> t a -> b
foldl, -- :: (b -> a -> b) -> b -> t a -> b
- -- foldl', -- :: (b -> a -> b) -> b -> t a -> b
+ foldl', -- :: (b -> a -> b) -> b -> t a -> b
foldr1, -- :: (a -> a -> a) -> t a -> a
foldl1, -- :: (a -> a -> a) -> t a -> a
maximum, -- :: (Foldable t, Ord a) => t a -> a
=====================================
libraries/base/changelog.md
=====================================
@@ -1,10 +1,10 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.20.0.0 *TBA*
+ * Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
* 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))
* 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))
-
## 4.19.0.0 *TBA*
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.
Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it.
=====================================
libraries/binary
=====================================
@@ -1 +1 @@
-Subproject commit 96599519783a5e02e9f050744a7ce5fb0940dc99
+Subproject commit b30971d569e934cd54d08c45c7e906cfe8af3709
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9795,7 +9795,7 @@ module Prelude where
foldr :: forall a b. (a -> b -> b) -> b -> t a -> b
...
foldl :: forall b a. (b -> a -> b) -> b -> t a -> b
- ...
+ foldl' :: forall b a. (b -> a -> b) -> b -> t a -> b
foldr1 :: forall a. (a -> a -> a) -> t a -> a
foldl1 :: forall a. (a -> a -> a) -> t a -> a
...
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -12573,7 +12573,7 @@ module Prelude where
foldr :: forall a b. (a -> b -> b) -> b -> t a -> b
...
foldl :: forall b a. (b -> a -> b) -> b -> t a -> b
- ...
+ foldl' :: forall b a. (b -> a -> b) -> b -> t a -> b
foldr1 :: forall a. (a -> a -> a) -> t a -> a
foldl1 :: forall a. (a -> a -> a) -> t a -> a
...
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -10081,7 +10081,7 @@ module Prelude where
foldr :: forall a b. (a -> b -> b) -> b -> t a -> b
...
foldl :: forall b a. (b -> a -> b) -> b -> t a -> b
- ...
+ foldl' :: forall b a. (b -> a -> b) -> b -> t a -> b
foldr1 :: forall a. (a -> a -> a) -> t a -> a
foldl1 :: forall a. (a -> a -> a) -> t a -> a
...
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9799,7 +9799,7 @@ module Prelude where
foldr :: forall a b. (a -> b -> b) -> b -> t a -> b
...
foldl :: forall b a. (b -> a -> b) -> b -> t a -> b
- ...
+ foldl' :: forall b a. (b -> a -> b) -> b -> t a -> b
foldr1 :: forall a. (a -> a -> a) -> t a -> a
foldl1 :: forall a. (a -> a -> a) -> t a -> a
...
=====================================
testsuite/tests/profiling/should_compile/T19894/Array.hs
=====================================
@@ -25,7 +25,7 @@ import Unfold (Unfold(..))
import Fold (Fold(..))
import qualified MArray as MA
import qualified Unfold as UF
-import Prelude hiding (length, read)
+import Prelude hiding (Foldable(..), read)
data Array a =
Array
=====================================
testsuite/tests/profiling/should_compile/T19894/Fold.hs
=====================================
@@ -17,7 +17,7 @@ import Data.Bifunctor (Bifunctor(..))
#if defined(FUSION_PLUGIN)
import Fusion.Plugin.Types (Fuse(..))
#endif
-import Prelude hiding (sum, take)
+import Prelude hiding (Foldable(..), take)
------------------------------------------------------------------------------
-- Step of a fold
=====================================
testsuite/tests/profiling/should_compile/T19894/MArray.hs
=====================================
@@ -45,7 +45,7 @@ import qualified GHC.ForeignPtr as GHC
import qualified Fold as FL
import qualified StreamD as D
import qualified StreamK as K
-import Prelude hiding (length, read)
+import Prelude hiding (Foldable(..), read)
data Array a =
Array
=====================================
testsuite/tests/profiling/should_compile/T19894/StreamD.hs
=====================================
@@ -108,7 +108,7 @@ import Data.Functor.Identity (Identity(..))
-- import Fusion.Plugin.Types (Fuse(..))
import GHC.Base (build)
import GHC.Types (SPEC(..))
-import Prelude hiding (map, mapM, foldr, take, concatMap, takeWhile, replicate)
+import Prelude hiding (map, mapM, Foldable(..), take, concatMap, takeWhile, replicate)
import Unfold (Unfold(..))
import Fold (Fold(..))
=====================================
testsuite/tests/profiling/should_compile/T19894/StreamK.hs
=====================================
@@ -101,7 +101,7 @@ import Control.Monad.IO.Class (MonadIO(..))
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
-import Prelude hiding (map, mapM, concatMap, foldr)
+import Prelude hiding (map, mapM, concatMap, Foldable(..))
-- import Streamly.Internal.Data.SVar
=====================================
testsuite/tests/rename/should_fail/T11071a.hs
=====================================
@@ -10,7 +10,7 @@ ignore = const (return ())
main = do
ignore intersperse -- missing in import list (one import)
- ignore foldl' -- missing in import list (two imports)
+ ignore union -- missing in import list (two imports)
ignore Down -- explicitly hidden
ignore True -- explicitly hidden from prelude (not really special)
ignore foobar -- genuinely out of scope
=====================================
testsuite/tests/rename/should_fail/T11071a.stderr
=====================================
@@ -6,12 +6,9 @@ T11071a.hs:12:12: error: [GHC-88464]
(at T11071a.hs:3:1-24).
T11071a.hs:13:12: error: [GHC-88464]
- Variable not in scope: foldl'
- Suggested fixes:
- • Perhaps use one of these:
- ‘foldl’ (imported from Prelude), ‘foldl1’ (imported from Prelude),
- ‘foldr’ (imported from Prelude)
- • Add ‘foldl'’ to one of these import lists:
+ Variable not in scope: union
+ Suggested fix:
+ • Add ‘union’ to one of these import lists:
‘Data.List’ (at T11071a.hs:3:1-24)
‘Data.IntMap’ (at T11071a.hs:4:1-21)
=====================================
testsuite/tests/rts/T14497.hs
=====================================
@@ -9,5 +9,5 @@ fuc n = n * fuc (n - 1)
main :: IO ()
main = do
let x = fuc 30000
- timeout 1000 (print x)
+ timeout 500 (print x)
print (x > 0)
=====================================
testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
=====================================
@@ -27,6 +27,10 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
+ foldl' (_ :: Integer -> Integer -> Integer) (_ :: Integer)
+ where foldl' :: forall (t :: * -> *) b a.
+ Foldable t =>
+ (b -> a -> b) -> b -> t a -> b
foldr (_ :: Integer -> Integer -> Integer) (_ :: Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
@@ -140,6 +144,10 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
+ foldl' (_ :: Integer -> Integer -> Integer)
+ where foldl' :: forall (t :: * -> *) b a.
+ Foldable t =>
+ (b -> a -> b) -> b -> t a -> b
foldr (_ :: Integer -> Integer -> Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
=====================================
testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
=====================================
@@ -28,6 +28,10 @@ constraint_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
where foldl :: forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
+ foldl' (_ :: a -> a -> a) (_ :: a)
+ where foldl' :: forall (t :: * -> *) b a.
+ Foldable t =>
+ (b -> a -> b) -> b -> t a -> b
foldr (_ :: a -> a -> a) (_ :: a)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
=====================================
testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
=====================================
@@ -53,6 +53,13 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with foldl @[] @Integer @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘Data.Foldable’))
+ foldl' (_ :: Integer -> Integer -> Integer) (_ :: Integer)
+ where foldl' :: forall (t :: * -> *) b a.
+ Foldable t =>
+ (b -> a -> b) -> b -> t a -> b
+ with foldl' @[] @Integer @Integer
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘Data.Foldable’))
foldr (_ :: Integer -> Integer -> Integer) (_ :: Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
@@ -147,6 +154,13 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with foldl @[] @Integer @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘Data.Foldable’))
+ foldl' (_ :: Integer -> Integer -> Integer)
+ where foldl' :: forall (t :: * -> *) b a.
+ Foldable t =>
+ (b -> a -> b) -> b -> t a -> b
+ with foldl' @[] @Integer @Integer
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘Data.Foldable’))
foldr (_ :: Integer -> Integer -> Integer)
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
=====================================
utils/ghc-pkg/Main.hs
=====================================
@@ -56,7 +56,8 @@ import System.Directory ( getXdgDirectory, createDirectoryIfMissing, getAppUserD
getModificationTime, XdgDirectory ( XdgData ) )
import Text.Printf
-import Prelude
+import Prelude hiding (Foldable(..))
+import Data.Foldable (Foldable(..))
import System.Console.GetOpt
import qualified Control.Exception as Exception
@@ -75,7 +76,7 @@ import System.IO.Error
import GHC.IO ( catchException )
import GHC.IO.Exception (IOErrorType(InappropriateType))
import Data.List ( group, sort, sortBy, nub, partition, find
- , intercalate, intersperse, foldl', unfoldr
+ , intercalate, intersperse, unfoldr
, isInfixOf, isSuffixOf, isPrefixOf, stripPrefix )
import Control.Concurrent
import qualified Data.Foldable as F
=====================================
utils/hsc2hs
=====================================
@@ -1 +1 @@
-Subproject commit 1ee25e923b769c8df310f7e8690ad7622eb4d446
+Subproject commit 5bf5c61e7c6e813d03bc069e17289c574185d41c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1ec362817baa5d440a9f2b3a8b17e5513538119
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1ec362817baa5d440a9f2b3a8b17e5513538119
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/20230831/70fec57f/attachment-0001.html>
More information about the ghc-commits
mailing list