[commit: ghc] wip/shnajd-TTG-SrcLocs: [TTG: Handling Source Locations] Foundation and Pat (Part 2) - Fixing a bug (6741b78)

[git at git.haskell.org]

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

On branch  : wip/shnajd-TTG-SrcLocs
Link       : http://ghc.haskell.org/trac/ghc/changeset/6741b78e1abef9f8df381261e541fcdbb30d0d48/ghc

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

commit 6741b78e1abef9f8df381261e541fcdbb30d0d48
Author: Shayan-Najd <sh.najd at gmail.com>
Date:   Fri Nov 9 19:29:49 2018 +0000

    [TTG: Handling Source Locations] Foundation and Pat (Part 2)
    - Fixing a bug


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

6741b78e1abef9f8df381261e541fcdbb30d0d48
 compiler/hsSyn/HsPat.hs                               | 10 +++++-----
 testsuite/tests/parser/should_compile/KindSigs.stderr | 14 ++++++++------
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index ece051f..f7bb3c9 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -534,7 +534,7 @@ pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
       -- is the pattern inside that matters.  Sigh.
 
 pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc
-pprPat (VarPat _ (L _ var))     = pprPatBndr var
+pprPat (VarPat _ (dL->(_  , var))) = pprPatBndr var
 pprPat (WildPat _)              = char '_'
 pprPat (LazyPat _ pat)          = char '~' <> pprParendLPat appPrec pat
 pprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat
@@ -569,7 +569,7 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
                          , ppr binds])
           <+> pprConArgs details
     else pprUserCon (unLoc con) details
-pprPat (XPat x)               = ppr x
+pprPat (XPat (l , e)) = whenPprDebug (braces (ppr l)) $$ ppr e
 
 
 pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))
@@ -714,12 +714,12 @@ isIrrefutableHsPat pat
     go1 (ListPat {})        = False
 
     go1 (ConPatIn {})       = False     -- Conservative
-    go1 (ConPatOut{ pat_con = L _ (RealDataCon con), pat_args = details })
+    go1 (ConPatOut{ pat_con = dL->(_ , RealDataCon con), pat_args = details })
         =  isJust (tyConSingleDataCon_maybe (dataConTyCon con))
            -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
            -- the latter is false of existentials. See Trac #4439
         && all go (hsConPatArgs details)
-    go1 (ConPatOut{ pat_con = L _ (PatSynCon _pat) })
+    go1 (ConPatOut{})
         = False -- Conservative
 
     go1 (LitPat {})         = False
@@ -776,7 +776,7 @@ patNeedsParens p = go
     go (SumPat {})            = False
     go (ListPat {})           = False
     go (LitPat _ l)           = hsLitNeedsParens p l
-    go (NPat _ (L _ ol) _ _)  = hsOverLitNeedsParens p ol
+    go (NPat _ (dL->(_ , ol)) _ _)  = hsOverLitNeedsParens p ol
     go (XPat {})              = True -- conservative default
 
 -- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 71a54b0..c7d59b7 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -338,12 +338,16 @@
               {OccName: qux}))
             (Prefix)
             (NoSrcStrict))
-           [({ KindSigs.hs:23:5 }
+           [(XPat
+             ((,)
+              { KindSigs.hs:23:5 }
              (WildPat
-              (NoExt)))
-           ,({ KindSigs.hs:23:7 }
+               (NoExt))))
+           ,(XPat
+             ((,)
+              { KindSigs.hs:23:7 }
              (WildPat
-              (NoExt)))]
+               (NoExt))))]
            (GRHSs
             (NoExt)
             [({ KindSigs.hs:23:9-12 }
@@ -605,5 +609,3 @@
       [])))]
   (Nothing)
   (Nothing)))
-
-