[Git][ghc/ghc][master] EPA: Use EpaLocation in EpVirtualBraces

1 Oct 2026


      Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00
EPA: Use EpaLocation in EpVirtualBraces

Haddock processing uses EpLayout.EpVirtualBraces to record the current
layout column, for allocating haddock comments correctly.

For exact printing, we need the line as well as the col, so we know
how many lines to skip when the indented code block starts.

This commit updates EpLayout.EpVirtualBraces so that it carries an
EpaLocation instead of just the Int column, to allow it to be used for
both purposes.

It is a simple mechanical change, with no other impact, but it allows
us to use EpLayout instead of AnnListLayout in AnnList, in the next
commit in this series.

- - - - -


24 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -945,13 +945,13 @@ body    :: { ([TrailingAnn]
              ,([LImportDecl GhcPs], [LHsDecl GhcPs])
              ,EpLayout) }
         :  '{'            top '}'      { (fst $2, snd $2, epExplicitBraces $1 $3) }
-        |      vocurly    top close    { (fst $2, snd $2, EpVirtualBraces (getVOCURLY $1)) }
+        |      vocurly    top close    { (fst $2, snd $2, EpVirtualBraces (glR $1)) }
 
 body2   :: { ([TrailingAnn]
              ,([LImportDecl GhcPs], [LHsDecl GhcPs])
              ,EpLayout) }
         :  '{' top '}'                          { (fst $2, snd $2, epExplicitBraces $1 $3) }
-        |  missing_module_keyword top close     { ([], snd $2, EpVirtualBraces leftmostColumn) }
+        |  missing_module_keyword top close     { ([], snd $2, EpVirtualBraces (EpaDelta noSrcSpan (SameLine 0) [])) }
 
 
 top     :: { ([TrailingAnn]
@@ -1855,7 +1855,7 @@ decllist_cls
         : '{'         decls_cls '}'     { sLL $1 $> ((epTok $1, fst $ unLoc $2, epTok $3)
                                              ,snd $ unLoc $2, epExplicitBraces $1 $3) }
         |     vocurly decls_cls close   { let { L l (anns, decls) = $2 }
-                                           in L l ((noEpTok, anns, noEpTok), decls, EpVirtualBraces (getVOCURLY $1)) }
+                                           in L l ((noEpTok, anns, noEpTok), decls, EpVirtualBraces (glR $1)) }
 
 -- Class body
 --
@@ -4305,7 +4305,6 @@ getINLINE         (L _ (ITinline_prag _ inl conl)) = (inl,conl)
 getSPEC_INLINE    (L _ (ITspec_inline_prag src True))  = (Inline,FunLike)
 getSPEC_INLINE    (L _ (ITspec_inline_prag src False)) = (NoInline,FunLike)
 getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x
-getVOCURLY        (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l
 
 getINTEGERs       (L _ (ITinteger (IL src _ _))) = src
 getCHARs          (L _ (ITchar       src _)) = src


=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -5,7 +5,7 @@ module GHC.Parser.Annotation (
   getEpTokenBufSpan,
   getEpTokenLoc, getEpUniTokenLoc,
   TokDcolon, TokDarrow, TokRarrow, TokForall, TokStar,
-  EpLayout(..),
+  EpLayout(..), getEpaLocationCol,
   EpaComment(..), EpaCommentTok(..),
   IsUnicodeSyntax(..),
   HasE(..),
@@ -282,7 +282,9 @@ data EpLayout =
     --   bar :: a
     -- @
     EpVirtualBraces
-      !Int -- ^ Layout column (indentation level, begins at 1)
+      !EpaLocation -- ^ Layout column (indentation level, begins at 1)
+                   -- We keep this as an 'EpaLocation' so exact printing
+                   -- can use it too.
   |
     -- | Empty or compiler-generated blocks do not have layout information
     -- associated with them.
@@ -290,6 +292,14 @@ data EpLayout =
 
 deriving instance Data EpLayout
 
+-- | Used in 'GHC.Parser.Haddock' to get layout column. It assumes
+-- | there is a RealSrcSpan in it, falling back to zero otherwise
+getEpaLocationCol :: EpaLocation -> Int
+getEpaLocationCol loc
+  = case loc of
+      EpaSpan (RealSrcSpan l _) -> srcSpanStartCol l
+      _ -> leftmostColumn -- should never happen in Parser output
+
 -- ---------------------------------------------------------------------
 
 data EpaComment =


=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -392,8 +392,9 @@ addHaddockInterleaveItems layout get_doc_item = go
     with_layout = case layout of
       EpNoLayout -> id
       EpExplicitBraces{} -> id
-      EpVirtualBraces n ->
-        let loc_range = mempty { loc_range_col = ColumnFrom (n+1) }
+      EpVirtualBraces n' ->
+        let n = getEpaLocationCol n'
+            loc_range = mempty { loc_range_col = ColumnFrom (n+1) }
         in hoistHdkA (inLocRange loc_range)
 
 instance HasHaddock (LocatedA (HsDecl GhcPs)) where
@@ -1304,7 +1305,7 @@ mkDocDecl layout (L l_comment hdk_comment)
     indent_mismatch = case layout of
       EpNoLayout -> False
       EpExplicitBraces{} -> False
-      EpVirtualBraces n -> n /= srcSpanStartCol (psRealSpan l_comment)
+      EpVirtualBraces n -> getEpaLocationCol n /= srcSpanStartCol (psRealSpan l_comment)
 
 mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs)
 mkDocIE (L l_comment hdk_comment) =


=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -34,7 +34,7 @@
         { T22919.hs:1:8-13 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T22919.hs:2:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -34,7 +34,7 @@
          "-- ^ Run any arbitrary IO code")
         { Test20239.hs:7:86 }))]))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { Test20239.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -40,7 +40,7 @@
          "-- Trailing comment, should be in HsModule extension point")
         { ZeroWidthSemi.hs:6:5 }))]))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { ZeroWidthSemi.hs:6:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T17544.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -64,7 +64,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (3)))
+        (EpaSpan { T17544.hs:6:3 })))
       []
       (Nothing)
       (L
@@ -243,7 +243,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (3)))
+        (EpaSpan { T17544.hs:10:3 })))
       []
       (Nothing)
       (L
@@ -423,7 +423,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (3)))
+        (EpaSpan { T17544.hs:14:3 })))
       []
       (Nothing)
       (L
@@ -603,7 +603,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (3)))
+        (EpaSpan { T17544.hs:18:3 })))
       []
       (Nothing)
       (L


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T17544_kw.hs:13:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -412,7 +412,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (5)))
+        (EpaSpan { T17544_kw.hs:22:5 })))
       []
       (Nothing)
       (L


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T24221.hs:3:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaDelta { <no location info> } (SameLine 0) []))
    (Nothing)
    (Nothing))
   (Nothing)


=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { DumpParsedAst.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -41,7 +41,7 @@
         { DumpParsedAstComments.hs:1:1-28 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { DumpParsedAstComments.hs:9:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -45,7 +45,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { DumpSemis.hs:4:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -1336,7 +1336,7 @@
         (EpTok (EpaSpan { <no location info> }))
         [])
        (EpVirtualBraces
-        (3)))
+        (EpaSpan { DumpSemis.hs:29:3 })))
       []
       (Nothing)
       (L


=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { KindSigs.hs:8:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T15323.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T20452.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -68,7 +68,7 @@
          "-- end 2")
         { T20718.hs:10:1-8 }))]))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T20718.hs:8:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T20718b.stderr
=====================================
@@ -55,7 +55,7 @@
         { T20718b.hs:6:1-21 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T20718b.hs:8:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T20846.hs:3:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/parser/should_compile/T23315/T23315.stderr
=====================================
@@ -24,7 +24,7 @@
     (EpaComments
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T23315.hsig:3:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
=====================================
@@ -47,7 +47,7 @@
          "-- comment post B")
         { AnnotationNoListTuplePuns.hs:17:3 }))]))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { AnnotationNoListTuplePuns.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -244,7 +244,7 @@
         { AnnotationNoListTuplePuns.ppr.hs:1:1-32 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -28,7 +28,7 @@
      []
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { T18791.hs:4:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -34,7 +34,7 @@
         { Test20297.hs:1:1 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { Test20297.hs:5:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -476,7 +476,7 @@
         { Test20297.ppr.hs:1:1 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { Test20297.ppr.hs:3:1 }))
    (Nothing)
    (Nothing))
   (Just


=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -34,7 +34,7 @@
         { Test24533.hs:1:1 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { Test24533.hs:4:1 }))
    (Nothing)
    (Nothing))
   (Just
@@ -694,7 +694,7 @@
         { Test24533.ppr.hs:1:1 }))]
      []))
    (EpVirtualBraces
-    (1))
+    (EpaSpan { Test24533.ppr.hs:3:1 }))
    (Nothing)
    (Nothing))
   (Just



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e358619f138494a690f47aa1f9663c8f...
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

    

Marge Bot (＠marge-bot)

tags

participants (1)