Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
473f12a3
Commit
473f12a3
authored
Feb 13, 2014
by
eir@cis.upenn.edu
Browse files
Fix #5682. Now, '(:) parses.
parent
3d9644c2
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/parser/Parser.y.pp
View file @
473f12a3
...
...
@@ -1155,6 +1155,8 @@ atype :: { LHsType RdrName }
|
SIMPLEQUOTE
'('
')'
{ LL $ HsTyVar $ getRdrName unitDataCon }
|
SIMPLEQUOTE
'('
ctype
','
comma_types1
')'
{ LL $ HsExplicitTupleTy [] ($3 : $5) }
|
SIMPLEQUOTE
'['
comma_types0
']'
{ LL $ HsExplicitListTy placeHolderKind $3 }
|
SIMPLEQUOTE
'('
qconop
')'
{ LL $ HsTyVar (unLoc $3) }
|
SIMPLEQUOTE
'('
varop
')'
{ LL $ HsTyVar (unLoc $3) }
|
'['
ctype
','
comma_types1
']'
{ LL $ HsExplicitListTy placeHolderKind ($2 : $4) }
|
INTEGER
{% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 }
|
STRING
{% mkTyLit $ LL $ HsStrTy $ getSTRING $1 }
...
...
testsuite/tests/parser/should_compile/T5682.hs
0 → 100644
View file @
473f12a3
{-# LANGUAGE DataKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-}
module
T5682
where
import
Data.Typeable
data
a
:+:
b
=
Mk
a
b
data
Foo
=
Bool
:+:
Bool
type
X
=
True
'
:+:
False
deriving
instance
Typeable
'
(
:+:
)
\ No newline at end of file
testsuite/tests/parser/should_compile/all.T
View file @
473f12a3
...
...
@@ -96,3 +96,4 @@ test('T5243', extra_clean(['T5243A.hi', 'T5243A.o']),
multimod_compile
,
['
T5243
',''])
test
('
T7118
',
normal
,
compile
,
[''])
test
('
T7776
',
normal
,
compile
,
[''])
test
('
T5682
',
normal
,
compile
,
[''])
\ No newline at end of file
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment