Handle the (~) type operator in 'tyconsym'
authorVladislav Zavialov <vlad.z.4096@gmail.com>
Tue, 19 Feb 2019 16:44:13 +0000 (19:44 +0300)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Thu, 21 Feb 2019 09:26:15 +0000 (04:26 -0500)
By parsing '~' in 'tyconsym' instead of 'oqtycon', we
get one less shift/reduce conflict.

compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs

index 544d9d7..05bf674 100644 (file)
@@ -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 }
 
 
 -----------------------------------------------------------------------------
index c65b814..12a9c05 100644 (file)
@@ -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))