[commit: ghc] wip/std-hdr-llf: Handle the (~) type operator in 'tyconsym' (e204431)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/std-hdr-llf
Link       : http://ghc.haskell.org/trac/ghc/changeset/e204431e5a5e2fd16da52b04bda2798f16c51344/ghc

>---------------------------------------------------------------

commit e204431e5a5e2fd16da52b04bda2798f16c51344
Author: Vladislav Zavialov <vlad.z.4096 at gmail.com>
Date:   Tue Feb 19 19:44:13 2019 +0300

    Handle the (~) type operator in 'tyconsym'
    
    By parsing '~' in 'tyconsym' instead of 'oqtycon', we
    get one less shift/reduce conflict.


>---------------------------------------------------------------

e204431e5a5e2fd16da52b04bda2798f16c51344
 compiler/parser/Parser.y    | 12 +++++-------
 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 544d9d7..05bf674 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 c65b814..12a9c05 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))