HsUniToken for :: in GADT constructors (#19623)

One more step towards the new design of EPA.

Updates the haddock submodule.

14 files changed, 74 insertions, 18 deletions

diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 381af647ba..01c0459866 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2371,7 +2371,7 @@ gadt_constr :: { LConDecl GhcPs }
     -- Returns a list because of:   C,D :: ty
     -- TODO:AZ capture the optSemi. Why leading?
         : optSemi con_list '::' sigtype
-                {% mkGadtDecl (comb2A $2 $>) (unLoc $2) $4 [mu AnnDcolon $3] }
+                {% mkGadtDecl (comb2A $2 $>) (unLoc $2) (hsUniTok $3) $4 }
 
 {- Note [Difference in parsing GADT and data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index c39cc478af..1530e9ab12 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -723,10 +723,10 @@ mkConDeclH98 ann name mb_forall mb_cxt args
 --   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
 mkGadtDecl :: SrcSpan
            -> [LocatedN RdrName]
+           -> LHsUniToken "::" "∷" GhcPs
            -> LHsSigType GhcPs
-           -> [AddEpAnn]
            -> P (LConDecl GhcPs)
-mkGadtDecl loc names ty annsIn = do
+mkGadtDecl loc names dcol ty = do
   cs <- getCommentsFor loc
   let l = noAnnSrcSpan loc
 
@@ -746,11 +746,12 @@ mkGadtDecl loc names ty annsIn = do
        let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
        return (PrefixConGADT arg_types, res_type, anns, cs)
 
-  let an = EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
+  let an = EpAnn (spanAsAnchor loc) annsa (cs Semi.<> csa)
 
   pure $ L l ConDeclGADT
                      { con_g_ext  = an
                      , con_names  = names
+                     , con_dcolon = dcol
                      , con_bndrs  = L (getLoc ty) outer_bndrs
                      , con_mb_cxt = mcxt
                      , con_g_args = args
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 271d9db30f..72403ef018 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -696,7 +696,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
   addHaddock (L l_con_decl con_decl) =
     extendHdkA (locA l_con_decl) $
     case con_decl of
-      ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
+      ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
         -- discardHasInnerDocs is ok because we don't need this info for GADTs.
         con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (head con_names))
         con_g_args' <-
@@ -708,7 +708,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
               pure $ RecConGADT (L l_rec flds') arr
         con_res_ty' <- addHaddock con_res_ty
         pure $ L l_con_decl $
-          ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt,
+          ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt,
                         con_doc = lexLHsDocString <$> con_doc',
                         con_g_args = con_g_args',
                         con_res_ty = con_res_ty' }
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 29937ea5f0..bc701e87bf 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2350,6 +2350,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
                   all_fvs) }}
 
 rnConDecl (ConDeclGADT { con_names   = names
+                       , con_dcolon  = dcol
                        , con_bndrs   = L l outer_bndrs
                        , con_mb_cxt  = mcxt
                        , con_g_args  = args
@@ -2388,6 +2389,7 @@ rnConDecl (ConDeclGADT { con_names   = names
             (ppr names $$ ppr outer_bndrs')
         ; new_mb_doc <- traverse rnLHsDoc mb_doc
         ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names
+                              , con_dcolon = dcol
                               , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt
                               , con_g_args = new_args, con_res_ty = new_res_ty
                               , con_doc = new_mb_doc },
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 194250aff8..931ea20796 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -703,6 +703,7 @@ mk_gadt_decl names args res_ty
        returnLA $ ConDeclGADT
                    { con_g_ext  = noAnn
                    , con_names  = names
+                   , con_dcolon = noHsUniTok
                    , con_bndrs  = bndrs
                    , con_mb_cxt = Nothing
                    , con_g_args = args
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index baeef95b17..026080d3f6 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -1054,7 +1054,7 @@ data ConDecl pass
   = ConDeclGADT
       { con_g_ext   :: XConDeclGADT pass
       , con_names   :: [LIdP pass]
-
+      , con_dcolon  :: !(LHsUniToken "::" "∷" pass)
       -- The following fields describe the type after the '::'
       -- See Note [GADT abstract syntax]
       , con_bndrs   :: XRec pass (HsOuterSigTyVarBndrs pass)
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index 781d006b54..2e0335db9f 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -844,7 +844,7 @@
                 (Anchor
                  { T17544.hs:25:5-18 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:25:10-11 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -852,6 +852,10 @@
                  (Unqual
                   {OccName: MkD5}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:25:10-11 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:25:13-18 })
                 (HsOuterImplicit
                  (NoExtField)))
@@ -1106,7 +1110,7 @@
                 (Anchor
                  { T17544.hs:31:5-18 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:31:10-11 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -1114,6 +1118,10 @@
                  (Unqual
                   {OccName: MkD6}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:31:10-11 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:31:13-18 })
                 (HsOuterImplicit
                  (NoExtField)))
@@ -1368,7 +1376,7 @@
                 (Anchor
                  { T17544.hs:37:5-18 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:37:10-11 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -1376,6 +1384,10 @@
                  (Unqual
                   {OccName: MkD7}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:37:10-11 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:37:13-18 })
                 (HsOuterImplicit
                  (NoExtField)))
@@ -1630,7 +1642,7 @@
                 (Anchor
                  { T17544.hs:43:5-18 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:43:10-11 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -1638,6 +1650,10 @@
                  (Unqual
                   {OccName: MkD8}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:43:10-11 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:43:13-18 })
                 (HsOuterImplicit
                  (NoExtField)))
@@ -1892,7 +1908,7 @@
                 (Anchor
                  { T17544.hs:49:5-18 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:49:10-11 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -1900,6 +1916,10 @@
                  (Unqual
                   {OccName: MkD9}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:49:10-11 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:49:13-18 })
                 (HsOuterImplicit
                  (NoExtField)))
@@ -2154,7 +2174,7 @@
                 (Anchor
                  { T17544.hs:55:5-20 }
                  (UnchangedAnchor))
-                [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:55:11-12 }))]
+                []
                 (EpaComments
                  []))
                [(L
@@ -2162,6 +2182,10 @@
                  (Unqual
                   {OccName: MkD10}))]
                (L
+                (TokenLoc
+                 (EpaSpan { T17544.hs:55:11-12 }))
+                (HsNormalTok))
+               (L
                 (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:55:14-20 })
                 (HsOuterImplicit
                  (NoExtField)))
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index 63fe2c10d5..889833f2a6 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -75,7 +75,7 @@
            (Anchor
             { T17544_kw.hs:16:9-20 }
             (UnchangedAnchor))
-           [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:16:15-16 }))]
+           []
            (EpaComments
             []))
           [(L
@@ -83,6 +83,10 @@
             (Unqual
              {OccName: MkFoo}))]
           (L
+           (TokenLoc
+            (EpaSpan { T17544_kw.hs:16:15-16 }))
+           (HsNormalTok))
+          (L
            (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 })
            (HsOuterImplicit
             (NoExtField)))
@@ -159,7 +163,7 @@
            (Anchor
             { T17544_kw.hs:19:9-26 }
             (UnchangedAnchor))
-           [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:19:15-16 }))]
+           []
            (EpaComments
             []))
           [(L
@@ -167,6 +171,10 @@
             (Unqual
              {OccName: MkBar}))]
           (L
+           (TokenLoc
+            (EpaSpan { T17544_kw.hs:19:15-16 }))
+           (HsNormalTok))
+          (L
            (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:18-26 })
            (HsOuterImplicit
             (NoExtField)))
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 0f41f9a4d0..3b0dd87fd3 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -1238,7 +1238,7 @@
              (Anchor
               { DumpParsedAst.hs:22:3-45 }
               (UnchangedAnchor))
-             [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:22:7-8 }))]
+             []
              (EpaComments
               []))
             [(L
@@ -1246,6 +1246,10 @@
               (Unqual
                {OccName: Nat}))]
             (L
+             (TokenLoc
+              (EpaSpan { DumpParsedAst.hs:22:7-8 }))
+             (HsNormalTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:10-45 })
              (HsOuterImplicit
               (NoExtField)))
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index cfaa1b102e..c89f054ce4 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -585,6 +585,10 @@
                 (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:3-5 })
                 {Name: DumpRenamedAst.Nat})]
               (L
+               (TokenLoc
+                (EpaSpan { DumpRenamedAst.hs:20:7-8 }))
+               (HsNormalTok))
+              (L
                (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:20:10-45 })
                (HsOuterImplicit
                 [{Name: f}
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index 0a2f60dd59..693814f96e 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -89,7 +89,7 @@
            (Anchor
             { T15323.hs:6:5-54 }
             (UnchangedAnchor))
-           [(AddEpAnn AnnDcolon (EpaSpan { T15323.hs:6:17-18 }))]
+           []
            (EpaComments
             []))
           [(L
@@ -97,6 +97,10 @@
             (Unqual
              {OccName: TestParens}))]
           (L
+           (TokenLoc
+            (EpaSpan { T15323.hs:6:17-18 }))
+           (HsNormalTok))
+          (L
            (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:6:20-54 })
            (HsOuterExplicit
             (EpAnn
@@ -225,3 +229,5 @@
        []))))]
   (Nothing)
   (Nothing)))
+
+
diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index 65fe422f4a..8d3588e7ec 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -75,7 +75,7 @@
            (Anchor
             { T18791.hs:5:3-17 }
             (UnchangedAnchor))
-           [(AddEpAnn AnnDcolon (EpaSpan { T18791.hs:5:7-8 }))]
+           []
            (EpaComments
             []))
           [(L
@@ -83,6 +83,10 @@
             (Unqual
              {OccName: MkT}))]
           (L
+           (TokenLoc
+            (EpaSpan { T18791.hs:5:7-8 }))
+           (HsNormalTok))
+          (L
            (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:5:10-17 })
            (HsOuterImplicit
             (NoExtField)))
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 3ea74a569c..2451354684 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -3230,11 +3230,13 @@ instance ExactPrint (ConDecl GhcPs) where
 
   exact (ConDeclGADT { con_g_ext = an
                      , con_names = cons
+                     , con_dcolon = dcol
                      , con_bndrs = bndrs
                      , con_mb_cxt = mcxt, con_g_args = args
                      , con_res_ty = res_ty, con_doc = doc }) = do
     mapM_ markAnnotated doc
     mapM_ markAnnotated cons
+    markUniToken dcol
     markEpAnn an AnnDcolon
     annotationsToComments (epAnnAnns an)  [AnnOpenP, AnnCloseP]
     -- when has_forall $ markEpAnn an AnnForall
diff --git a/utils/haddock b/utils/haddock
-Subproject d504cd50d8b660c207573864890392f02a48ca5
+Subproject 24208496649a02d5f87373052c430ea4a97842c