Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
d415f38a
by Alan Zimmerman at 2026-08-02T22:47:27-04:00
6 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Types/ForeignCall.hs
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
| ... | ... | @@ -1583,7 +1583,7 @@ type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA |
| 1583 | 1583 | type instance Anno (FamilyResultSig (GhcPass p)) = EpAnnCO
|
| 1584 | 1584 | type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA
|
| 1585 | 1585 | type instance Anno (InjectivityAnn (GhcPass p)) = EpAnnCO
|
| 1586 | -type instance Anno (CType (GhcPass p)) = SrcSpanAnnP
|
|
| 1586 | +type instance Anno (CType (GhcPass p)) = SrcSpanAnnA
|
|
| 1587 | 1587 | type instance Anno (HsDerivingClause (GhcPass p)) = EpAnnCO
|
| 1588 | 1588 | type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnA
|
| 1589 | 1589 | type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA
|
| ... | ... | @@ -1707,15 +1707,17 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs |
| 1707 | 1707 | | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }
|
| 1708 | 1708 | |
| 1709 | 1709 | |
| 1710 | -capi_ctype :: { Maybe (LocatedP (CType GhcPs)) }
|
|
| 1710 | +capi_ctype :: { Maybe (LocatedA (CType GhcPs)) }
|
|
| 1711 | 1711 | capi_ctype : '{-# CTYPE' STRING STRING '#-}'
|
| 1712 | - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) (Just (Header (getSTRINGs $2) (getSTRING $2)))
|
|
| 1713 | - (getSTRING $3)))
|
|
| 1714 | - (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) }
|
|
| 1712 | + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3)
|
|
| 1713 | + (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn)
|
|
| 1714 | + (Just (Header (getSTRINGs $2) (getSTRING $2)))
|
|
| 1715 | + (getSTRING $3)))}
|
|
| 1715 | 1716 | |
| 1716 | 1717 | | '{-# CTYPE' STRING '#-}'
|
| 1717 | - {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) Nothing (getSTRING $2)))
|
|
| 1718 | - (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) }
|
|
| 1718 | + {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2)
|
|
| 1719 | + (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn)
|
|
| 1720 | + Nothing (getSTRING $2)))}
|
|
| 1719 | 1721 | |
| 1720 | 1722 | | { Nothing }
|
| 1721 | 1723 |
| ... | ... | @@ -229,7 +229,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn |
| 229 | 229 | mkTyData :: SrcSpan
|
| 230 | 230 | -> Bool
|
| 231 | 231 | -> NewOrData
|
| 232 | - -> Maybe (LocatedP (CType GhcPs))
|
|
| 232 | + -> Maybe (LocatedA (CType GhcPs))
|
|
| 233 | 233 | -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
|
| 234 | 234 | -> Maybe (LHsKind GhcPs)
|
| 235 | 235 | -> [LConDecl GhcPs]
|
| ... | ... | @@ -251,7 +251,7 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr)) |
| 251 | 251 | tcdDataDefn = defn,
|
| 252 | 252 | tcdModifiers = [] })) }
|
| 253 | 253 | |
| 254 | -mkDataDefn :: Maybe (LocatedP (CType GhcPs))
|
|
| 254 | +mkDataDefn :: Maybe (LocatedA (CType GhcPs))
|
|
| 255 | 255 | -> Maybe (LHsContext GhcPs)
|
| 256 | 256 | -> Maybe (LHsKind GhcPs)
|
| 257 | 257 | -> DataDefnCons (LConDecl GhcPs)
|
| ... | ... | @@ -326,7 +326,7 @@ mkTyFamInstEqn loc bndrs lhs rhs annEq |
| 326 | 326 | |
| 327 | 327 | mkDataFamInst :: SrcSpan
|
| 328 | 328 | -> NewOrData
|
| 329 | - -> Maybe (LocatedP (CType GhcPs))
|
|
| 329 | + -> Maybe (LocatedA (CType GhcPs))
|
|
| 330 | 330 | -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs
|
| 331 | 331 | , LHsType GhcPs)
|
| 332 | 332 | -> Maybe (LHsKind GhcPs)
|
| ... | ... | @@ -109,6 +109,7 @@ import Data.Data (Data) |
| 109 | 109 | import Data.Functor ((<&>))
|
| 110 | 110 | |
| 111 | 111 | import Control.DeepSeq (NFData(..))
|
| 112 | +import GHC.Parser.Annotation (AnnPragma, noAnn)
|
|
| 112 | 113 | |
| 113 | 114 | {-
|
| 114 | 115 | ************************************************************************
|
| ... | ... | @@ -213,11 +214,11 @@ instance Outputable CCallSpec where |
| 213 | 214 | |
| 214 | 215 | defaultCType :: String -> CType (GhcPass p)
|
| 215 | 216 | defaultCType =
|
| 216 | - CType (CTypeGhc NoSourceText NoSourceText) Nothing . packHText
|
|
| 217 | + CType (CTypeGhc NoSourceText NoSourceText noAnn) Nothing . packHText
|
|
| 217 | 218 | |
| 218 | -mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p)
|
|
| 219 | -mkCType x y m =
|
|
| 220 | - CType (CTypeGhc x y) m
|
|
| 219 | +mkCType :: SourceText -> SourceText -> AnnPragma -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p)
|
|
| 220 | +mkCType x y ann m =
|
|
| 221 | + CType (CTypeGhc x y ann) m
|
|
| 221 | 222 | |
| 222 | 223 | typeCheckCType :: CType GhcRn -> CType GhcTc
|
| 223 | 224 | typeCheckCType (CType x y z) = CType x (typeCheckHeader <$> y) z
|
| ... | ... | @@ -302,6 +303,7 @@ data StaticTargetGhc = StaticTargetGhc |
| 302 | 303 | data CTypeGhc = CTypeGhc
|
| 303 | 304 | { cTypeSourceText :: SourceText
|
| 304 | 305 | , cTypeOtherText :: SourceText
|
| 306 | + , cTypeAnn :: AnnPragma
|
|
| 305 | 307 | }
|
| 306 | 308 | deriving (Data, Eq)
|
| 307 | 309 | |
| ... | ... | @@ -349,6 +351,7 @@ instance Binary CTypeGhc where |
| 349 | 351 | return $ CTypeGhc
|
| 350 | 352 | { cTypeSourceText = str1
|
| 351 | 353 | , cTypeOtherText = str2
|
| 354 | + , cTypeAnn = noAnn
|
|
| 352 | 355 | }
|
| 353 | 356 | |
| 354 | 357 | instance NFData StaticTargetGhc where
|
| ... | ... | @@ -4401,13 +4401,14 @@ instance ExactPrint t => ExactPrint (HsModifierOf t GhcPs) where |
| 4401 | 4401 | |
| 4402 | 4402 | -- ---------------------------------------------------------------------
|
| 4403 | 4403 | |
| 4404 | -instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where
|
|
| 4405 | - getAnnotationEntry = entryFromLocatedA
|
|
| 4406 | - setAnnotationAnchor = setAnchorAn
|
|
| 4404 | +instance Typeable p => ExactPrint (CType (GhcPass p)) where
|
|
| 4405 | + getAnnotationEntry _ = NoEntryVal
|
|
| 4406 | + setAnnotationAnchor a _ _ _ = a
|
|
| 4407 | 4407 | |
| 4408 | - exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (CType ext mh ct)) = do
|
|
| 4408 | + exact (CType ext mh ct) = do
|
|
| 4409 | 4409 | let stp = cTypeSourceText ext
|
| 4410 | 4410 | stct = cTypeOtherText ext
|
| 4411 | + AnnPragma o c s l1 l2 t m = cTypeAnn ext
|
|
| 4411 | 4412 | o' <- markAnnOpen'' o stp "{-# CTYPE"
|
| 4412 | 4413 | l1' <- case mh of
|
| 4413 | 4414 | Nothing -> return l1
|
| ... | ... | @@ -4415,7 +4416,7 @@ instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where |
| 4415 | 4416 | printStringAtAA l1 (toSourceTextWithSuffix srcH "" "")
|
| 4416 | 4417 | l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackHText ct) "")
|
| 4417 | 4418 | c' <- markEpToken c
|
| 4418 | - return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType ext mh ct))
|
|
| 4419 | + return (CType (ext { cTypeAnn = AnnPragma o' c' s l1' l2' t m }) mh ct)
|
|
| 4419 | 4420 | |
| 4420 | 4421 | -- ---------------------------------------------------------------------
|
| 4421 | 4422 |
| ... | ... | @@ -837,7 +837,7 @@ type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA |
| 837 | 837 | type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
|
| 838 | 838 | type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF
|
| 839 | 839 | type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA
|
| 840 | -type instance Anno (CType DocNameI) = EpAnn AnnPragma
|
|
| 840 | +type instance Anno (CType DocNameI) = SrcSpanAnnA
|
|
| 841 | 841 | type instance Anno (Header DocNameI) = EpAnn AnnPragma
|
| 842 | 842 | type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA
|
| 843 | 843 | type instance Anno (HsContextDetails DocNameI a) = SrcSpanAnnA
|