diff options
| -rw-r--r-- | libraries/base/Data/Tuple.hs | 4 | ||||
| -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/base/tests/read-show-solo.stdout | 5 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Tuple.hs | 50 |
7 files changed, 89 insertions, 4 deletions
diff --git a/libraries/base/Data/Tuple.hs b/libraries/base/Data/Tuple.hs index 569dd14da0..5b64f17601 100644 --- a/libraries/base/Data/Tuple.hs +++ b/libraries/base/Data/Tuple.hs @@ -16,7 +16,8 @@ ----------------------------------------------------------------------------- module Data.Tuple - ( fst + ( Solo (..) + , fst , snd , curry , uncurry @@ -24,6 +25,7 @@ module Data.Tuple ) where import GHC.Base () -- Note [Depend on GHC.Tuple] +import GHC.Tuple (Solo (..)) default () -- Double isn't available yet diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs index 7f698ec498..43e5ee5b32 100644 --- a/libraries/base/GHC/Read.hs +++ b/libraries/base/GHC/Read.hs @@ -669,7 +669,25 @@ instance Read () where readList = readListDefault -- | @since 4.15 -deriving instance Read a => Read (Solo a) +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 -- | @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 04fbcb6112..ecfb7dbe0f 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -169,7 +169,9 @@ appPrec1 = I# 11# -- appPrec + 1 deriving instance Show () -- | @since 4.15 -deriving instance Show a => Show (Solo a) +instance Show a => Show (Solo a) where + showsPrec d (Solo x) = showParen (d > 10) $ + showString "Solo " . showsPrec 11 x -- | @since 2.01 instance Show a => Show [a] where diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T index ebbf81ec52..371ed56327 100644 --- a/libraries/base/tests/all.T +++ b/libraries/base/tests/all.T @@ -45,6 +45,7 @@ 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 new file mode 100644 index 0000000000..553e837836 --- /dev/null +++ b/libraries/base/tests/read-show-solo.hs @@ -0,0 +1,9 @@ +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/base/tests/read-show-solo.stdout b/libraries/base/tests/read-show-solo.stdout new file mode 100644 index 0000000000..9478a3df92 --- /dev/null +++ b/libraries/base/tests/read-show-solo.stdout @@ -0,0 +1,5 @@ +Solo 3 +Solo (Just "") +Just (Solo "") +Solo 3 +Just (Solo 5) diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs index b45ae023bf..9254ab72ae 100644 --- a/libraries/ghc-prim/GHC/Tuple.hs +++ b/libraries/ghc-prim/GHC/Tuple.hs @@ -29,7 +29,55 @@ data () = () -- The desugarer uses 1-tuples, -- but "()" is already used up for 0-tuples -- See Note [One-tuples] in GHC.Builtin.Types -data Solo a = Solo a + +-- | @Solo@ is the canonical lifted 1-tuple, just like '(,)' is the canonical +-- lifted 2-tuple (pair) and '(,,)' is the canonical lifted 3-tuple (triple). +-- +-- The most important feature of @Solo@ is that it is possible to force its +-- "outside" (usually by pattern matching) without forcing its "inside", +-- because it is defined as a datatype rather than a newtype. One situation +-- where this can be useful is when writing a function to extract a value from +-- a data structure. Suppose you write an implementation of arrays and offer +-- only this function to index into them: +-- +-- @ +-- index :: Array a -> Int -> a +-- @ +-- +-- Now imagine that someone wants to extract a value from an array and store it +-- in a lazy-valued finite map/dictionary: +-- +-- @ +-- insert "hello" (arr `index` 12) m +-- @ +-- +-- This can actually lead to a space leak. The value is not actually extracted +-- from the array until that value (now buried in a map) is forced. That means +-- the entire array may be kept live by just that value! Often, the solution +-- is to use a strict map, or to force the value before storing it, but for +-- some purposes that's undesirable. +-- +-- One common solution is to include an indexing function that can produce its +-- result in an arbitrary @Applicative@ context: +-- +-- @ +-- indexA :: Applicative f => Array a -> Int -> f a +-- @ +-- +-- When using @indexA@ in a /pure/ context, @Solo@ serves as a handy +-- @Applicative@ functor to hold the result. You could write a non-leaky +-- version of the above example thus: +-- +-- @ +-- case arr `indexA` 12 of +-- Solo a -> insert "hello" a m +-- @ +-- +-- While such simple extraction functions are the most common uses for +-- 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 (a,b) = (a,b) data (a,b,c) = (a,b,c) |