diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-19 19:44:13 +0300 |
|---|---|---|
| committer | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-02-19 19:53:13 +0300 |
| commit | 6b4d731bdcb02189461b5fc22011386bed9e44a2 (patch) | |
| tree | cd8c62b7c0b81039bbb087d6dfd7baf175611e26 | |
| parent | f7c2525b9c8735ffdad0beb7dcdeff897ca63e7a (diff) | |
| download | haskell-wip/export-bang-dot.tar.gz | |
Handle the (~) type operator in 'tyconsym'wip/export-bang-dot
By parsing '~' in 'tyconsym' instead of 'oqtycon', we
get one less shift/reduce conflict.
| -rw-r--r-- | compiler/parser/Parser.y | 12 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 4 |
2 files changed, 8 insertions, 8 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 544d9d76e4..05bf67498b 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -88,7 +88,7 @@ import Util ( looksLikePackageName, fstOf3, sndOf3, thdOf3 ) import GhcPrelude } -%expect 237 -- shift/reduce conflicts +%expect 236 -- shift/reduce conflicts {- Last updated: 04 June 2018 @@ -1989,15 +1989,14 @@ 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 $ if isBangRdr (unLoc $1) - then TyElBang - else TyElOpr (unLoc $1) } + | qtyconop { sL1 $1 $ if isBangRdr (unLoc $1) then TyElBang else + if isTildeRdr (unLoc $1) then TyElTilde 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 } | unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) } atype :: { LHsType GhcPs } @@ -3251,8 +3250,6 @@ oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon; : qtycon { $1 } | '(' qtyconsym ')' {% ams (sLL $1 $> (unLoc $2)) [mop $1,mj AnnVal $2,mcp $3] } - | '(' '~' ')' {% ams (sLL $1 $> $ eqTyCon_RDR) - [mop $1,mj AnnVal $2,mcp $3] } oqtycon_no_varcon :: { Located RdrName } -- Type constructor which cannot be mistaken -- for variable constructor in export lists @@ -3318,6 +3315,7 @@ tyconsym :: { Located RdrName } | '-' { sL1 $1 $! mkUnqual tcClsName (fsLit "-") } | '!' { sL1 $1 $! mkUnqual tcClsName (fsLit "!") } | '.' { sL1 $1 $! mkUnqual tcClsName (fsLit ".") } + | '~' { sL1 $1 $ eqTyCon_RDR } ----------------------------------------------------------------------------- diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index c65b814529..12a9c05514 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -50,6 +50,7 @@ module RdrHsSyn ( checkPattern, -- HsExp -> P HsPat bang_RDR, isBangRdr, + isTildeRdr, checkPatterns, -- SrcLoc -> [HsExp] -> P [HsPat] checkMonadComp, -- P (HsStmtContext RdrName) checkCommand, -- LHsExpr RdrName -> P (LHsCmd RdrName) @@ -1163,9 +1164,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, isTildeRdr :: RdrName -> Bool isBangRdr (Unqual occ) = occNameFS occ == fsLit "!" isBangRdr _ = False +isTildeRdr = (==eqTyCon_RDR) checkPatField :: SDoc -> LHsRecField GhcPs (LHsExpr GhcPs) -> P (LHsRecField GhcPs (LPat GhcPs)) |