diff options
| author | Tobias Dammers <tdammers@gmail.com> | 2017-10-25 19:09:03 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-10-25 19:18:42 -0400 |
| commit | dbd81f7e86514498218572b9d978373b1699cc5b (patch) | |
| tree | 5c4527f5405e67d0de0006fc07dd132162c3b96d /compiler/typecheck/TcGenDeriv.hs | |
| parent | 4c06ccb71737b77a8165e888ad75417a425549dd (diff) | |
| download | haskell-dbd81f7e86514498218572b9d978373b1699cc5b.tar.gz | |
Factor out readField (#14364)
Improves compiler performance of deriving Read instances, as suggested
in the issue.
Additionally, we introduce `readSymField`, a companion to `readField`
that parses symbol-type fields (where the field name is a symbol, e.g.
`(#)`, rather than an alphanumeric identifier. The decision between
these two functions is made a compile time, because we already know
which one we need based on the field name.
Reviewers: austin, hvr, bgamari, RyanGlScott
Reviewed By: bgamari
Subscribers: RyanGlScott, rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D4108
Diffstat (limited to 'compiler/typecheck/TcGenDeriv.hs')
| -rw-r--r-- | compiler/typecheck/TcGenDeriv.hs | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index 9e27ad5ca1..70ceb30305 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -900,9 +900,7 @@ instance Read T where -- Record construction binds even more tightly than application do expectP (Ident "T1") expectP (Punc '{') - expectP (Ident "f1") - expectP (Punc '=') - x <- ReadP.reset Read.readPrec + x <- Read.readField "f1" (ReadP.reset readPrec) expectP (Punc '}') return (T1 { f1 = x })) +++ @@ -1068,21 +1066,28 @@ gen_Read_binds get_fixity loc tycon read_arg a ty = ASSERT( not (isUnliftedType ty) ) noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR])) - read_field lbl a = read_lbl lbl ++ - [read_punc "=", - noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps reset_RDR [readPrec_RDR]))] - - -- When reading field labels we might encounter - -- a = 3 - -- _a = 3 - -- or (#) = 4 - -- Note the parens! - read_lbl lbl | isSym lbl_str - = [read_punc "(", symbol_pat lbl_str, read_punc ")"] - | otherwise - = ident_h_pat lbl_str - where - lbl_str = unpackFS lbl + -- When reading field labels we might encounter + -- a = 3 + -- _a = 3 + -- or (#) = 4 + -- Note the parens! + read_field lbl a = + [noLoc + (mkBindStmt + (nlVarPat a) + (nlHsApps + read_field + [ nlHsLit (mkHsString lbl_str) + , nlHsVarApps reset_RDR [readPrec_RDR] + ] + ) + ) + ] + where + lbl_str = unpackFS lbl + read_field + | isSym lbl_str = readSymField_RDR + | otherwise = readField_RDR {- ************************************************************************ |