From bf0d3df4d011bc93af28b195a97abfcd24b9e7d6 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 19 Apr 2011 13:31:53 +0100 Subject: [PATCH] Fix Trac #5041: parse the trailing '#' This matters for constructors and field labels that have a trailing hash (MagicHash language extension). --- compiler/typecheck/TcGenDeriv.lhs | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 2c04cf4..efacac2 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -893,15 +893,15 @@ gen_Read_binds get_fixity loc tycon read_nullary_cons = case nullary_cons of [] -> [] - [con] -> [nlHsDo DoExpr [bindLex (match_con con)] (result_expr con [])] + [con] -> [nlHsDo DoExpr (match_con con) (result_expr con [])] _ -> [nlHsApp (nlHsVar choose_RDR) (nlList (map mk_pair nullary_cons))] -- NB For operators the parens around (:=:) are matched by the -- enclosing "parens" call, so here we must match the naked -- data_con_str con - match_con con | isSym con_str = symbol_pat con_str - | otherwise = ident_pat con_str + match_con con | isSym con_str = [symbol_pat con_str] + | otherwise = ident_h_pat con_str where con_str = data_con_str con -- For nullary constructors we must match Ident s for normal constrs @@ -925,12 +925,12 @@ gen_Read_binds get_fixity loc tycon prefix_parser = mk_parser prefix_prec prefix_stmts body read_prefix_con - | isSym con_str = [read_punc "(", bindLex (symbol_pat con_str), read_punc ")"] - | otherwise = [bindLex (ident_pat con_str)] + | isSym con_str = [read_punc "(", symbol_pat con_str, read_punc ")"] + | otherwise = ident_h_pat con_str read_infix_con - | isSym con_str = [bindLex (symbol_pat con_str)] - | otherwise = [read_punc "`", bindLex (ident_pat con_str), read_punc "`"] + | isSym con_str = [symbol_pat con_str] + | otherwise = [read_punc "`"] ++ ident_h_pat con_str ++ [read_punc "`"] prefix_stmts -- T a b c = read_prefix_con ++ read_args @@ -972,8 +972,15 @@ gen_Read_binds get_fixity loc tycon 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' - ident_pat s = nlConPat ident_RDR [nlLitPat (mkHsString s)] -- Ident "foo" - symbol_pat s = nlConPat symbol_RDR [nlLitPat (mkHsString s)] -- Symbol ">>" + + -- 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 data_con_str con = occNameString (getOccName con) @@ -991,11 +998,9 @@ gen_Read_binds get_fixity loc tycon -- or (#) = 4 -- Note the parens! read_lbl lbl | isSym lbl_str - = [read_punc "(", - bindLex (symbol_pat lbl_str), - read_punc ")"] + = [read_punc "(", symbol_pat lbl_str, read_punc ")"] | otherwise - = [bindLex (ident_pat lbl_str)] + = ident_h_pat lbl_str where lbl_str = occNameString (getOccName lbl) \end{code} -- 1.7.10.4