diff options
| -rw-r--r-- | compiler/GHC/Builtin/Types.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Utils.hs | 8 | ||||
| -rw-r--r-- | libraries/base/GHC/Read.hs | 20 | ||||
| -rw-r--r-- | libraries/base/GHC/Show.hs | 4 | ||||
| -rw-r--r-- | libraries/base/tests/all.T | 1 | ||||
| -rw-r--r-- | libraries/base/tests/read-show-solo.hs | 9 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Tuple.hs | 10 |
7 files changed, 23 insertions, 41 deletions
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 421029a4fb..1c587810ba 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -74,6 +74,7 @@ module GHC.Builtin.Types ( tupleTyCon, tupleDataCon, tupleTyConName, tupleDataConName, promotedTupleDataCon, unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey, + soloTyCon, pairTyCon, mkPromotedPairTy, isPromotedPairType, unboxedUnitTy, unboxedUnitTyCon, unboxedUnitDataCon, @@ -288,6 +289,14 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they -- need to look out for them. unitTyCon , unboxedUnitTyCon + + -- Solo (i.e., the bosed 1-tuple) is also not treated + -- like other tuples (i.e. we /do/ include it here), + -- since it does not use special syntax like other tuples + -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names + -- have known keys) in GHC.Builtin.Types. + , soloTyCon + , anyTyCon , boolTyCon , charTyCon @@ -1208,6 +1217,9 @@ unitDataCon = head (tyConDataCons unitTyCon) unitDataConId :: Id unitDataConId = dataConWorkId unitDataCon +soloTyCon :: TyCon +soloTyCon = tupleTyCon Boxed 1 + pairTyCon :: TyCon pairTyCon = tupleTyCon Boxed 2 diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs index 16d5096605..9d91b1246d 100644 --- a/compiler/GHC/Builtin/Utils.hs +++ b/compiler/GHC/Builtin/Utils.hs @@ -62,7 +62,6 @@ import GHC.Core.Class import GHC.Core.TyCon import GHC.Types.Avail -import GHC.Types.Basic import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env @@ -130,13 +129,6 @@ knownKeyNames = all_names where all_names = - -- We exclude most tuples from this list—see - -- Note [Infinite families of known-key names] in GHC.Builtin.Names. - -- We make an exception for Solo (i.e., the boxed 1-tuple), since it does - -- not use special syntax like other tuples. - -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) - -- in GHC.Builtin.Types. - tupleTyConName BoxedTuple 1 : tupleDataConName Boxed 1 : concat [ concatMap wired_tycon_kk_names primTyCons , concatMap wired_tycon_kk_names wiredInTyCons , concatMap wired_tycon_kk_names typeNatTyCons diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index 43e5ee5b32..7f698ec498 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -669,25 +669,7 @@ instance Read () where readList = readListDefault -- | @since 4.15 -instance Read a => Read (Solo a) where - -- Since our `show` doesn't show record syntax, we want to accept non-record - -- syntax. Since Solo is actually a record, it only seems fair to accept - -- record syntax as well. - readPrec = parens $ - (prec appPrec $ - do expectP (L.Ident "Solo") - x <- step readPrec - return (Solo x)) - +++ - (prec appPrec1 - (do expectP (L.Ident "Solo") - expectP (L.Punc "{") - x <- readField - "getSolo" (reset readPrec) - expectP (L.Punc "}") - return (Solo x))) - - readListPrec = readListPrecDefault +deriving instance Read a => Read (Solo a) -- | @since 2.01 instance (Read a, Read b) => Read (a,b) where diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index ecfb7dbe0f..04fbcb6112 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -169,9 +169,7 @@ appPrec1 = I# 11# -- appPrec + 1 deriving instance Show () -- | @since 4.15 -instance Show a => Show (Solo a) where - showsPrec d (Solo x) = showParen (d > 10) $ - showString "Solo " . showsPrec 11 x +deriving instance Show a => Show (Solo a) -- | @since 2.01 instance Show a => Show [a] where diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index 371ed56327..ebbf81ec52 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -45,7 +45,6 @@ test('inits', normal, compile_and_run, ['']) test('genericNegative001', extra_run_opts('-1'), compile_and_run, ['']) test('ix001', normal, compile_and_run, ['']) test('isValidNatural', normal, compile_and_run, ['']) -test('read-show-solo', normal, compile_and_run, ['']) # need to add -K64m to the compiler opts, so that GHCi gets it too test('ioref001', diff --git a/libraries/base/tests/read-show-solo.hs b/libraries/base/tests/read-show-solo.hs deleted file mode 100644 index 553e837836..0000000000 --- a/libraries/base/tests/read-show-solo.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main (main) where -import Data.Tuple (Solo (..)) - -main = do - print $ Solo (3 :: Int) - print $ Solo (Just "") - print $ Just (Solo "") - print (read (show (Solo (3 :: Int))) :: Solo Int) - print (read "Just Solo { getSolo = 5 }" :: Maybe (Solo Int)) diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs index 9254ab72ae..9f4b70e6c1 100644 --- a/libraries/ghc-prim/GHC/Tuple.hs +++ b/libraries/ghc-prim/GHC/Tuple.hs @@ -77,7 +77,15 @@ data () = () -- unary tuples, they can also be useful for fine-grained control of -- strict-spined data structure traversals, and for unifying the -- implementations of lazy and strict mapping functions. -data Solo a = Solo { getSolo :: a } +data Solo a = Solo a + +getSolo :: Solo a -> a +-- getSolo is a standalone function, rather than a record field of Solo, +-- because Solo is a wired-in TyCon, and a wired-in TyCon that has +-- record fields is a bit more inconvenient than if it doesn't. +-- (No other wired-in TyCon has record fields.) So it seems easier +-- to have getSolo as its own separate function (#20562) +getSolo (Solo a) = a data (a,b) = (a,b) data (a,b,c) = (a,b,c) |