GitLab

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

Commits:

f8b2bd8f

by Alan Zimmerman at 2026-09-08T09:39:12-04:00

EPA Fix HsCmdDo exact print with comments

Exact printing of HsCmdDo was ignoring the location for the do
statements, and this is an annotation that can have comments in it.

Update it so we print the statements as a unit, including any
comments.

Also add the result of auditing that we capture comments in all needed
places, noting that the remaining Anno SrcSpan instances are benign.

3 changed files:

compiler/GHC/Hs/Doc.hs
compiler/GHC/Hs/Extension/Pass.hs
utils/check-exact/ExactPrint.hs

Changes:

compiler/GHC/Hs/Doc.hs

@@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc
  import Language.Haskell.Syntax.Extension
  import Language.Haskell.Syntax.Module.Name
 +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
  type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan
  deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass)

compiler/GHC/Hs/Extension/Pass.hs

@@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a
  -- but pass-independent, source location
  type XRecGhc a = GenLocated (Anno a) a
 +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
  type instance Anno (HsDocString (GhcPass _))  = SrcSpan
  type instance Anno HsDocStringChunk           = SrcSpan

utils/check-exact/ExactPrint.hs

@@ -3404,13 +3404,13 @@ instance ExactPrint (HsCmd GhcPs) where
        e' <- markAnnotated e
        return (HsCmdLet (tkLet', tkIn') binds' e')
 -  exact (HsCmdDo (an0,loc) (L l es)) = do
 +  exact (HsCmdDo (an0,loc) es) = do
      debugM $ "HsCmdDo"
      loc' <- printStringAtAA loc "do"
      (an1,es') <- markAnnList' an0 $ do
 -      ee <- mapM markAnnotated es
 +      ee <- markAnnotated es
        return ee
 -    return (HsCmdDo (an1,loc') (L l es'))
 +    return (HsCmdDo (an1,loc') es')
  -- ---------------------------------------------------------------------
@@ -4508,10 +4508,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe
        Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
          debugM $ "LocatedL [ExprLStmt: snocView"
          ls' <- markAnnotated ls
 -        initStmts' <- markAnnotated initStmts
 +        initStmts' <- mapM markAnnotated initStmts
          return (initStmts' ++ [ls'])
        _ -> do
 -        stmts' <- markAnnotated stmts
 +        stmts' <- mapM markAnnotated stmts
          return stmts'
  instance ExactPrint [Located HsDocStringChunk] where