Commit 52e43004 authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent d3e2912a
......@@ -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")
......
......@@ -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]))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment