[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: use EpToken for dcol in ConDeclGADT

Vladislav Zavialov (@int-index) gitlab at gitlab.haskell.org
Sun Dec 10 18:39:23 UTC 2023



Vladislav Zavialov pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC


Commits:
f175c9ea by Vladislav Zavialov at 2023-12-10T21:35:26+03:00
EPA: use EpToken for dcol in ConDeclGADT

- - - - -


17 changed files:

- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Concrete.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/printer/T18791.stderr
- utils/check-exact/ExactPrint.hs
- utils/haddock


Changes:

=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -665,8 +665,13 @@ type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen
 standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
 standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
 
-type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn]
-type instance XConDeclH98  (GhcPass _) = EpAnn [AddEpAnn]
+type instance XConDeclGADT GhcPs = (EpUniToken "::" "∷", EpAnn [AddEpAnn])
+type instance XConDeclGADT GhcRn = NoExtField
+type instance XConDeclGADT GhcTc = NoExtField
+
+type instance XConDeclH98  GhcPs = EpAnn [AddEpAnn]
+type instance XConDeclH98  GhcRn = NoExtField
+type instance XConDeclH98  GhcTc = NoExtField
 
 type instance XXConDecl (GhcPass _) = DataConCantHappen
 


=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -242,11 +242,6 @@ type instance Anno (HsToken tok) = TokenLocation
 noHsTok :: GenLocated TokenLocation (HsToken tok)
 noHsTok = L NoTokenLoc HsTok
 
-type instance Anno (HsUniToken tok utok) = TokenLocation
-
-noHsUniTok :: GenLocated TokenLocation (HsUniToken tok utok)
-noHsUniTok = L NoTokenLoc HsNormalTok
-
 --- Outputable
 
 instance Outputable NoExtField where
@@ -256,8 +251,4 @@ instance Outputable DataConCantHappen where
   ppr = dataConCantHappen
 
 instance KnownSymbol tok => Outputable (HsToken tok) where
-   ppr _ = text (symbolVal (Proxy :: Proxy tok))
-
-instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where
-   ppr HsNormalTok  = text (symbolVal (Proxy :: Proxy tok))
-   ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok))
\ No newline at end of file
+   ppr _ = text (symbolVal (Proxy :: Proxy tok))
\ No newline at end of file


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2434,7 +2434,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 (comb2 $2 $>) (unLoc $2) (hsUniTok $3) $4 }
+                {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (epUniTok $3) $4 }
 
 {- Note [Difference in parsing GADT and data constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -4494,11 +4494,6 @@ epUniTok t@(L l _) = EpUniTok (EpaSpan l) u
 hsTok' :: Located Token -> Located (HsToken tok)
 hsTok' (L l _) = L l HsTok
 
-hsUniTok :: Located Token -> LHsUniToken tok utok GhcPs
-hsUniTok t@(L l _) =
-  L (mkTokenLocation l)
-    (if isUnicode t then HsUnicodeTok else HsNormalTok)
-
 epExplicitBraces :: Located Token -> Located Token -> EpLayout
 epExplicitBraces t1 t2 = EpExplicitBraces (epTok t1) (epTok t2)
 


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -806,7 +806,7 @@ mkConDeclH98 ann name mb_forall mb_cxt args
 --   Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
 mkGadtDecl :: SrcSpan
            -> NonEmpty (LocatedN RdrName)
-           -> LHsUniToken "::" "∷" GhcPs
+           -> EpUniToken "::" "∷"
            -> LHsSigType GhcPs
            -> P (LConDecl GhcPs)
 mkGadtDecl loc names dcol ty = do
@@ -835,9 +835,8 @@ mkGadtDecl loc names dcol ty = do
         HsOuterExplicit an _ -> EpAnn (entry an) noAnn emptyComments
 
   pure $ L l ConDeclGADT
-                     { con_g_ext  = an
+                     { con_g_ext  = (dcol, an)
                      , con_names  = names
-                     , con_dcolon = dcol
                      , con_bndrs  = L bndrs_loc outer_bndrs
                      , con_mb_cxt = mcxt
                      , con_g_args = args


=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -698,7 +698,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_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
+      ConDeclGADT { con_g_ext, con_names, 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 (NE.head con_names))
         con_g_args' <-
@@ -710,7 +710,7 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
               pure $ RecConGADT arr (L l_rec flds')
         con_res_ty' <- addHaddock con_res_ty
         pure $ L l_con_decl $
-          ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt,
+          ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt,
                         con_doc = lexLHsDocString <$> con_doc',
                         con_g_args = con_g_args',
                         con_res_ty = con_res_ty' }


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2400,7 +2400,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
              , text "new_ex_dqtvs':" <+> ppr new_ex_tvs ])
 
         ; mb_doc' <- traverse rnLHsDoc mb_doc
-        ; return (decl { con_ext = noAnn
+        ; return (decl { con_ext = noExtField
                        , con_name = new_name, con_ex_tvs = new_ex_tvs
                        , con_mb_cxt = new_context, con_args = new_args
                        , con_doc = mb_doc'
@@ -2408,7 +2408,6 @@ 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
@@ -2446,8 +2445,7 @@ rnConDecl (ConDeclGADT { con_names   = names
         ; traceRn "rnConDecl (ConDeclGADT)"
             (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
+        ; return (ConDeclGADT { con_g_ext = noExtField, con_names = new_names
                               , 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 },


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -747,7 +747,6 @@ 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


=====================================
compiler/Language/Haskell/Syntax/Concrete.hs
=====================================
@@ -6,9 +6,7 @@
 -- | Bits of concrete syntax (tokens, layout).
 
 module Language.Haskell.Syntax.Concrete
-  ( LHsToken, LHsUniToken,
-    HsToken(HsTok),
-    HsUniToken(HsNormalTok, HsUnicodeTok),
+  ( LHsToken, HsToken(HsTok),
   ) where
 
 import GHC.Prelude
@@ -17,7 +15,6 @@ import Data.Data
 import Language.Haskell.Syntax.Extension
 
 type LHsToken tok p = XRec p (HsToken tok)
-type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
 
 -- | A token stored in the syntax tree. For example, when parsing a
 -- let-expression, we store @HsToken "let"@ and @HsToken "in"@.
@@ -25,15 +22,5 @@ type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
 -- (exactprint) the original program text.
 data HsToken (tok :: Symbol) = HsTok
 
--- | With @UnicodeSyntax@, there might be multiple ways to write the same
--- token. For example an arrow could be either @->@ or @→@. This choice must be
--- recorded in order to exactprint such tokens, so instead of @HsToken "->"@ we
--- introduce @HsUniToken "->" "→"@.
---
--- See also @IsUnicodeSyntax@ in @GHC.Parser.Annotation@; we do not use here to
--- avoid a dependency.
-data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
-
 deriving instance Eq (HsToken tok)
-deriving instance KnownSymbol tok => Data (HsToken tok)
-deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
\ No newline at end of file
+deriving instance KnownSymbol tok => Data (HsToken tok)
\ No newline at end of file


=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -95,7 +95,6 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
         -- Because Expr imports Decls via HsBracket
 
 import Language.Haskell.Syntax.Binds
-import Language.Haskell.Syntax.Concrete
 import Language.Haskell.Syntax.Extension
 import Language.Haskell.Syntax.Type
 import Language.Haskell.Syntax.Basic (Role)
@@ -1080,7 +1079,6 @@ data ConDecl pass
   = ConDeclGADT
       { con_g_ext   :: XConDeclGADT pass
       , con_names   :: NonEmpty (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)


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -1108,11 +1108,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:25:5-18 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:25:10-11 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:25:5-18 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -1124,10 +1128,6 @@
                   (Unqual
                    {OccName: MkD5}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:25:10-11 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:25:13-18 })
@@ -1485,11 +1485,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:31:5-18 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:31:10-11 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:31:5-18 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -1501,10 +1505,6 @@
                   (Unqual
                    {OccName: MkD6}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:31:10-11 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:31:13-18 })
@@ -1862,11 +1862,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:37:5-18 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:37:10-11 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:37:5-18 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -1878,10 +1882,6 @@
                   (Unqual
                    {OccName: MkD7}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:37:10-11 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:37:13-18 })
@@ -2239,11 +2239,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:43:5-18 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:43:10-11 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:43:5-18 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -2255,10 +2259,6 @@
                   (Unqual
                    {OccName: MkD8}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:43:10-11 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:43:13-18 })
@@ -2616,11 +2616,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:49:5-18 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:49:10-11 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:49:5-18 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -2632,10 +2636,6 @@
                   (Unqual
                    {OccName: MkD9}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:49:10-11 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:49:13-18 })
@@ -2993,11 +2993,15 @@
                 (EpaComments
                  []))
                (ConDeclGADT
-                (EpAnn
-                 (EpaSpan { T17544.hs:55:5-20 })
-                 []
-                 (EpaComments
-                  []))
+                ((,)
+                 (EpUniTok
+                  (EpaSpan { T17544.hs:55:11-12 })
+                  (NormalSyntax))
+                 (EpAnn
+                  (EpaSpan { T17544.hs:55:5-20 })
+                  []
+                  (EpaComments
+                   [])))
                 (:|
                  (L
                   (EpAnn
@@ -3009,10 +3013,6 @@
                   (Unqual
                    {OccName: MkD10}))
                  [])
-                (L
-                 (TokenLoc
-                  (EpaSpan { T17544.hs:55:11-12 }))
-                 (HsNormalTok))
                 (L
                  (EpAnn
                   (EpaSpan { T17544.hs:55:14-20 })


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -89,11 +89,15 @@
            (EpaComments
             []))
           (ConDeclGADT
-           (EpAnn
-            (EpaSpan { T17544_kw.hs:16:9-20 })
-            []
-            (EpaComments
-             []))
+           ((,)
+            (EpUniTok
+             (EpaSpan { T17544_kw.hs:16:15-16 })
+             (NormalSyntax))
+            (EpAnn
+             (EpaSpan { T17544_kw.hs:16:9-20 })
+             []
+             (EpaComments
+              [])))
            (:|
             (L
              (EpAnn
@@ -105,10 +109,6 @@
              (Unqual
               {OccName: MkFoo}))
             [])
-           (L
-            (TokenLoc
-             (EpaSpan { T17544_kw.hs:16:15-16 }))
-            (HsNormalTok))
            (L
             (EpAnn
              (EpaSpan { T17544_kw.hs:16:18-20 })
@@ -202,11 +202,15 @@
           (EpaComments
            []))
          (ConDeclGADT
-          (EpAnn
-           (EpaSpan { T17544_kw.hs:19:9-26 })
-           []
-           (EpaComments
-            []))
+          ((,)
+           (EpUniTok
+            (EpaSpan { T17544_kw.hs:19:15-16 })
+            (NormalSyntax))
+           (EpAnn
+            (EpaSpan { T17544_kw.hs:19:9-26 })
+            []
+            (EpaComments
+             [])))
           (:|
            (L
             (EpAnn
@@ -218,10 +222,6 @@
             (Unqual
              {OccName: MkBar}))
            [])
-          (L
-           (TokenLoc
-            (EpaSpan { T17544_kw.hs:19:15-16 }))
-           (HsNormalTok))
           (L
            (EpAnn
             (EpaSpan { T17544_kw.hs:19:18-26 })


=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -1903,11 +1903,15 @@
             (EpaComments
              []))
            (ConDeclGADT
-            (EpAnn
-             (EpaSpan { DumpParsedAst.hs:23:3-45 })
-             []
-             (EpaComments
-              []))
+            ((,)
+             (EpUniTok
+              (EpaSpan { DumpParsedAst.hs:23:7-8 })
+              (NormalSyntax))
+             (EpAnn
+              (EpaSpan { DumpParsedAst.hs:23:3-45 })
+              []
+              (EpaComments
+               [])))
             (:|
              (L
               (EpAnn
@@ -1919,10 +1923,6 @@
               (Unqual
                {OccName: Nat}))
              [])
-            (L
-             (TokenLoc
-              (EpaSpan { DumpParsedAst.hs:23:7-8 }))
-             (HsNormalTok))
             (L
              (EpAnn
               (EpaSpan { DumpParsedAst.hs:23:10-45 })


=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -168,11 +168,7 @@
              (EpaComments
               []))
             (ConDeclH98
-             (EpAnn
-              (EpaDelta (SameLine 0) [])
-              []
-              (EpaComments
-               []))
+             (NoExtField)
              (L
               (EpAnn
                (EpaSpan { DumpRenamedAst.hs:9:14-17 })
@@ -196,11 +192,7 @@
              (EpaComments
               []))
             (ConDeclH98
-             (EpAnn
-              (EpaDelta (SameLine 0) [])
-              []
-              (EpaComments
-               []))
+             (NoExtField)
              (L
               (EpAnn
                (EpaSpan { DumpRenamedAst.hs:9:21-24 })
@@ -1094,11 +1086,7 @@
               (EpaComments
                []))
              (ConDeclGADT
-              (EpAnn
-               (EpaDelta (SameLine 0) [])
-               []
-               (EpaComments
-                []))
+              (NoExtField)
               (:|
                (L
                 (EpAnn
@@ -1109,10 +1097,6 @@
                   []))
                 {Name: DumpRenamedAst.Nat})
                [])
-              (L
-               (TokenLoc
-                (EpaSpan { DumpRenamedAst.hs:20:7-8 }))
-               (HsNormalTok))
               (L
                (EpAnn
                 (EpaSpan { DumpRenamedAst.hs:20:10-45 })
@@ -1494,11 +1478,7 @@
              (EpaComments
               []))
             (ConDeclH98
-             (EpAnn
-              (EpaDelta (SameLine 0) [])
-              []
-              (EpaComments
-               []))
+             (NoExtField)
              (L
               (EpAnn
                (EpaSpan { DumpRenamedAst.hs:22:21-23 })


=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -100,11 +100,15 @@
            (EpaComments
             []))
           (ConDeclGADT
-           (EpAnn
-            (EpaSpan { T15323.hs:6:5-54 })
-            []
-            (EpaComments
-             []))
+           ((,)
+            (EpUniTok
+             (EpaSpan { T15323.hs:6:17-18 })
+             (NormalSyntax))
+            (EpAnn
+             (EpaSpan { T15323.hs:6:5-54 })
+             []
+             (EpaComments
+              [])))
            (:|
             (L
              (EpAnn
@@ -116,10 +120,6 @@
              (Unqual
               {OccName: TestParens}))
             [])
-           (L
-            (TokenLoc
-             (EpaSpan { T15323.hs:6:17-18 }))
-            (HsNormalTok))
            (L
             (EpAnn
              (EpaSpan { T15323.hs:6:20-29 })


=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -77,11 +77,15 @@
            (EpaComments
             []))
           (ConDeclGADT
-           (EpAnn
-            (EpaSpan { T18791.hs:5:3-17 })
-            []
-            (EpaComments
-             []))
+           ((,)
+            (EpUniTok
+             (EpaSpan { T18791.hs:5:7-8 })
+             (NormalSyntax))
+            (EpAnn
+             (EpaSpan { T18791.hs:5:3-17 })
+             []
+             (EpaComments
+              [])))
            (:|
             (L
              (EpAnn
@@ -93,10 +97,6 @@
              (Unqual
               {OccName: MkT}))
             [])
-           (L
-            (TokenLoc
-             (EpaSpan { T18791.hs:5:7-8 }))
-            (HsNormalTok))
            (L
             (EpAnn
              (EpaSpan { T18791.hs:5:10-17 })


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -852,15 +852,6 @@ markToken (L (TokenLoc aa) t) = do
   aa' <- printStringAtAA aa (symbolVal (Proxy @tok))
   return (L (TokenLoc aa') t)
 
-markUniToken :: forall m w tok utok. (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)
-  => LHsUniToken tok utok GhcPs -> EP w m (LHsUniToken tok utok GhcPs)
-markUniToken (L l HsNormalTok)  = do
-  (L l' _) <- markToken (L l (HsTok @tok))
-  return (L l' HsNormalTok)
-markUniToken (L l HsUnicodeTok) = do
-  (L l' _) <- markToken (L l (HsTok @utok))
-  return (L l' HsUnicodeTok)
-
 -- ---------------------------------------------------------------------
 
 markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)
@@ -4422,10 +4413,10 @@ exact_condecls an cs
 -- ---------------------------------------------------------------------
 
 instance ExactPrint (ConDecl GhcPs) where
-  getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (con_g_ext x)
+  getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (snd (con_g_ext x))
   getAnnotationEntry x@(ConDeclH98{})  = fromAnn (con_ext x)
 
-  setAnnotationAnchor x at ConDeclGADT{} anc ts cs = x { con_g_ext = setAnchorEpa (con_g_ext x) anc ts cs}
+  setAnnotationAnchor x at ConDeclGADT{} anc ts cs = x { con_g_ext = fmap (\an -> setAnchorEpa an anc ts cs) (con_g_ext x) }
   setAnnotationAnchor x at ConDeclH98{}  anc ts cs = x { con_ext   = setAnchorEpa (con_ext x) anc ts cs}
 
 -- based on pprConDecl
@@ -4477,14 +4468,13 @@ instance ExactPrint (ConDecl GhcPs) where
 
   -- -----------------------------------
 
-  exact (ConDeclGADT { con_g_ext = an
+  exact (ConDeclGADT { con_g_ext = (dcol, 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
     cons' <- mapM markAnnotated cons
-    dcol' <- markUniToken dcol
+    dcol' <- markEpUniToken dcol
     an1 <- annotationsToComments an lidl  [AnnOpenP, AnnCloseP]
 
     -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
@@ -4506,9 +4496,8 @@ instance ExactPrint (ConDecl GhcPs) where
             rarr' <- markEpUniToken rarr
             return (RecConGADT rarr' fields')
     res_ty' <- markAnnotated res_ty
-    return (ConDeclGADT { con_g_ext = an2
+    return (ConDeclGADT { con_g_ext = (dcol', an2)
                         , 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 })


=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit bbc5ab1bc4c2d064e3dd5f7413f527d57b53a6b1
+Subproject commit 5b607d9ae5770d68df48c6334ac3ef22404f6a65



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f175c9eafa4cd82325f87c70b69207d49259dd7f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f175c9eafa4cd82325f87c70b69207d49259dd7f
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231210/bc71b6b8/attachment-0001.html>


More information about the ghc-commits mailing list