[Git][ghc/ghc][master] EPA: Move the 'where' annotation for PatSynBind

6 Jul 2026


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


Commits:
383ddcd4 by Alan Zimmerman at 2026-07-06T07:08:16-04:00
EPA: Move the 'where' annotation for PatSynBind

This allows us to move it out of the MatchGroup exact print annotation
too

- - - - -


18 changed files:

- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.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/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- utils/check-exact/ExactPrint.hs


Changes:

=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -147,11 +147,12 @@ data AnnPSB
   = AnnPSB {
       ap_pattern :: EpToken "pattern",
       ap_larrow  :: Maybe (EpUniToken "<-" "←"),
-      ap_equal   :: Maybe (EpToken "=")
+      ap_equal   :: Maybe (EpToken "="),
+      ap_where   :: Maybe (EpToken "where")
     } deriving Data
 
 instance NoAnn AnnPSB where
-  noAnn = AnnPSB noAnn noAnn noAnn
+  noAnn = AnnPSB noAnn noAnn noAnn noAnn
 
 -- ---------------------------------------------------------------------
 


=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -68,7 +68,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
               `extQ` annotationGrhsAnn
               `extQ` annotationAnnList
               `extQ` annotationEpAnnListWhere
-              `extQ` annotationAnnListWhere
+              `extQ` annotationAnnListUnit
               `extQ` annotationAnnListCommas
               `extQ` annotationAnnListEpaLocation
               `extQ` annotationNoEpAnns
@@ -377,9 +377,9 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
             annotationAnnListCommas :: EpAnn (AnnList [EpToken ","]) -> SDoc
             annotationAnnListCommas = annotation' (text "EpAnn (AnnList [EpToken \",\"])")
 
-            annotationAnnListWhere :: AnnList (EpToken "where") -> SDoc
-            annotationAnnListWhere anns = case ba of
-             BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList (EpToken \"where\")")
+            annotationAnnListUnit :: AnnList () -> SDoc
+            annotationAnnListUnit anns = case ba of
+             BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList ()")
              NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns))
                                                $$ vcat (gmapQ showAstData' anns)
 


=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -1654,7 +1654,7 @@ type instance XMG         GhcRn b = (Origin, -- See Note [Generated code and pat
                                      MatchGroupAnn)
 type instance XMG         GhcTc b = MatchGroupTc
 
-type MatchGroupAnn = AnnList (EpToken "where")
+type MatchGroupAnn = AnnList ()
 
 data MatchGroupTc
   = MatchGroupTc


=====================================
compiler/GHC/Parser.y
=====================================
@@ -1760,19 +1760,19 @@ pattern_synonym_decl :: { LHsDecl GhcPs }
          {%      let (name, args) = $2 in
                  amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4
                                                     ImplicitBidirectional
-                      (AnnPSB (epTok $1) Nothing (Just (epTok $3)))) }
+                      (AnnPSB (epTok $1) Nothing (Just (epTok $3)) Nothing)) }
 
         | 'pattern' pattern_synonym_lhs '<-' pat_syn_pat
          {%    let (name, args) = $2 in
                amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional
-                       (AnnPSB (epTok $1) (Just (epUniTok $3)) Nothing)) }
+                       (AnnPSB (epTok $1) (Just (epUniTok $3)) Nothing Nothing)) }
 
         | 'pattern' pattern_synonym_lhs '<-' pat_syn_pat where_decls
             {% do { let (name, args) = $2
                   ; mg <- mkPatSynMatchGroup name $5
                   ; amsA' (sLL $1 $> . ValD noExtField $
                            mkPatSynBind name args $4 (ExplicitBidirectional mg)
-                            (AnnPSB (epTok $1) (Just (epUniTok $3)) Nothing))
+                            (AnnPSB (epTok $1) (Just (epUniTok $3)) Nothing (Just (sndOf3 $ unLoc $5)) ))
                    }}
 
 pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs) }
@@ -1789,11 +1789,13 @@ cvars1 :: { [RecordPatSynField GhcPs] }
        | var ',' cvars1               {% do { h <- addTrailingCommaN $1 (gl $2)
                                             ; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}}
 
-where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), AnnList (EpToken "where")) }
+where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ()) }
         : 'where' '{' decls '}'       {% amsA' (sLL $1 $> (thdOf3 $ unLoc $3,
-                                                AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) (epTok $1) [])) }
+                                                epTok $1,
+                                                AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) () [])) }
         | 'where' vocurly decls close {% amsA' (sLL $1 $3 (thdOf3 $ unLoc $3,
-                                                AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) (epTok $1) [])) }
+                                                epTok $1,
+                                                AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) () [])) }
 
 pattern_synonym_sig :: { LSig GhcPs }
         : 'pattern' con_list '::' sigtype
@@ -3535,7 +3537,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
 -----------------------------------------------------------------------------
 -- Case alternatives
 
-altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList (EpToken "where"))) }
+altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())) }
         : '{'        alts(PATS) '}'    { $2 >>= \ $2 -> amsA'
                                            (sLL $1 $> (reverse (snd $ unLoc $2),
                                            (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2) noAnn []))) }


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -723,9 +723,9 @@ tyConToDataCon (L loc tc)
     occ = rdrNameOcc tc
 
 mkPatSynMatchGroup :: LocatedN RdrName
-                   -> LocatedA (OrdList (LHsDecl GhcPs), AnnList (EpToken "where"))
+                   -> LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ())
                    -> P (MatchGroup GhcPs (LHsExpr GhcPs))
-mkPatSynMatchGroup (L loc patsyn_name) (L ld (decls, ann)) =
+mkPatSynMatchGroup (L loc patsyn_name) (L ld (decls, _, ann)) =
     do { matches <- mapM fromDecl (fromOL decls)
        ; when (null matches) (wrongNumberErr (locA loc))
        ; return $ mkMatchGroup FromSource ann (L ld matches) }
@@ -1772,11 +1772,11 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
               -> PV (LocatedA b)
   -- | Disambiguate "case ... of ..."
   mkHsCasePV :: SrcSpan -> LHsExpr GhcPs
-             -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList (EpToken "where"))
+             -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())
              -> EpAnnHsCase -> PV (LocatedA b)
   -- | Disambiguate "\... -> ..." (lambda), "\case" and "\cases"
   mkHsLamPV :: SrcSpan -> HsLamVariant
-            -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList (EpToken "where"))
+            -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())
             -> EpAnnLam
             -> PV (LocatedA b)
   -- | Function argument representation


=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -74,7 +74,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -86,7 +86,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -99,7 +99,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -2232,7 +2232,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -94,7 +94,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -218,7 +218,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -371,7 +371,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -34,7 +34,7 @@
              (Nothing)
              (ListNone)
              []
-             (NoEpTok)
+             (())
              []))
            (L
             (EpAnn


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -271,7 +271,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -578,7 +578,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -840,7 +840,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1056,7 +1056,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1162,7 +1162,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1270,7 +1270,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1786,7 +1786,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1914,7 +1914,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -2040,7 +2040,7 @@
                          (Nothing)
                          (ListNone)
                          []
-                         (NoEpTok)
+                         (())
                          []))
                        (L
                         (EpAnn
@@ -2153,7 +2153,7 @@
                          (Nothing)
                          (ListNone)
                          []
-                         (NoEpTok)
+                         (())
                          []))
                        (L
                         (EpAnn
@@ -2281,7 +2281,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -2402,7 +2402,7 @@
                       (EpaSpan { DumpSemis.hs:38:7 }))
                     ,(EpTok
                       (EpaSpan { DumpSemis.hs:38:8 }))]
-                    (NoEpTok)
+                    (())
                     []))
                   (L
                    (EpAnn


=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -1018,7 +1018,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -1753,7 +1753,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -108,7 +108,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -99,7 +99,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn


=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -74,7 +74,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -207,7 +207,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -330,7 +330,7 @@
                     (Nothing)
                     (ListNone)
                     []
-                    (NoEpTok)
+                    (())
                     []))
                   (L
                    (EpAnn
@@ -525,7 +525,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -646,7 +646,7 @@
          (Nothing)
          (ListNone)
          []
-         (NoEpTok)
+         (())
          []))
        (L
         (EpAnn
@@ -763,7 +763,7 @@
                     (Nothing)
                     (ListNone)
                     []
-                    (NoEpTok)
+                    (())
                     []))
                   (L
                    (EpAnn


=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -555,7 +555,7 @@
              (Nothing)
              (ListNone)
              []
-             (NoEpTok)
+             (())
              []))
            (L
             (EpAnn
@@ -1165,7 +1165,7 @@
              (Nothing)
              (ListNone)
              []
-             (NoEpTok)
+             (())
              []))
            (L
             (EpAnn


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -2326,7 +2326,7 @@ instance ExactPrint (PatSynBind GhcPs GhcPs) where
   getAnnotationEntry _ = NoEntryVal
   setAnnotationAnchor a _ _ _ = a
 
-  exact (PSB{ psb_ext = AnnPSB ap al ae
+  exact (PSB{ psb_ext = AnnPSB ap al ae aw
             , psb_id = psyn, psb_args = details
             , psb_def = pat
             , psb_dir = dir }) = do
@@ -2349,23 +2349,24 @@ instance ExactPrint (PatSynBind GhcPs GhcPs) where
           ac' <- markEpToken ac
           return (psyn', RecCon (ao',ac') vs')
 
-    (al', ae', pat', dir') <-
+    (al', ae', pat', dir', aw') <-
       case dir of
         Unidirectional           -> do
           al' <- mapM markEpUniToken al
           pat' <- markAnnotated pat
-          return (al', ae, pat', dir)
+          return (al', ae, pat', dir, aw)
         ImplicitBidirectional    -> do
           ae' <- mapM markEpToken ae
           pat' <- markAnnotated pat
-          return (al, ae', pat', dir)
+          return (al, ae', pat', dir, aw)
         ExplicitBidirectional mg -> do
           al' <- mapM markEpUniToken al
           pat' <- markAnnotated pat
+          aw' <- mapM markEpToken aw
           mg' <- markAnnotated mg
-          return (al', ae, pat', ExplicitBidirectional mg')
+          return (al', ae, pat', ExplicitBidirectional mg', aw')
 
-    return (PSB{ psb_ext = AnnPSB ap' al' ae'
+    return (PSB{ psb_ext = AnnPSB ap' al' ae' aw'
                , psb_id = psyn', psb_args = details'
                , psb_def = pat'
                , psb_dir = dir' })
@@ -3249,11 +3250,10 @@ instance (Typeable body,
     = MG (origin,an) (L (setAnchorEpa l anc ts cs) matches)
 
   exact (MG (origin,an) (L l matches)) = do
-    an0 <- markLensFun an lal_rest markEpToken -- 'where', only for PatSynBind
-    (an1,matches') <- markAnnListA' an0 $ \a -> do
+    (an0,matches') <- markAnnListA' an $ \a -> do
         m' <- markAnnotated matches
         return (a,m')
-    return (MG (origin, an1) (L l matches'))
+    return (MG (origin, an0) (L l matches'))
 
 -- ---------------------------------------------------------------------
 



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

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

    

Marge Bot (＠marge-bot)

tags

participants (1)