[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add test for T23184
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Apr 1 01:59:56 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00
Add test for T23184
There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch:
```
commit 6656f0165a30fc2a22208532ba384fc8e2f11b46
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Jul 23 23:57:01 2021 +0100
A bunch of changes related to eta reduction
This is a large collection of changes all relating to eta
reduction, originally triggered by #18993, but there followed
a long saga.
Specifics:
...lots of lines omitted...
Other incidental changes
* Fix a fairly long-standing outright bug in the ApplyToVal case of
GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the
tail of 'dmds' in the recursive call, which meant the demands were All
Wrong. I have no idea why this has not caused problems before now.
```
Note this "Fix a fairly longstanding outright bug". This is the specific fix
```
@@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:_) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env dmds cont
+ do { let (dmd:cont_dmds) = dmds -- Never fails
+ ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplArg env' dup se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
```
Ticket #23184 is a report of the bug that this diff fixes.
- - - - -
709214a9 by mangoiv at 2023-03-31T21:59:42-04:00
[feat] make ($) representation polymorphic
- this change was approved by the CLC in [1] following a CLC proposal [2]
- make ($) representation polymorphic (adjust the type signature)
- change ($) implementation to allow additional polymorphism
- adjust the haddock of ($) to reflect these changes
- add additional documentation to document these changes
- add changelog entry
- adjust tests (move now succeeding tests and adjust stdout of some
tests)
[1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854
[2] https://github.com/haskell/core-libraries-committee/issues/132
- - - - -
d8955491 by Artem Pelenitsyn at 2023-03-31T21:59:48-04:00
User Guide: update copyright year: 2020->2023
- - - - -
19 changed files:
- docs/users_guide/conf.py
- libraries/base/GHC/Base.hs
- libraries/base/changelog.md
- testsuite/tests/dependent/ghci/T11549.stdout
- testsuite/tests/dependent/ghci/T11786.stdout
- testsuite/tests/ghci/scripts/T18755.stdout
- + testsuite/tests/simplCore/should_run/T23184.hs
- + testsuite/tests/simplCore/should_run/T23184.stdout
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
- − testsuite/tests/typecheck/should_fail/T5570.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_fail/T5570.hs → testsuite/tests/typecheck/should_run/T5570.hs
- + testsuite/tests/typecheck/should_run/T5570.stdout
- testsuite/tests/typecheck/should_run/all.T
Changes:
=====================================
docs/users_guide/conf.py
=====================================
@@ -47,7 +47,7 @@ rst_prolog = """
# General information about the project.
project = u'Glasgow Haskell Compiler'
-copyright = u'2020, GHC Team'
+copyright = u'2023, GHC Team'
# N.B. version comes from ghc_config
release = version # The full version, including alpha/beta/rc tags.
=====================================
libraries/base/GHC/Base.hs
=====================================
@@ -1598,6 +1598,14 @@ const x _ = x
flip :: (a -> b -> c) -> b -> a -> c
flip f x y = f y x
+-- Note: Before base-4.19, ($) was not representation polymorphic
+-- in both type parameters but only in the return type.
+-- The generalization forced a change to the implementation,
+-- changing its laziness, affecting expressions like (($) undefined): before
+-- base-4.19 the expression (($) undefined) `seq` () was equivalent to
+-- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now
+-- it is equivalent to undefined `seq` () which diverges.
+
-- | Application operator. This operator is redundant, since ordinary
-- application @(f x)@ means the same as @(f '$' x)@. However, '$' has
-- low, right-associative binding precedence, so it sometimes allows
@@ -1608,11 +1616,11 @@ flip f x y = f y x
-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
-- or @'Data.List.zipWith' ('$') fs xs at .
--
--- Note that @('$')@ is representation-polymorphic in its result type, so that
--- @foo '$' True@ where @foo :: Bool -> Int#@ is well-typed.
+-- Note that @('$')@ is representation-polymorphic, so that
+-- @foo '$' 4#@ where @foo :: Int# -> Int#@ is well-typed.
{-# INLINE ($) #-}
-($) :: forall r a (b :: TYPE r). (a -> b) -> a -> b
-f $ x = f x
+($) :: forall repa repb (a :: TYPE repa) (b :: TYPE repb). (a -> b) -> a -> b
+($) f = f
-- | Strict (call-by-value) application operator. It takes a function and an
-- argument, evaluates the argument to weak head normal form (WHNF), then calls
=====================================
libraries/base/changelog.md
=====================================
@@ -21,6 +21,7 @@
([CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148))
* Add `COMPLETE` pragmas to the `TypeRep`, `SSymbol`, `SChar`, and `SNat` pattern synonyms.
([CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149))
+ * Make `($)` representation polymorphic ([CLC proposal #132](https://github.com/haskell/core-libraries-committee/issues/132))
## 4.18.0.0 *TBA*
* Shipped with GHC 9.6.1
=====================================
testsuite/tests/dependent/ghci/T11549.stdout
=====================================
@@ -8,8 +8,14 @@ error :: GHC.Stack.Types.HasCallStack => [Char] -> a
-- Defined in ‘GHC.Err’
-fprint-explicit-runtime-reps
-($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b
-($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b
+($)
+ :: forall (repa :: RuntimeRep) (repb :: RuntimeRep)
+ (a :: TYPE repa) (b :: TYPE repb).
+ (a -> b) -> a -> b
+($) ::
+ forall (repa :: RuntimeRep) (repb :: RuntimeRep) (a :: TYPE repa)
+ (b :: TYPE repb).
+ (a -> b) -> a -> b
-- Defined in ‘GHC.Base’
infixr 0 $
TYPE :: RuntimeRep -> *
=====================================
testsuite/tests/dependent/ghci/T11786.stdout
=====================================
@@ -3,13 +3,16 @@
($) :: (a -> b) -> a -> b -- Defined in ‘GHC.Base’
infixr 0 $
($)
- :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+ :: forall (repa :: GHC.Types.RuntimeRep)
+ (repb :: GHC.Types.RuntimeRep) (a :: TYPE repa) (b :: TYPE repb).
(a -> b) -> a -> b
(($))
- :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+ :: forall (repa :: GHC.Types.RuntimeRep)
+ (repb :: GHC.Types.RuntimeRep) (a :: TYPE repa) (b :: TYPE repb).
(a -> b) -> a -> b
($) ::
- forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+ forall (repa :: GHC.Types.RuntimeRep)
+ (repb :: GHC.Types.RuntimeRep) (a :: TYPE repa) (b :: TYPE repb).
(a -> b) -> a -> b
-- Defined in ‘GHC.Base’
infixr 0 $
=====================================
testsuite/tests/ghci/scripts/T18755.stdout
=====================================
@@ -1,3 +1,4 @@
($)
- :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+ :: forall (repa :: GHC.Types.RuntimeRep)
+ (repb :: GHC.Types.RuntimeRep) (a :: TYPE repa) (b :: TYPE repb).
(a -> b) -> a -> b
=====================================
testsuite/tests/simplCore/should_run/T23184.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import GHC.Magic
+
+main :: IO ()
+main = print $ noinline (\x -> sum $ tardisManual [0..x]) 0
+
+tardisManual :: [Int] -> [Int]
+tardisManual xs =
+ let
+ go [] !acc _ = ([], 0)
+ go (_:xs) !acc l =
+ let (xs', _) = go xs acc l
+ in (l:xs', 0)
+ (r, l) = go xs True l
+ in r
+{-# INLINE tardisManual #-}
=====================================
testsuite/tests/simplCore/should_run/T23184.stdout
=====================================
@@ -0,0 +1 @@
+0
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -109,4 +109,5 @@ test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O'])
test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836
test('T22448', normal, compile_and_run, ['-O1'])
test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint'])
+test('T23184', normal, compile_and_run, ['-O'])
=====================================
testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
=====================================
@@ -115,10 +115,10 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
- ($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
- where ($) :: forall a b. (a -> b) -> a -> b
($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ ($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
+ where ($) :: forall a b. (a -> b) -> a -> b
return (_ :: [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: [Integer] -> Integer) (_ :: t0)
@@ -237,10 +237,10 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
- ($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
- where ($) :: forall a b. (a -> b) -> a -> b
($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ ($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
+ where ($) :: forall a b. (a -> b) -> a -> b
return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -184,7 +184,6 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
round :: forall a b. (RealFrac a, Integral b) => a -> b
truncate :: forall a b. (RealFrac a, Integral b) => a -> b
seq :: forall a b. a -> b -> b
- ($) :: forall a b. (a -> b) -> a -> b
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
@@ -194,5 +193,6 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
+ ($) :: forall a b. (a -> b) -> a -> b
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -187,7 +187,6 @@ holes3.hs:11:15: error: [GHC-88464]
round :: forall a b. (RealFrac a, Integral b) => a -> b
truncate :: forall a b. (RealFrac a, Integral b) => a -> b
seq :: forall a b. a -> b -> b
- ($) :: forall a b. (a -> b) -> a -> b
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
@@ -197,5 +196,6 @@ holes3.hs:11:15: error: [GHC-88464]
unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
+ ($) :: forall a b. (a -> b) -> a -> b
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
=====================================
testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
=====================================
@@ -67,7 +67,10 @@ refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(and originally defined in ‘GHC.Base’))
($) (_ :: [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- with ($) @GHC.Types.LiftedRep @[Integer] @Integer
+ with ($) @GHC.Types.LiftedRep
+ @GHC.Types.LiftedRep
+ @[Integer]
+ @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
($!) (_ :: [Integer] -> Integer)
@@ -168,7 +171,10 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(and originally defined in ‘GHC.Base’))
($) (_ :: Integer -> [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- with ($) @GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
+ with ($) @GHC.Types.LiftedRep
+ @GHC.Types.LiftedRep
+ @Integer
+ @([Integer] -> Integer)
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
($!) (_ :: Integer -> [Integer] -> Integer)
=====================================
testsuite/tests/typecheck/should_fail/T14884.stderr
=====================================
@@ -23,7 +23,7 @@ T14884.hs:4:5: error: [GHC-88464]
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
($) :: forall a b. (a -> b) -> a -> b
- with ($) @GHC.Types.LiftedRep @String @(IO ())
+ with ($) @GHC.Types.LiftedRep @GHC.Types.LiftedRep @String @(IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
($!) :: forall a b. (a -> b) -> a -> b
=====================================
testsuite/tests/typecheck/should_fail/T5570.stderr deleted
=====================================
@@ -1,6 +0,0 @@
-
-T5570.hs:7:16: error: [GHC-83865]
- • Expected a lifted type, but ‘Double#’ is a DoubleRep type
- • In the first argument of ‘($)’, namely ‘D#’
- In the second argument of ‘($)’, namely ‘D# $ 3.0##’
- In the expression: print $ D# $ 3.0##
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -265,7 +265,6 @@ test('AssocTyDef07', normal, compile_fail, [''])
test('AssocTyDef08', normal, compile_fail, [''])
test('AssocTyDef09', normal, compile_fail, [''])
test('T3592', normal, compile_fail, [''])
-test('T5570', normal, compile_fail, [''])
test('T5691', normal, compile_fail, [''])
test('T5689', normal, compile_fail, [''])
test('T5684', normal, compile_fail, [''])
=====================================
testsuite/tests/typecheck/should_fail/T5570.hs → testsuite/tests/typecheck/should_run/T5570.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE MagicHash #-}
-module T5570 where
+module Main where
import GHC.Exts
=====================================
testsuite/tests/typecheck/should_run/T5570.stdout
=====================================
@@ -0,0 +1 @@
+3.0
=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -94,6 +94,7 @@ test('T4809', normal, compile_and_run, [''])
test('T2722', normal, compile_and_run, [''])
test('mc17', normal, compile_and_run, [''])
test('T5759', normal, compile_and_run, [''])
+test('T5570', normal, compile_and_run, [''])
test('T5573a', omit_ways(['ghci']), compile_and_run, [''])
test('T5573b', omit_ways(['ghci']), compile_and_run, [''])
test('T7023', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f361393418831461e4b8949e4b7dd0bf4ae6909d...d895549185f5cef314ca679b4b1e112c07d42ad2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f361393418831461e4b8949e4b7dd0bf4ae6909d...d895549185f5cef314ca679b4b1e112c07d42ad2
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/20230331/d500c9b0/attachment-0001.html>
More information about the ghc-commits
mailing list