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.