diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-03-23 11:40:02 -0400 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-03-23 11:40:02 -0400 |
| commit | d5577f44eaf3b9dfdfc77828038782bf818c176a (patch) | |
| tree | 447d2163367ece2e2801376e35d06490cfff779c /compiler | |
| parent | 034c32f6b8abd15eb9affca972844d3c6842af69 (diff) | |
| download | haskell-d5577f44eaf3b9dfdfc77828038782bf818c176a.tar.gz | |
Special-case record fields ending with hash when deriving Read
Summary:
In commit dbd81f7e86514498218572b9d978373b1699cc5b, a
regression was inadvertently introduced which caused derived `Read`
instances for record data types with fields ending in a `#` symbol
(using `MagicHash`) would no longer parse on valid output. This
is ultimately due to the same reasons as #5041, as we cannot parse
a field name like `foo#` as a single identifier. We fix this issue
by employing the same workaround as in #5041: first parse the
identifier name `foo`, then then symbol `#`.
This is accomplished by the new `readFieldHash` function in
`GHC.Read`. This will likely warrant a `base-4.11.1.0` release.
Test Plan: make test TEST=T14918
Reviewers: tdammers, hvr, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14918
Differential Revision: https://phabricator.haskell.org/D4502
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/prelude/PrelNames.hs | 3 | ||||
| -rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 16 |
2 files changed, 12 insertions, 7 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 {- ************************************************************************ |