diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-19 18:27:09 +0300 |
|---|---|---|
| committer | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-03-21 10:47:03 +0300 |
| commit | e761dbb2df53e6dd2d325bd278b935bdeaa2ef65 (patch) | |
| tree | d9c12f29e85cb725cca54baf672f45f73c7acdf8 /compiler/parser | |
| parent | d70eda19335f5e2eb58fe3b9467ccffb606d5568 (diff) | |
| download | haskell-e761dbb2df53e6dd2d325bd278b935bdeaa2ef65.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.y | 10 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 5 |
2 files changed, 10 insertions, 5 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 27e96ade5a..6c863d5bd6 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1990,14 +1990,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 } @@ -3309,13 +3310,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 ".") } ----------------------------------------------------------------------------- @@ -3370,7 +3371,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 0529e35d27..af59a18968 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) @@ -1165,6 +1166,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) |