Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC

Commits:

12 changed files:

Changes:

  • compiler/GHC/Builtin/Utils.hs
    ... ... @@ -299,7 +299,7 @@ ghcPrimWarns = WarnSome
    299 299 
       []
    300 300 
       where
    301 301 
         mk_txt msg =
    302 
    -      DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText msg Nothing) []]
    302 
    +      DeprecatedTxt (NoSourceText, noAnn) [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText msg Nothing) []]
    303 303 
         mk_decl_dep (occ, msg) = (occ, mk_txt msg)
    304 304
    305 305 
     ghcPrimFixities :: [(OccName,Fixity)]

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -1162,7 +1162,7 @@ cidDeprecation :: forall p. IsPass p
    1162 1162 
     cidDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    1163 1163 
       where
    1164 1164 
         decl_deprecation :: GhcPass p  -> ClsInstDecl (GhcPass p)
    1165 
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    1165 
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    1166 1166 
         decl_deprecation GhcPs (ClsInstDecl{ cid_ext = (depr, _) } )
    1167 1167 
           = depr
    1168 1168 
         decl_deprecation GhcRn (ClsInstDecl{ cid_ext = depr })
    ... ... @@ -1360,7 +1360,7 @@ derivDeprecation :: forall p. IsPass p
    1360 1360 
     derivDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    1361 1361 
       where
    1362 1362 
         decl_deprecation :: GhcPass p  -> DerivDecl (GhcPass p)
    1363 
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    1363 
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    1364 1364 
         decl_deprecation GhcPs (DerivDecl{ deriv_ext = (depr, _) })
    1365 1365 
           = depr
    1366 1366 
         decl_deprecation GhcRn (DerivDecl{ deriv_ext = (depr, _) })
    ... ... @@ -1701,7 +1701,7 @@ type instance Anno (FunDep (GhcPass p)) = SrcSpanAnnA
    1701 1701 
     type instance Anno (FamilyResultSig (GhcPass p)) = EpAnnCO
    1702 1702 
     type instance Anno (FamilyDecl (GhcPass p)) = SrcSpanAnnA
    1703 1703 
     type instance Anno (InjectivityAnn (GhcPass p)) = EpAnnCO
    1704 
    -type instance Anno (CType (GhcPass p)) = SrcSpanAnnP
    1704 
    +type instance Anno (CType (GhcPass p)) = SrcSpanAnnA
    1705 1705 
     type instance Anno (HsDerivingClause (GhcPass p)) = EpAnnCO
    1706 1706 
     type instance Anno (DerivClauseTys (GhcPass _)) = SrcSpanAnnA
    1707 1707 
     type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA

  • compiler/GHC/Hs/Dump.hs
    ... ... @@ -97,7 +97,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    97 97 
                   `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
    98 98 
                   `ext2Q` located
    99 99 
                   `extQ` srcSpanAnnA
    100 
    -              `extQ` srcSpanAnnP
    101 100 
                   `extQ` srcSpanAnnN
    102 101 
                   `extQ` srcSpanAnnBF
    103 102
    ... ... @@ -404,9 +403,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    404 403 
                 srcSpanAnnA :: EpAnn [TrailingAnn] -> SDoc
    405 404 
                 srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA")
    406 405
    407 
    -            srcSpanAnnP :: EpAnn AnnPragma -> SDoc
    408 
    -            srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP")
    409 
    -
    410 406 
                 srcSpanAnnN :: EpAnn NameAnn -> SDoc
    411 407 
                 srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN")
    412 408

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -83,7 +83,7 @@ import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
    83 83 
     import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
    84 84 
     import GHC.Builtin.Types ( constraintKindTyConName )
    85 85 
     import GHC.Stg.EnforceEpt.TagSig
    86 
    -import GHC.Parser.Annotation (noLocA)
    86 
    +import GHC.Parser.Annotation (noLocA, noAnn)
    87 87 
     import GHC.Hs.Extension ( GhcPass, GhcRn, GhcTc )
    88 88 
     import GHC.Hs.Decls.Overlap ( OverlapFlag )
    89 89 
     import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
    ... ... @@ -664,8 +664,8 @@ fromIfaceWarnings = \case
    664 664
    665 665 
     fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
    666 666 
     fromIfaceWarningTxt = \case
    667 
    -    IfWarningTxt src mb_cat strs -> WarningTxt src (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    668 
    -    IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    667 
    +    IfWarningTxt src mb_cat strs -> WarningTxt (src, noAnn) (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    668 
    +    IfDeprecatedTxt src strs -> DeprecatedTxt (src, noAnn) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    669 669
    670 670 
     fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn
    671 671 
     fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names)

  • compiler/GHC/Iface/Warnings.hs
    ... ... @@ -23,12 +23,11 @@ toIfaceWarnings (WarnSome vs ds) = IfWarnSome vs' ds'
    23 23 
         ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]
    24 24
    25 25 
     toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
    26 
    -toIfaceWarningTxt (WarningTxt src mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    27 
    -toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    26 
    +toIfaceWarningTxt (WarningTxt (src, _) mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    27 
    +toIfaceWarningTxt (DeprecatedTxt (src, _) strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    28 28
    29 29 
     toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
    30 30 
     toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names)
    31 31
    32 32 
     toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral
    33 33 
     toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs
    34 
    -

  • compiler/GHC/Parser.y
    ... ... @@ -1705,15 +1705,17 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs
    1705 1705 
             | type                      { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }
    1706 1706
    1707 1707
    1708 
    -capi_ctype :: { Maybe (LocatedP (CType GhcPs)) }
    1708 
    +capi_ctype :: { Maybe (LocatedA (CType GhcPs)) }
    1709 1709 
     capi_ctype : '{-# CTYPE' STRING STRING '#-}'
    1710 
    -                       {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3) (Just (Header (getSTRINGs $2) (getSTRING $2)))
    1711 
    -                                        (getSTRING $3)))
    1712 
    -                              (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn) }
    1710 
    +                       {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $3)
    1711 
    +                                                                (AnnPragma (glR $1) (epTok $4) noAnn (glR $2) (glR $3) noAnn noAnn)
    1712 
    +                                                                (Just (Header (getSTRINGs $2) (getSTRING $2)))
    1713 
    +                                                                (getSTRING $3)))}
    1713 1714
    1714 1715 
                | '{-# CTYPE'        STRING '#-}'
    1715 
    -                       {% fmap Just $ amsr (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2) Nothing (getSTRING $2)))
    1716 
    -                              (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn) }
    1716 
    +                       {% fmap Just $ amsA' (sLL $1 $> (mkCType (getCTYPEs $1) (getSTRINGs $2)
    1717 
    +                                                                (AnnPragma (glR $1) (epTok $3) noAnn noAnn (glR $2) noAnn noAnn)
    1718 
    +                                                                Nothing (getSTRING $2)))}
    1717 1719
    1718 1720 
                |           { Nothing }
    1719 1721
    ... ... @@ -2073,11 +2075,13 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
    2073 2075
    2074 2076 
     maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
    2075 2077 
             : '{-# DEPRECATED' strings '#-}'
    2076 
    -                            {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
    2077 
    -                                (AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }
    2078 
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    2079 
    +                                DeprecatedTxt (getDEPRECATED_PRAGs $1, AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn)
    2080 
    +                                              (map stringLiteralToHsDocWst $ snd $ unLoc $2))}
    2078 2081 
             | '{-# WARNING' warning_category strings '#-}'
    2079 
    -                            {% fmap Just $ amsr (sLL $1 $> $ WarningTxt (getWARNING_PRAGs $1) $2 (map stringLiteralToHsDocWst $ snd $ unLoc $3))
    2080 
    -                                (AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}
    2082 
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    2083 
    +                                WarningTxt (getWARNING_PRAGs $1, AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)
    2084 
    +                                           $2 (map stringLiteralToHsDocWst $ snd $ unLoc $3))}
    2081 2085 
             |  {- empty -}      { Nothing }
    2082 2086
    2083 2087 
     warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) }
    ... ... @@ -2106,7 +2110,7 @@ warning :: { OrdList (LWarnDecl GhcPs) }
    2106 2110 
             : warning_category namespace_spec namelist strings
    2107 2111 
                     {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)
    2108 2112 
                          (Warning (fst $ unLoc $4) (unLoc $2) (unLoc $3)
    2109 
    -                              (WarningTxt NoSourceText $1 (map stringLiteralToHsDocWst $ snd $ unLoc $4)))) }
    2113 
    +                              (WarningTxt (NoSourceText, noAnn) $1 (map stringLiteralToHsDocWst $ snd $ unLoc $4)))) }
    2110 2114
    2111 2115 
     namespace_spec :: { Located (NamespaceSpecifier GhcPs) }
    2112 2116 
       : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }
    ... ... @@ -2134,7 +2138,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
    2134 2138 
     deprecation :: { OrdList (LWarnDecl GhcPs) }
    2135 2139 
             : namespace_spec namelist strings
    2136 2140 
                  {% fmap unitOL $ amsA' (sL (comb3 $1 $2 $>) $ (Warning (fst $ unLoc $3) (unLoc $1) (unLoc $2)
    2137 
    -                                          (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
    2141 
    +                                          (DeprecatedTxt (NoSourceText, noAnn) $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
    2138 2142
    2139 2143 
     strings :: { Located ((EpToken "[", EpToken "]"),[Located StringLiteral]) }
    2140 2144 
         : STRING             { sL1 $1 (noAnn,[L (gl $1) (getStringLiteral $1)]) }

  • compiler/GHC/Parser/Annotation.hs
    ... ... @@ -27,9 +27,9 @@ module GHC.Parser.Annotation (
    27 27 
       EpAnnCO,
    28 28
    29 29 
       -- ** Annotations in 'GenLocated'
    30 
    -  LocatedA, LocatedN, LocatedAn, LocatedP,
    30 
    +  LocatedA, LocatedN, LocatedAn,
    31 31 
       LocatedE, LocatedBF,
    32 
    -  SrcSpanAnnA, SrcSpanAnnP, SrcSpanAnnN,
    32 
    +  SrcSpanAnnA, SrcSpanAnnN,
    33 33 
       SrcSpanAnnBF,
    34 34
    35 35 
       -- ** Annotation data types used in 'GenLocated'
    ... ... @@ -428,7 +428,6 @@ emptyComments = EpaComments []
    428 428 
     type LocatedA = GenLocated SrcSpanAnnA
    429 429 
     type LocatedN = GenLocated SrcSpanAnnN
    430 430
    431 
    -type LocatedP = GenLocated SrcSpanAnnP
    432 431 
     type LocatedBF = GenLocated SrcSpanAnnBF
    433 432
    434 433 
     -- | Annotation for items appearing in a list. They can have one or
    ... ... @@ -439,7 +438,6 @@ type SrcSpanAnnA = EpAnn [TrailingAnn]
    439 438 
     -- on the context, such as backticks.
    440 439 
     type SrcSpanAnnN = EpAnn NameAnn
    441 440
    442 
    -type SrcSpanAnnP = EpAnn AnnPragma
    443 441 
     type SrcSpanAnnBF = EpAnn AnnBooleanFormula
    444 442
    445 443 
     type LocatedE = GenLocated EpaLocation

  • compiler/GHC/Parser/PostProcess.hs
    ... ... @@ -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)

  • compiler/GHC/Types/ForeignCall.hs
    ... ... @@ -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 . fsLit
    217 
    +  CType (CTypeGhc NoSourceText NoSourceText noAnn) Nothing . fsLit
    217 218
    218 
    -mkCType :: SourceText -> SourceText -> Maybe (Header (GhcPass p)) -> FastString -> CType (GhcPass p)
    219 
    -mkCType x y m =
    220 
    -  CType (CTypeGhc x y) m
    219 
    +mkCType :: SourceText -> SourceText -> AnnPragma -> Maybe (Header (GhcPass p)) -> FastString -> 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
    ... ... @@ -356,6 +358,7 @@ instance Binary CTypeGhc where
    356 358 
           return $ CTypeGhc
    357 359 
             { cTypeSourceText = str1
    358 360 
             , cTypeOtherText  = str2
    361 
    +        , cTypeAnn        = noAnn
    359 362 
             }
    360 363
    361 364 
     instance NFData StaticTargetGhc where

  • compiler/GHC/Unit/Module/Warnings.hs
    ... ... @@ -156,8 +156,8 @@ warningTxtSame w1 w2
    156 156 
     instance Outputable (InWarningCategory (GhcPass pass)) where
    157 157 
       ppr (InWarningCategory _ wt) = text "in" <+> doubleQuotes (ppr wt)
    158 158
    159 
    -type instance XDeprecatedTxt       (GhcPass _) = SourceText
    160 
    -type instance XWarningTxt          (GhcPass _) = SourceText
    159 
    +type instance XDeprecatedTxt       (GhcPass _) = (SourceText, AnnPragma)
    160 
    +type instance XWarningTxt          (GhcPass _) = (SourceText, AnnPragma)
    161 161 
     type instance XXWarningTxt         (GhcPass _) = DataConCantHappen
    162 162 
     type instance XInWarningCategory   (GhcPass _) = (EpToken "in", SourceText)
    163 163 
     type instance XXInWarningCategory  (GhcPass _) = DataConCantHappen
    ... ... @@ -165,7 +165,7 @@ type instance XXInWarningCategory (GhcPass _) = DataConCantHappen
    165 165 
     type instance Anno (WithHsDocIdentifiers StringLiteral pass) = EpaLocation
    166 166 
     type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation
    167 167 
     type instance Anno (WarningCategory) = EpaLocation
    168 
    -type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
    168 
    +type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnA
    169 169
    170 170 
     deriving stock instance Eq (WarningTxt GhcPs)
    171 171 
     deriving stock instance Eq (WarningTxt GhcRn)
    ... ... @@ -190,15 +190,15 @@ deriving instance Uniquable WarningCategory
    190 190 
     instance Outputable (WarningTxt (GhcPass pass)) where
    191 191 
         ppr (WarningTxt lsrc mcat ws)
    192 192 
           = case lsrc of
    193 
    -            NoSourceText   -> pp_ws ws
    194 
    -            SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    193 
    +            (NoSourceText, _)   -> pp_ws ws
    194 
    +            (SourceText src, _) -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    195 195 
             where
    196 196 
               ctg_doc = maybe empty (\ctg -> ppr ctg) mcat
    197 197
    198 198 
         ppr (DeprecatedTxt lsrc ds)
    199 199 
           = case lsrc of
    200 
    -          NoSourceText   -> pp_ws ds
    201 
    -          SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
    200 
    +          (NoSourceText, _)   -> pp_ws ds
    201 
    +          (SourceText src, _) -> ftext src <+> pp_ws ds <+> text "#-}"
    202 202
    203 203 
     pp_ws :: [LocatedE (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
    204 204 
     pp_ws [l] = ppr $ unLoc l

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -1558,26 +1558,26 @@ instance ExactPrint ModuleName where
    1558 1558
    1559 1559 
     -- ---------------------------------------------------------------------
    1560 1560
    1561 
    -instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
    1562 
    -  getAnnotationEntry = entryFromLocatedA
    1563 
    -  setAnnotationAnchor = setAnchorAn
    1561 
    +instance ExactPrint (WarningTxt GhcPs) where
    1562 
    +  getAnnotationEntry _ = NoEntryVal
    1563 
    +  setAnnotationAnchor a _ _ _ = a
    1564 1564
    1565 
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (WarningTxt src mb_cat ws)) = do
    1565 
    +  exact (WarningTxt (src, AnnPragma o c (os,cs) l1 l2 t m) mb_cat ws) = do
    1566 1566 
         o' <- markAnnOpen'' o src "{-# WARNING"
    1567 1567 
         mb_cat' <- markAnnotated mb_cat
    1568 1568 
         os' <- markEpToken os
    1569 1569 
         ws' <- mapM markAnnotated ws
    1570 1570 
         cs' <- markEpToken cs
    1571 1571 
         c' <- markEpToken c
    1572 
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt src mb_cat' ws'))
    1572 
    +    return (WarningTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) mb_cat' ws')
    1573 1573
    1574 
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (DeprecatedTxt src ws)) = do
    1574 
    +  exact (DeprecatedTxt (src, AnnPragma o c (os,cs) l1 l2 t m) ws) = do
    1575 1575 
         o' <- markAnnOpen'' o src "{-# DEPRECATED"
    1576 1576 
         os' <- markEpToken os
    1577 1577 
         ws' <- mapM markAnnotated ws
    1578 1578 
         cs' <- markEpToken cs
    1579 1579 
         c' <- markEpToken c
    1580 
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))
    1580 
    +    return (DeprecatedTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) ws')
    1581 1581
    1582 1582 
     instance Typeable p => ExactPrint (InWarningCategory (GhcPass p)) where
    1583 1583 
       getAnnotationEntry _ = NoEntryVal
    ... ... @@ -4407,13 +4407,14 @@ instance ExactPrint t => ExactPrint (HsModifierOf t GhcPs) where
    4407 4407
    4408 4408 
     -- ---------------------------------------------------------------------
    4409 4409
    4410 
    -instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where
    4411 
    -  getAnnotationEntry = entryFromLocatedA
    4412 
    -  setAnnotationAnchor = setAnchorAn
    4410 
    +instance Typeable p => ExactPrint (CType (GhcPass p)) where
    4411 
    +  getAnnotationEntry _ = NoEntryVal
    4412 
    +  setAnnotationAnchor a _ _ _ = a
    4413 4413
    4414 
    -  exact (L (EpAnn l (AnnPragma o c s l1 l2 t m) cs) (CType ext mh ct)) = do
    4414 
    +  exact (CType ext mh ct) = do
    4415 4415 
         let stp  = cTypeSourceText ext
    4416 4416 
             stct = cTypeOtherText  ext
    4417 
    +        AnnPragma o c s l1 l2 t m = cTypeAnn ext
    4417 4418 
         o' <- markAnnOpen'' o stp "{-# CTYPE"
    4418 4419 
         l1' <- case mh of
    4419 4420 
                  Nothing -> return l1
    ... ... @@ -4421,7 +4422,7 @@ instance Typeable p => ExactPrint (LocatedP (CType (GhcPass p))) where
    4421 4422 
                    printStringAtAA l1 (toSourceTextWithSuffix srcH "" "")
    4422 4423 
         l2' <- printStringAtAA l2 (toSourceTextWithSuffix stct (unpackFS ct) "")
    4423 4424 
         c' <- markEpToken c
    4424 
    -    return (L (EpAnn l (AnnPragma o' c' s l1' l2' t m) cs) (CType ext mh ct))
    4425 
    +    return (CType (ext { cTypeAnn = AnnPragma o' c' s l1' l2' t m }) mh ct)
    4425 4426
    4426 4427 
     -- ---------------------------------------------------------------------
    4427 4428

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

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help