summaryrefslogtreecommitdiff
path: root/compiler/parser
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2019-02-19 18:27:09 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-02-21 04:26:15 -0500
commit2f4af71e73ac3b59f4faba5bf1b25774b1008898 (patch)
tree2f3db562b6ff0609be9207276921bafc2a6c620f /compiler/parser
parent32f44ed81b0f16099d780e73ad2ea1a3cd812448 (diff)
downloadhaskell-2f4af71e73ac3b59f4faba5bf1b25774b1008898.tar.gz
Dot/bang operators in export lists (Trac #16339)
The dot type operator was handled in the 'tyvarop' parser production, and the bang type operator in 'tyapp'. However, export lists and role annotations use 'oqtycon', so these type operators could not be exported or assigned roles. The fix is to handle them in a lower level production, 'tyconsym'.
Diffstat (limited to 'compiler/parser')
-rw-r--r--compiler/parser/Parser.y10
-rw-r--r--compiler/parser/RdrHsSyn.hs5
2 files changed, 10 insertions, 5 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 78f1013151..544d9d76e4 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1989,14 +1989,15 @@ tyapps :: { [Located TyEl] } -- NB: This list is reversed
tyapp :: { Located TyEl }
: atype { sL1 $1 $ TyElOpd (unLoc $1) }
| TYPEAPP atype { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) }
- | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) }
+ | qtyconop { sL1 $1 $ if isBangRdr (unLoc $1)
+ then TyElBang
+ else TyElOpr (unLoc $1) }
| tyvarop { sL1 $1 $ TyElOpr (unLoc $1) }
| SIMPLEQUOTE qconop {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
[mj AnnSimpleQuote $1,mj AnnVal $2] }
| SIMPLEQUOTE varop {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
[mj AnnSimpleQuote $1,mj AnnVal $2] }
| '~' { sL1 $1 TyElTilde }
- | '!' { sL1 $1 TyElBang }
| unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) }
atype :: { LHsType GhcPs }
@@ -3310,13 +3311,13 @@ qtyconsym :: { Located RdrName }
| QVARSYM { sL1 $1 $! mkQual tcClsName (getQVARSYM $1) }
| tyconsym { $1 }
--- Does not include "!", because that is used for strictness marks
--- or ".", because that separates the quantified type vars from the rest
tyconsym :: { Located RdrName }
: CONSYM { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
| VARSYM { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
| ':' { sL1 $1 $! consDataCon_RDR }
| '-' { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
+ | '!' { sL1 $1 $! mkUnqual tcClsName (fsLit "!") }
+ | '.' { sL1 $1 $! mkUnqual tcClsName (fsLit ".") }
-----------------------------------------------------------------------------
@@ -3371,7 +3372,6 @@ tyvarop :: { Located RdrName }
tyvarop : '`' tyvarid '`' {% ams (sLL $1 $> (unLoc $2))
[mj AnnBackquote $1,mj AnnVal $2
,mj AnnBackquote $3] }
- | '.' { sL1 $1 $ mkUnqual tcClsName (fsLit ".") }
tyvarid :: { Located RdrName }
: VARID { sL1 $1 $! mkUnqual tvName (getVARID $1) }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 606e2e7d6b..c65b814529 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -49,6 +49,7 @@ module RdrHsSyn (
checkContext, -- HsType -> P HsContext
checkPattern, -- HsExp -> P HsPat
bang_RDR,
+ isBangRdr,
checkPatterns, -- SrcLoc -> [HsExp] -> P [HsPat]
checkMonadComp, -- P (HsStmtContext RdrName)
checkCommand, -- LHsExpr RdrName -> P (LHsCmd RdrName)
@@ -1162,6 +1163,10 @@ plus_RDR = mkUnqual varName (fsLit "+") -- Hack
bang_RDR = mkUnqual varName (fsLit "!") -- Hack
pun_RDR = mkUnqual varName (fsLit "pun-right-hand-side")
+isBangRdr :: RdrName -> Bool
+isBangRdr (Unqual occ) = occNameFS occ == fsLit "!"
+isBangRdr _ = False
+
checkPatField :: SDoc -> LHsRecField GhcPs (LHsExpr GhcPs)
-> P (LHsRecField GhcPs (LPat GhcPs))
checkPatField msg (dL->L l fld) = do p <- checkLPat msg (hsRecFieldArg fld)