[commit: ghc] master: Fix Trac #12051 (72b677d)
git at git.haskell.org
git at git.haskell.org
Thu May 19 11:23:36 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/72b677d31e39f417e4403b1b151f02913f483d32/ghc
>---------------------------------------------------------------
commit 72b677d31e39f417e4403b1b151f02913f483d32
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon May 16 13:41:06 2016 +0100
Fix Trac #12051
A minor parser issue, allowing a mal-formed data constructor
through.
>---------------------------------------------------------------
72b677d31e39f417e4403b1b151f02913f483d32
compiler/parser/Parser.y | 15 +----
compiler/parser/RdrHsSyn.hs | 73 ++++++++++++++++--------
testsuite/tests/parser/should_fail/T12051.hs | 3 +
testsuite/tests/parser/should_fail/T12051.stderr | 2 +
testsuite/tests/parser/should_fail/all.T | 1 +
5 files changed, 57 insertions(+), 37 deletions(-)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 4c272a1..4502dca 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1642,7 +1642,7 @@ btype :: { LHsType RdrName }
-- Used for parsing Haskell98-style data constructors,
-- in order to forbid the blasphemous
-- > data Foo = Int :+ Char :* Bool
--- See also Note [Parsing data constructors is hard].
+-- See also Note [Parsing data constructors is hard] in RdrHsSyn
btype_no_ops :: { LHsType RdrName }
: btype_no_ops atype { sLL $1 $> $ HsAppTy $1 $2 }
| atype { $1 }
@@ -1898,23 +1898,12 @@ forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr RdrName]) }
| {- empty -} { noLoc ([], Nothing) }
constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
- -- see Note [Parsing data constructors is hard]
+ -- See Note [Parsing data constructors is hard] in RdrHsSyn
: btype_no_ops {% do { c <- splitCon $1
; return $ sLL $1 $> c } }
| btype_no_ops conop btype_no_ops {% do { ty <- splitTilde $1
; return $ sLL $1 $> ($2, InfixCon ty $3) } }
-{- Note [Parsing data constructors is hard]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We parse the constructor declaration
- C t1 t2
-as a btype_no_ops (treating C as a type constructor) and then convert C to be
-a data constructor. Reason: it might continue like this:
- C t1 t2 :% D Int
-in which case C really would be a type constructor. We can't resolve this
-ambiguity till we come across the constructor oprerator :% (or not, more usually)
--}
-
fielddecls :: { [LConDeclField RdrName] }
: {- empty -} { [] }
| fielddecls1 { $1 }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index d650b01..43ff230 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -74,6 +74,7 @@ import Name
import BasicTypes
import TcEvidence ( idHsWrapper )
import Lexer
+import Lexeme ( isLexCon )
import Type ( TyThing(..) )
import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon,
nilDataConName, nilDataConKey,
@@ -425,16 +426,34 @@ has_args ((L _ (Match _ args _ _)) : _) = not (null args)
********************************************************************* -}
------------------------------------------------------------------------------
--- splitCon
-
--- When parsing data declarations, we sometimes inadvertently parse
--- a constructor application as a type (eg. in data T a b = C a b `D` E a b)
--- This function splits up the type application, adds any pending
--- arguments, and converts the type constructor back into a data constructor.
+{- Note [Parsing data constructors is hard]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We parse the RHS of the constructor declaration
+ data T = C t1 t2
+as a btype_no_ops (treating C as a type constructor) and then convert C to be
+a data constructor. Reason: it might continue like this:
+ data T = C t1 t2 :% D Int
+in which case C really /would/ be a type constructor. We can't resolve this
+ambiguity till we come across the constructor oprerator :% (or not, more usually)
+
+So the plan is:
+
+* Parse the data constructor declration as a type (actually btype_no_ops)
+
+* Use 'splitCon' to rejig it into the data constructor and the args
+
+* In doing so, we use 'tyConToDataCon' to convert the RdrName for
+ the data con, which has been parsed as a tycon, back to a datacon.
+ This is more than just adjusting the name space; for operators we
+ need to check that it begins with a colon. E.g.
+ data T = (+++)
+ will parse ok (since tycons can be operators), but we should reject
+ it (Trac #12051).
+-}
splitCon :: LHsType RdrName
-> P (Located RdrName, HsConDeclDetails RdrName)
+-- See Note [Parsing data constructors is hard]
-- This gets given a "type" that should look like
-- C Int Bool
-- or C { x::Int, y::Bool }
@@ -453,11 +472,23 @@ splitCon ty
mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
mk_rest ts = PrefixCon ts
-recordPatSynErr :: SrcSpan -> LPat RdrName -> P a
-recordPatSynErr loc pat =
- parseErrorSDoc loc $
- text "record syntax not supported for pattern synonym declarations:" $$
- ppr pat
+tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
+-- See Note [Parsing data constructors is hard]
+-- Data constructor RHSs are parsed as types
+tyConToDataCon loc tc
+ | isTcOcc occ
+ , isLexCon (occNameFS occ)
+ = return (L loc (setRdrNameSpace tc srcDataName))
+
+ | otherwise
+ = parseErrorSDoc loc (msg $$ extra)
+ where
+ occ = rdrNameOcc tc
+
+ msg = text "Not a data constructor:" <+> quotes (ppr tc)
+ extra | tc == forall_tv_RDR
+ = text "Perhaps you intended to use ExistentialQuantification"
+ | otherwise = empty
mkPatSynMatchGroup :: Located RdrName
-> Located (OrdList (LHsDecl RdrName))
@@ -493,6 +524,12 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
text "pattern synonym 'where' clause cannot be empty" $$
text "In the pattern synonym declaration for: " <+> ppr (patsyn_name)
+recordPatSynErr :: SrcSpan -> LPat RdrName -> P a
+recordPatSynErr loc pat =
+ parseErrorSDoc loc $
+ text "record syntax not supported for pattern synonym declarations:" $$
+ ppr pat
+
mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr RdrName]
-> LHsContext RdrName -> HsConDeclDetails RdrName
-> ConDecl RdrName
@@ -513,18 +550,6 @@ mkGadtDecl names ty = ConDeclGADT { con_names = names
, con_type = ty
, con_doc = Nothing }
-tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
-tyConToDataCon loc tc
- | isTcOcc (rdrNameOcc tc)
- = return (L loc (setRdrNameSpace tc srcDataName))
- | otherwise
- = parseErrorSDoc loc (msg $$ extra)
- where
- msg = text "Not a data constructor:" <+> quotes (ppr tc)
- extra | tc == forall_tv_RDR
- = text "Perhaps you intended to use ExistentialQuantification"
- | otherwise = empty
-
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
-- ^ This rather gruesome function is used mainly by the parser.
-- When parsing:
diff --git a/testsuite/tests/parser/should_fail/T12051.hs b/testsuite/tests/parser/should_fail/T12051.hs
new file mode 100644
index 0000000..3744f77
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T12051.hs
@@ -0,0 +1,3 @@
+module T12051 where
+
+data T = (+++) Int
diff --git a/testsuite/tests/parser/should_fail/T12051.stderr b/testsuite/tests/parser/should_fail/T12051.stderr
new file mode 100644
index 0000000..ae65eae
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T12051.stderr
@@ -0,0 +1,2 @@
+
+T12051.hs:3:10: error: Not a data constructor: ‘+++’
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index e6c6f41..ca23d3b 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -93,3 +93,4 @@ test('T10196Fail1', normal, compile_fail, [''])
test('T10196Fail2', normal, compile_fail, [''])
test('T10498a', normal, compile_fail, [''])
test('T10498b', normal, compile_fail, [''])
+test('T12051', normal, compile_fail, [''])
More information about the ghc-commits
mailing list