diff options
-rw-r--r-- | compiler/prelude/PrelNames.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 16 | ||||
-rw-r--r-- | docs/users_guide/8.4.2-notes.rst | 88 | ||||
-rw-r--r-- | docs/users_guide/index.rst | 4 | ||||
-rw-r--r-- | libraries/base/GHC/Read.hs | 17 | ||||
-rw-r--r-- | libraries/base/changelog.md | 4 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/T14918.hs | 18 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/T14918.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_run/all.T | 1 |
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, ['']) |