Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2ca87972 by Alan Zimmerman at 2026-08-20T14:58:36-04:00 EPA: Remove LocatedBC / SrcSpanBF The custom annotations are now in the BooleanFormula TTG extension points, so LBooleanFormula can now use the standard LocatedA. - - - - - 9 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Types.hs Changes: ===================================== compiler/GHC/Data/BooleanFormula.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Types.SrcLoc (unLoc) import GHC.Utils.Outputable -import GHC.Parser.Annotation ( SrcSpanAnnBF ) +import GHC.Parser.Annotation ( SrcSpanAnnA, EpToken(..) ) import GHC.Hs.Extension (GhcPass (..), OutputableBndrId) import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP, noExtField, NoExtField, DataConCantHappen, @@ -38,12 +38,12 @@ import Language.Haskell.Syntax.BooleanFormula -- Boolean formula type and smart constructors ---------------------------------------------------------------------- -type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnBF +type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnA type instance XBFVar (GhcPass _) = NoExtField type instance XBFAnd (GhcPass _) = NoExtField type instance XBFOr (GhcPass _) = NoExtField -type instance XBFParens (GhcPass _) = NoExtField +type instance XBFParens (GhcPass _) = (EpToken "(", EpToken ")") type instance XXBooleanFormula (GhcPass _) = DataConCantHappen instance BooleanFormulaDefault (GhcPass p) where ===================================== compiler/GHC/Hs/Dump.hs ===================================== @@ -97,7 +97,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 `ext2Q` located `extQ` srcSpanAnnA `extQ` srcSpanAnnN - `extQ` srcSpanAnnBF where generic :: Data a => a -> SDoc generic t = parens $ text (showConstr (toConstr t)) @@ -396,10 +395,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 srcSpanAnnN :: EpAnn NameAnn -> SDoc srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN") - srcSpanAnnBF :: EpAnn AnnBooleanFormula -> SDoc - srcSpanAnnBF = locatedAnn'' (text "SrcSpanAnnBF") - - locatedAnn'' :: forall a. (Typeable a, Data a) => SDoc -> EpAnn a -> SDoc locatedAnn'' tag ss = parens $ ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2081,7 +2081,7 @@ instance ToHie PendingRnSplice where toHie (PendingRnSplice _ e) = toHie e instance (HiePass p, Data (IdGhcP p)) - => ToHie (GenLocated SrcSpanAnnBF (BooleanFormula (GhcPass p))) where + => ToHie (GenLocated SrcSpanAnnA (BooleanFormula (GhcPass p))) where toHie (L span form) = concatM $ makeNode form (locA span) : case form of Var _ a -> [ toHie $ C Use a ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -1330,7 +1330,7 @@ pprIfaceDecl ss decl@(IfaceClass { ifName = clas fromIfaceBooleanFormula (IfVar nm ) = Var noExtField $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm fromIfaceBooleanFormula (IfAnd bfs ) = And noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs fromIfaceBooleanFormula (IfOr bfs ) = Or noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs - fromIfaceBooleanFormula (IfParens bf) = Parens noExtField $ (noLocA . fromIfaceBooleanFormula) bf + fromIfaceBooleanFormula (IfParens bf) = Parens noAnn $ (noLocA . fromIfaceBooleanFormula) bf -- See Note [Suppressing binder signatures] in GHC.Iface.Type ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -121,7 +121,7 @@ import GHC.Types.Tickish import GHC.Types.TyThing import GHC.Types.Error -import GHC.Parser.Annotation (noLocA) +import GHC.Parser.Annotation (noLocA, noAnn) import GHC.Fingerprint @@ -885,7 +885,7 @@ tc_iface_decl _parent ignore_prags tc_boolean_formula :: IfaceBooleanFormula -> IfL (BooleanFormula GhcRn) tc_boolean_formula (IfAnd ibfs ) = BF.And NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs tc_boolean_formula (IfOr ibfs ) = BF.Or NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs - tc_boolean_formula (IfParens ibf) = BF.Parens NoExtField . noLocA <$> tc_boolean_formula ibf + tc_boolean_formula (IfParens ibf) = BF.Parens noAnn . noLocA <$> tc_boolean_formula ibf tc_boolean_formula (IfVar nm ) = BF.Var NoExtField . noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm) mk_sc_doc pred = text "Superclass" <+> ppr pred ===================================== compiler/GHC/Parser.y ===================================== @@ -3820,7 +3820,7 @@ name_boolformula_opt :: { LBooleanFormula GhcPs } name_boolformula :: { LBooleanFormula GhcPs } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula - {% do { h <- addTrailingVbarBF $1 (epTok $2) + {% do { h <- addTrailingVbarA $1 (epTok $2) ; return (sLLa $1 $> (Or noExtField [h,$3])) } } name_boolformula_and :: { LBooleanFormula GhcPs } @@ -3830,12 +3830,11 @@ name_boolformula_and :: { LBooleanFormula GhcPs } name_boolformula_and_list :: { NonEmpty (LBooleanFormula GhcPs) } : name_boolformula_atom { NE.singleton $1 } | name_boolformula_atom ',' name_boolformula_and_list - {% do { h <- addTrailingCommaBF $1 (epTok $2) + {% do { h <- addTrailingCommaA $1 (epTok $2) ; return (h NE.<| $3) } } name_boolformula_atom :: { LBooleanFormula GhcPs } - : '(' name_boolformula ')' {% amsr (sLL $1 $> (Parens noExtField $2)) - (AnnBooleanFormula (epTok $1) (epTok $3) []) } + : '(' name_boolformula ')' {% amsA' (sLL $1 $> (Parens (epTok $1, epTok $3) $2)) } | name_var { sL1a $1 (Var noExtField $1) } namelist :: { Located [LocatedN RdrName] } @@ -4794,20 +4793,6 @@ addTrailingAnnA (L anns a) tok ta = do -- ------------------------------------- -addTrailingVbarBF :: MonadP m => LocatedBF a -> EpToken "|" -> m (LocatedBF a) -addTrailingVbarBF la tok = addTrailingAnnBF la (AddVbarAnn tok) - -addTrailingCommaBF :: MonadP m => LocatedBF a -> EpToken "," -> m (LocatedBF a) -addTrailingCommaBF la tok = addTrailingAnnBF la (AddCommaAnn tok) - -addTrailingAnnBF :: MonadP m => LocatedBF a -> TrailingAnn -> m (LocatedBF a) -addTrailingAnnBF (L anns a) ta = do - !cs <- getCommentsFor (locA anns) - let anns' = addTrailingAnnToBF ta cs anns - return (L anns' a) - --- ------------------------------------- - -- Mostly use to add AnnComma, special case it to NOP if adding a zero-width annotation addTrailingCommaN :: MonadP m => LocatedN a -> SrcSpan -> m (LocatedN a) addTrailingCommaN (L anns a) span = do ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -28,23 +28,19 @@ module GHC.Parser.Annotation ( -- ** Annotations in 'GenLocated' LocatedA, LocatedN, LocatedAn, - LocatedBF, SrcSpanAnnA, SrcSpanAnnN, - SrcSpanAnnBF, -- ** Annotation data types used in 'GenLocated' AnnList(..), AnnListBrackets(..), AnnParen(..), AnnCType(..),AnnWarningTxt(..),AnnOverlap(..),AnnAnnDecl(..),AnnPragSCC(..), - AnnBooleanFormula(..), NameAnn(..), NameAdornment(..), NoEpAnns(..), -- ** Trailing annotations in lists TrailingAnn(..), ta_location, addTrailingAnnToA, addTrailingCommaToN, - addTrailingAnnToBF, noTrailingN, -- ** Utilities for converting between different 'GenLocated' when @@ -430,8 +426,6 @@ emptyComments = EpaComments [] type LocatedA = GenLocated SrcSpanAnnA type LocatedN = GenLocated SrcSpanAnnN -type LocatedBF = GenLocated SrcSpanAnnBF - -- | Annotation for items appearing in a list. They can have one or -- more trailing punctuations items, such as commas or semicolons. type SrcSpanAnnA = EpAnn [TrailingAnn] @@ -440,8 +434,6 @@ type SrcSpanAnnA = EpAnn [TrailingAnn] -- on the context, such as backticks. type SrcSpanAnnN = EpAnn NameAnn -type SrcSpanAnnBF = EpAnn AnnBooleanFormula - -- | General representation of a 'GenLocated' type carrying a -- parameterised annotation type. type LocatedAn an = GenLocated (EpAnn an) @@ -551,17 +543,6 @@ data AnnParen | AnnParensHash (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)' deriving Data --- --------------------------------------------------------------------- --- | Exact print annotation for the 'BooleanFormula' data type. - -data AnnBooleanFormula - = AnnBooleanFormula { - abf_open :: (EpToken "("), -- ^ opening parenthesis. - abf_close :: (EpToken ")"), -- ^ closing parenthesis. - abf_trailing :: ![TrailingAnn] -- ^ items appearing after the - -- item, such as '|', ',' - } deriving (Data,Eq) - -- --------------------------------------------------------------------- -- Annotations for names -- --------------------------------------------------------------------- @@ -669,14 +650,6 @@ data AnnPragSCC -- --------------------------------------------------------------------- -addTrailingAnnToBF :: TrailingAnn -> EpAnnComments - -> EpAnn AnnBooleanFormula -> EpAnn AnnBooleanFormula -addTrailingAnnToBF t cs n = n { anns = addTrailing (anns n) - , comments = comments n <> cs } - where - -- See Note [list append in addTrailing*] - addTrailing n = n { abf_trailing = abf_trailing n ++ [t]} - -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. addTrailingAnnToA :: TrailingAnn -> EpAnnComments @@ -1030,9 +1003,6 @@ instance (NoAnn ann) => NoAnn (EpAnn ann) where instance NoAnn NoEpAnns where noAnn = NoEpAnns -instance NoAnn AnnBooleanFormula where - noAnn = AnnBooleanFormula noAnn noAnn [] - instance NoAnn AnnList where noAnn = AnnList Nothing ListNone noAnn ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -353,10 +353,6 @@ instance HasTrailing (EpToken "{", EpToken "}") where trailing _ = [] setTrailing a _ = a -instance HasTrailing (AnnBooleanFormula) where - trailing bf = abf_trailing bf - setTrailing a ts = a { abf_trailing = ts } - -- --------------------------------------------------------------------- fromAnn' :: (HasEntry a) => a -> Entry @@ -2731,9 +2727,11 @@ instance ExactPrint (BF.BooleanFormula GhcPs) where exact (BF.And e ls) = do ls' <- mapM markAnnotated ls return (BF.And e ls') - exact (BF.Parens e x) = do + exact (BF.Parens (o,c) x) = do + o' <- markEpToken o x' <- markAnnotated x - return (BF.Parens e x') + c' <- markEpToken c + return (BF.Parens (o',c') x') -- --------------------------------------------------------------------- @@ -4474,17 +4472,6 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe stmts' <- markAnnotated stmts return stmts' -instance ExactPrint (LocatedBF (BF.BooleanFormula GhcPs)) where - getAnnotationEntry = entryFromLocatedA - setAnnotationAnchor = setAnchorAn - exact (L an bf) = do - debugM $ "LocatedCB [LBooleanFormula" - let (AnnBooleanFormula op cp ta) = anns an - op' <- markEpToken op - bf' <- markAnnotated bf - cp' <- markEpToken cp - return (L (an {anns = AnnBooleanFormula op' cp' ta}) bf') - instance ExactPrint [Located HsDocStringChunk] where getAnnotationEntry _ = NoEntryVal setAnnotationAnchor a _ _ _ = a ===================================== utils/haddock/haddock-api/src/Haddock/Types.hs ===================================== @@ -834,7 +834,7 @@ type instance Anno (HsDecl DocNameI) = SrcSpanAnnA type instance Anno (FamilyResultSig DocNameI) = EpAnn NoEpAnns type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA type instance Anno (HsSigType DocNameI) = SrcSpanAnnA -type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF +type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnA type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA type instance Anno (CType DocNameI) = SrcSpanAnnA type instance Anno (Header DocNameI) = SrcSpanAnnA @@ -1041,7 +1041,7 @@ type instance XXHsContextDetails DocNameI = DataConCantHappen type instance XBFVar DocNameI = NoExtField type instance XBFAnd DocNameI = NoExtField type instance XBFOr DocNameI = NoExtField -type instance XBFParens DocNameI = NoExtField +type instance XBFParens DocNameI = (EpToken "(", EpToken ")") type instance XXBooleanFormula DocNameI = DataConCantHappen ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ca87972f6dbcf9440eca80c46f19b71... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ca87972f6dbcf9440eca80c46f19b71... 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