[commit: ghc] master: Use expectP in deriving( Read ) (52e4300)
Simon Peyton Jones <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master http://hackage.haskell.org/trac/ghc/changeset/52e43004f63276c1342933e40a673ad25cf2113a >--------------------------------------------------------------- commit 52e43004f63276c1342933e40a673ad25cf2113a Author: Simon Peyton Jones <[email protected]> Date: Fri Dec 21 17:39:33 2012 +0000 Use expectP in deriving( Read ) Note [Use expectP] in TcGenDeriv ~~~~~~~~~~~~~~~~~~ Note that we use expectP (Ident "T1") rather than Ident "T1" <- lexP The latter desugares to inline code for matching the Ident and the string, and this can be very voluminous. The former is much more compact. Cf Trac #7258, although that also concerned non-linearity in the occurrence analyser, a separate issue. >--------------------------------------------------------------- compiler/prelude/PrelNames.lhs | 3 +- compiler/typecheck/TcGenDeriv.lhs | 43 ++++++++++++++++++++++-------------- 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index c763b70..5d8dc3c 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -585,7 +585,7 @@ unsafeIndex_RDR = varQual_RDR gHC_ARR (fsLit "unsafeIndex") unsafeRangeSize_RDR = varQual_RDR gHC_ARR (fsLit "unsafeRangeSize") readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR, - readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR :: RdrName + readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName readList_RDR = varQual_RDR gHC_READ (fsLit "readList") readListDefault_RDR = varQual_RDR gHC_READ (fsLit "readListDefault") readListPrec_RDR = varQual_RDR gHC_READ (fsLit "readListPrec") @@ -594,6 +594,7 @@ readPrec_RDR = varQual_RDR gHC_READ (fsLit "readPrec") parens_RDR = varQual_RDR gHC_READ (fsLit "parens") choose_RDR = varQual_RDR gHC_READ (fsLit "choose") lexP_RDR = varQual_RDR gHC_READ (fsLit "lexP") +expectP_RDR = varQual_RDR gHC_READ (fsLit "expectP") punc_RDR, ident_RDR, symbol_RDR :: RdrName punc_RDR = dataQual_RDR lEX (fsLit "Punc") diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 2ae812e..a8d79b1 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -851,30 +851,29 @@ Example | T1 { f1 :: Int } | T2 T - instance Read T where readPrec = parens ( prec 4 ( - do x <- ReadP.step Read.readPrec - Symbol "%%" <- Lex.lex - y <- ReadP.step Read.readPrec + do x <- ReadP.step Read.readPrec + expectP (Symbol "%%") + y <- ReadP.step Read.readPrec return (x %% y)) +++ prec (appPrec+1) ( -- Note the "+1" part; "T2 T1 {f1=3}" should parse ok -- Record construction binds even more tightly than application - do Ident "T1" <- Lex.lex - Punc '{' <- Lex.lex - Ident "f1" <- Lex.lex - Punc '=' <- Lex.lex + do expectP (Ident "T1") + expectP (Punc '{') + expectP (Ident "f1") + expectP (Punc '=') x <- ReadP.reset Read.readPrec - Punc '}' <- Lex.lex + expectP (Punc '}') return (T1 { f1 = x })) +++ prec appPrec ( - do Ident "T2" <- Lex.lexP - x <- ReadP.step Read.readPrec + do expectP (Ident "T2") + x <- ReadP.step Read.readPrec return (T2 x)) ) @@ -882,6 +881,17 @@ instance Read T where readList = readListDefault +Note [Use expectP] +~~~~~~~~~~~~~~~~~~ +Note that we use + expectP (Ident "T1") +rather than + Ident "T1" <- lexP +The latter desugares to inline code for matching the Ident and the +string, and this can be very voluminous. The former is much more +compact. Cf Trac #7258, although that also concerned non-linearity in +the occurrence analyser, a separate issue. + \begin{code} gen_Read_binds :: FixityEnv -> SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff) @@ -983,24 +993,23 @@ gen_Read_binds get_fixity loc tycon mk_alt e1 e2 = genOpApp e1 alt_RDR e2 -- e1 +++ e2 mk_parser p ss b = nlHsApps prec_RDR [nlHsIntLit p -- prec p (do { ss ; b }) , nlHsDo DoExpr (ss ++ [noLoc $ mkLastStmt b])] - bindLex pat = noLoc (mkBindStmt pat (nlHsVar lexP_RDR)) -- pat <- lexP con_app con as = nlHsVarApps (getRdrName con) as -- con as result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as) -- return (con as) - punc_pat s = nlConPat punc_RDR [nlLitPat (mkHsString s)] -- Punc 'c' - -- For constructors and field labels ending in '#', we hackily -- let the lexer generate two tokens, and look for both in sequence -- Thus [Ident "I"; Symbol "#"]. See Trac #5041 ident_h_pat s | Just (ss, '#') <- snocView s = [ ident_pat ss, symbol_pat "#" ] | otherwise = [ ident_pat s ] - ident_pat s = bindLex $ nlConPat ident_RDR [nlLitPat (mkHsString s)] -- Ident "foo" <- lexP - symbol_pat s = bindLex $ nlConPat symbol_RDR [nlLitPat (mkHsString s)] -- Symbol ">>" <- lexP + bindLex pat = noLoc (mkBodyStmt (nlHsApp (nlHsVar expectP_RDR) pat)) -- expectP p + -- See Note [Use expectP] + ident_pat s = bindLex $ nlHsApps ident_RDR [nlHsLit (mkHsString s)] -- expectP (Ident "foo") + symbol_pat s = bindLex $ nlHsApps symbol_RDR [nlHsLit (mkHsString s)] -- expectP (Symbol ">>") + read_punc c = bindLex $ nlHsApps punc_RDR [nlHsLit (mkHsString c)] -- expectP (Punc "<") data_con_str con = occNameString (getOccName con) - read_punc c = bindLex (punc_pat c) read_arg a ty = ASSERT( not (isUnLiftedType ty) ) noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR]))