[Git][ghc/ghc][master] EPA: Remove LocatedP from CType

3 Aug 2026


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


Commits:
d415f38a by Alan Zimmerman at 2026-08-02T22:47:27-04:00
EPA: Remove LocatedP from CType

The next step of removing use of LocatedP by moving
the AnnPragma for CType into its TTG extension point
instead.

- - - - -


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:

=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -1583,7 +1583,7 @@ type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA
 type instance Anno (FamilyResultSig (GhcPass p)) = EpAnnCO
 type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA
 type instance Anno (InjectivityAnn (GhcPass p)) = EpAnnCO
-type instance Anno (CType (GhcPass p)) = SrcSpanAnnP
+type instance Anno (CType (GhcPass p)) = SrcSpanAnnA
 type instance Anno (HsDerivingClause (GhcPass p)) = EpAnnCO
 type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnA
 type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA


=====================================
compiler/GHC/Parser.y
=====================================
@@ -1707,15 +1707,17 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs
         | type                      { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }
 
 
-capi_ctype :: { Maybe (LocatedP (CType GhcPs)) }
+capi_ctype :: { Maybe (LocatedA (CType GhcPs)) }
 capi_ctype : '{-# CTYPE' STRING STRING '#-}'
-                       {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) (Just (Header (getSTRINGs $2) (getSTRING $2)))
-                                        (getSTRING $3)))
-                              (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) }
+                       {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3)
+                                                                (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn)
+                                                                (Just (Header (getSTRINGs $2) (getSTRING $2)))
+                                                                (getSTRING $3)))}
 
            | '{-# CTYPE'        STRING '#-}'
-                       {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) Nothing (getSTRING $2)))
-                              (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) }
+                       {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2)
+                                                                (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn)
+                                                                Nothing (getSTRING $2)))}
 
            |           { Nothing }
 


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -229,7 +229,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn
 mkTyData :: SrcSpan
          -> Bool
          -> NewOrData
-         -> Maybe (LocatedP (CType GhcPs))
+         -> Maybe (LocatedA (CType GhcPs))
          -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
          -> Maybe (LHsKind GhcPs)
          -> [LConDecl GhcPs]
@@ -251,7 +251,7 @@ mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr))
                                    tcdDataDefn = defn,
                                    tcdModifiers = [] })) }
 
-mkDataDefn :: Maybe (LocatedP (CType GhcPs))
+mkDataDefn :: Maybe (LocatedA (CType GhcPs))
            -> Maybe (LHsContext GhcPs)
            -> Maybe (LHsKind GhcPs)
            -> DataDefnCons (LConDecl GhcPs)
@@ -326,7 +326,7 @@ mkTyFamInstEqn loc bndrs lhs rhs annEq
 
 mkDataFamInst :: SrcSpan
               -> NewOrData
-              -> Maybe (LocatedP (CType GhcPs))
+              -> Maybe (LocatedA (CType GhcPs))
               -> (Maybe ( LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs
                         , LHsType GhcPs)
               -> Maybe (LHsKind GhcPs)


=====================================
compiler/GHC/Types/ForeignCall.hs
=====================================
@@ -109,6 +109,7 @@ import Data.Data (Data)
 import Data.Functor ((<&>))
 
 import Control.DeepSeq (NFData(..))
+import GHC.Parser.Annotation (AnnPragma, noAnn)
 
 {-
 ************************************************************************
@@ -213,11 +214,11 @@ instance Outputable CCallSpec where
 
 defaultCType :: String -> CType (GhcPass p)
 defaultCType =
-  CType (CTypeGhc NoSourceText NoSourceText) Nothing . packHText
+  CType (CTypeGhc NoSourceText NoSourceText noAnn) Nothing . packHText
 
-mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p)
-mkCType x y m =
-  CType (CTypeGhc x y) m
+mkCType :: SourceText -> SourceText -> AnnPragma -> Maybe (Header (GhcPass p)) -> HText -> CType (GhcPass p)
+mkCType x y ann m =
+  CType (CTypeGhc x y ann) m
 
 typeCheckCType :: CType GhcRn -> CType GhcTc
 typeCheckCType (CType x y z) = CType x (typeCheckHeader <$> y) z
@@ -302,6 +303,7 @@ data StaticTargetGhc = StaticTargetGhc
 data CTypeGhc = CTypeGhc
   { cTypeSourceText :: SourceText
   , cTypeOtherText  :: SourceText
+  , cTypeAnn        :: AnnPragma
   }
   deriving (Data, Eq)
 
@@ -349,6 +351,7 @@ instance Binary CTypeGhc where
       return $ CTypeGhc
         { cTypeSourceText = str1
         , cTypeOtherText  = str2
+        , cTypeAnn        = noAnn
         }
 
 instance NFData StaticTargetGhc where


=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -4401,13 +4401,14 @@ instance ExactPrint t => ExactPrint (HsModifierOf t GhcPs) where
 
 -- ---------------------------------------------------------------------
 
-instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where
-  getAnnotationEntry = entryFromLocatedA
-  setAnnotationAnchor = setAnchorAn
+instance Typeable p => ExactPrint (CType (GhcPass p)) where
+  getAnnotationEntry _ = NoEntryVal
+  setAnnotationAnchor a _ _ _ = a
 
-  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (CType ext mh ct)) = do
+  exact (CType ext mh ct) = do
     let stp  = cTypeSourceText ext
         stct = cTypeOtherText  ext
+        AnnPragma o c s l1 l2 t m = cTypeAnn ext
     o' <- markAnnOpen'' o stp "{-# CTYPE"
     l1' <- case mh of
              Nothing -> return l1
@@ -4415,7 +4416,7 @@ instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where
                printStringAtAA l1 (toSourceTextWithSuffix srcH "" "")
     l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackHText ct) "")
     c' <- markEpToken c
-    return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType ext mh ct))
+    return (CType (ext { cTypeAnn = AnnPragma o' c' s l1' l2' t m }) mh ct)
 
 -- ---------------------------------------------------------------------
 


=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -837,7 +837,7 @@ type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA
 type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
 type instance Anno (BooleanFormula DocNameI) = SrcSpanAnnBF
 type instance Anno (OverlapMode DocNameI) = SrcSpanAnnA
-type instance Anno (CType DocNameI) = EpAnn AnnPragma
+type instance Anno (CType DocNameI) = SrcSpanAnnA
 type instance Anno (Header DocNameI) = EpAnn AnnPragma
 type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA
 type instance Anno (HsContextDetails DocNameI a) = SrcSpanAnnA



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d415f38a75cc88921a344220ad2eed0e...
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

    

Marge Bot (＠marge-bot)

tags

participants (1)