summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/prelude/PrelNames.hs3
-rw-r--r--compiler/typecheck/TcGenDeriv.hs16
-rw-r--r--docs/users_guide/8.4.2-notes.rst88
-rw-r--r--docs/users_guide/index.rst4
-rw-r--r--libraries/base/GHC/Read.hs17
-rw-r--r--libraries/base/changelog.md4
-rw-r--r--testsuite/tests/deriving/should_run/T14918.hs18
-rw-r--r--testsuite/tests/deriving/should_run/T14918.stdout2
-rw-r--r--testsuite/tests/deriving/should_run/all.T1
9 files changed, 144 insertions, 9 deletions
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index df13eaa04b..280f1efd80 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -745,8 +745,9 @@ choose_RDR = varQual_RDR gHC_READ (fsLit "choose")
lexP_RDR = varQual_RDR gHC_READ (fsLit "lexP")
expectP_RDR = varQual_RDR gHC_READ (fsLit "expectP")
-readField_RDR, readSymField_RDR :: RdrName
+readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName
readField_RDR = varQual_RDR gHC_READ (fsLit "readField")
+readFieldHash_RDR = varQual_RDR gHC_READ (fsLit "readFieldHash")
readSymField_RDR = varQual_RDR gHC_READ (fsLit "readSymField")
punc_RDR, ident_RDR, symbol_RDR :: RdrName
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 0a5c5aab65..788e6d9757 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1080,19 +1080,23 @@ gen_Read_binds get_fixity loc tycon
[noLoc
(mkBindStmt
(nlVarPat a)
- (nlHsApps
+ (nlHsApp
read_field
- [ nlHsLit (mkHsString lbl_str)
- , nlHsVarApps reset_RDR [readPrec_RDR]
- ]
+ (nlHsVarApps reset_RDR [readPrec_RDR])
)
)
]
where
lbl_str = unpackFS lbl
+ mk_read_field read_field_rdr lbl
+ = nlHsApps read_field_rdr [nlHsLit (mkHsString lbl)]
read_field
- | isSym lbl_str = readSymField_RDR
- | otherwise = readField_RDR
+ | isSym lbl_str
+ = mk_read_field readSymField_RDR lbl_str
+ | Just (ss, '#') <- snocView lbl_str -- #14918
+ = mk_read_field readFieldHash_RDR ss
+ | otherwise
+ = mk_read_field readField_RDR lbl_str
{-
************************************************************************
diff --git a/docs/users_guide/8.4.2-notes.rst b/docs/users_guide/8.4.2-notes.rst
new file mode 100644
index 0000000000..7002caae0d
--- /dev/null
+++ b/docs/users_guide/8.4.2-notes.rst
@@ -0,0 +1,88 @@
+.. _release-8-4-2:
+
+Release notes for version 8.4.2
+===============================
+
+TODO
+
+Highlights
+----------
+
+The highlights, since the 8.4.1 release, are:
+
+- TODO
+
+
+Full details
+------------
+
+
+Language
+~~~~~~~~
+
+- Fix a regression in which derived `Read` instances for record data types
+ with field names ending with `#` (by way of :ghc-flag:`-XMagicHash`) would
+ no longer parse valid output.
+
+Compiler
+~~~~~~~~
+
+
+Runtime system
+~~~~~~~~~~~~~~
+
+
+Template Haskell
+~~~~~~~~~~~~~~~~
+
+
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- Add the `readFieldHash` function to `GHC.Read` which behaves like
+ `readField`, but for a field that ends with a `#` symbol.
+
+Build system
+~~~~~~~~~~~~
+
+
+Included libraries
+------------------
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Deppendency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
diff --git a/docs/users_guide/index.rst b/docs/users_guide/index.rst
index b57e37b018..7f42dca802 100644
--- a/docs/users_guide/index.rst
+++ b/docs/users_guide/index.rst
@@ -12,8 +12,8 @@ Contents:
license
intro
- 8.2.1-notes
- 8.4.1-notes
+ 8.4.2-notes
+ 8.6.1-notes
ghci
runghc
usage
diff --git a/libraries/base/GHC/Read.hs b/libraries/base/GHC/Read.hs
index ad51c46ec5..f7870a2df1 100644
--- a/libraries/base/GHC/Read.hs
+++ b/libraries/base/GHC/Read.hs
@@ -37,6 +37,7 @@ module GHC.Read
, readListDefault, readListPrecDefault
, readNumber
, readField
+ , readFieldHash
, readSymField
-- Temporary
@@ -376,6 +377,22 @@ readField fieldName readVal = do
-- See Note [Why readField]
+-- | 'Read' parser for a record field, of the form @fieldName#=value@. That is,
+-- an alphanumeric identifier @fieldName@ followed by the symbol @#@. The
+-- second argument is a parser for the field value.
+--
+-- Note that 'readField' does not suffice for this purpose due to
+-- <https://ghc.haskell.org/trac/ghc/ticket/5041 Trac #5041>.
+readFieldHash :: String -> ReadPrec a -> ReadPrec a
+readFieldHash fieldName readVal = do
+ expectP (L.Ident fieldName)
+ expectP (L.Symbol "#")
+ expectP (L.Punc "=")
+ readVal
+{-# NOINLINE readFieldHash #-}
+
+-- See Note [Why readField]
+
-- | 'Read' parser for a symbol record field, of the form @(###)=value@ (where
-- @###@ is the field name). The field name must be a symbol (operator-style),
-- e.g. @(#)@. For regular (alphanumeric) field names, use 'readField'. The
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 47fe01148d..16e183e6b2 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -9,6 +9,10 @@
* Add `Applicative` (for `K1`), `Semigroup` and `Monoid` instances in
`GHC.Generics`. (#14849)
+## 4.11.1.0 *TBA*
+ * Add the `readFieldHash` function to `GHC.Read` which behaves like
+ `readField`, but for a field that ends with a `#` symbol (#14918).
+
## 4.11.0.0 *TBA*
* Bundled with GHC 8.4.1
diff --git a/testsuite/tests/deriving/should_run/T14918.hs b/testsuite/tests/deriving/should_run/T14918.hs
new file mode 100644
index 0000000000..2ad293724b
--- /dev/null
+++ b/testsuite/tests/deriving/should_run/T14918.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE MagicHash #-}
+module Main where
+
+data T a = MkT { runT :: a, (##) :: a } deriving (Read, Show)
+data T# a = MkT# { runT# :: a, (###) :: a } deriving (Read, Show)
+
+t1, t2 :: T Int
+t1 = MkT (-1) 1
+t2 = read $ show t1
+
+t1#, t2# :: T# Int
+t1# = MkT# (-1) 1
+t2# = read $ show t1#
+
+main :: IO ()
+main = do
+ print t2
+ print t2#
diff --git a/testsuite/tests/deriving/should_run/T14918.stdout b/testsuite/tests/deriving/should_run/T14918.stdout
new file mode 100644
index 0000000000..b85e2a219e
--- /dev/null
+++ b/testsuite/tests/deriving/should_run/T14918.stdout
@@ -0,0 +1,2 @@
+MkT {runT = -1, (##) = 1}
+MkT# {runT# = -1, (###) = 1}
diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T
index c5605f627e..cf0cb922ed 100644
--- a/testsuite/tests/deriving/should_run/all.T
+++ b/testsuite/tests/deriving/should_run/all.T
@@ -45,3 +45,4 @@ test('T10598_bug', normal, compile_and_run, [''])
test('T10598_run', normal, compile_and_run, [''])
test('T11535', when(opsys('mingw32'), expect_broken_for(12210, ['ghci'])),
compile_and_run, [''])
+test('T14918', normal, compile_and_run, [''])