diff options
author | mangoiv <mail@mangoiv.com> | 2023-03-30 13:08:43 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-01 04:20:01 -0400 |
commit | 62d25071791b68fa63a2bb007fd1ac565795a9c5 (patch) | |
tree | 5a38d4684b5b6c807e42df2119600c5731aeda2c | |
parent | 0077cb225bde18ee6c7ff49d6486eb20fc6c011a (diff) | |
download | haskell-62d25071791b68fa63a2bb007fd1ac565795a9c5.tar.gz |
[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
-rw-r--r-- | libraries/base/GHC/Base.hs | 16 | ||||
-rw-r--r-- | libraries/base/changelog.md | 1 | ||||
-rw-r--r-- | testsuite/tests/dependent/ghci/T11549.stdout | 10 | ||||
-rw-r--r-- | testsuite/tests/dependent/ghci/T11786.stdout | 9 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T18755.stdout | 3 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr | 8 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/holes.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/holes3.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr | 10 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T14884.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T5570.stderr | 6 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_run/T5570.hs (renamed from testsuite/tests/typecheck/should_fail/T5570.hs) | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_run/T5570.stdout | 1 | ||||
-rwxr-xr-x | testsuite/tests/typecheck/should_run/all.T | 1 |
15 files changed, 47 insertions, 27 deletions
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index a078676d0f..de99446079 100644 --- a/libraries/base/GHC/Base.hs +++ b/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@. -- --- 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 diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index 76a79abb3f..fcfaed25ec 100644 --- a/libraries/base/changelog.md +++ b/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 diff --git a/testsuite/tests/dependent/ghci/T11549.stdout b/testsuite/tests/dependent/ghci/T11549.stdout index b1edea905d..8b74c72e63 100644 --- a/testsuite/tests/dependent/ghci/T11549.stdout +++ b/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 -> * diff --git a/testsuite/tests/dependent/ghci/T11786.stdout b/testsuite/tests/dependent/ghci/T11786.stdout index b43290bd2a..c8281393e5 100644 --- a/testsuite/tests/dependent/ghci/T11786.stdout +++ b/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 $ diff --git a/testsuite/tests/ghci/scripts/T18755.stdout b/testsuite/tests/ghci/scripts/T18755.stdout index c69cdfaf37..57358ed396 100644 --- a/testsuite/tests/ghci/scripts/T18755.stdout +++ b/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 diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr index 628a78aea6..c87b80b3b1 100644 --- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr +++ b/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) diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr index 5dfb035931..31025b670a 100644 --- a/testsuite/tests/typecheck/should_compile/holes.stderr +++ b/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] diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr index 72b16b9e5d..c4bf422a71 100644 --- a/testsuite/tests/typecheck/should_compile/holes3.stderr +++ b/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] diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr index 6dc4f2ba0a..7ded5f9b8a 100644 --- a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr +++ b/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) diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr index 5ce38cdecb..1451df6d79 100644 --- a/testsuite/tests/typecheck/should_fail/T14884.stderr +++ b/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 diff --git a/testsuite/tests/typecheck/should_fail/T5570.stderr b/testsuite/tests/typecheck/should_fail/T5570.stderr deleted file mode 100644 index bce53fe394..0000000000 --- a/testsuite/tests/typecheck/should_fail/T5570.stderr +++ /dev/null @@ -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## diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 2afc480451..07bfcd8436 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/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, ['']) diff --git a/testsuite/tests/typecheck/should_fail/T5570.hs b/testsuite/tests/typecheck/should_run/T5570.hs index 3dcc4d8be4..7e84bc7796 100644 --- a/testsuite/tests/typecheck/should_fail/T5570.hs +++ b/testsuite/tests/typecheck/should_run/T5570.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash #-} -module T5570 where +module Main where import GHC.Exts diff --git a/testsuite/tests/typecheck/should_run/T5570.stdout b/testsuite/tests/typecheck/should_run/T5570.stdout new file mode 100644 index 0000000000..9f55b2ccb5 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T5570.stdout @@ -0,0 +1 @@ +3.0 diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 7a5d4a484a..e3b3fb4817 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/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, ['']) |