Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • ghc/ghc
  • bgamari/ghc
  • syd/ghc
  • ggreif/ghc
  • watashi/ghc
  • RolandSenn/ghc
  • mpickering/ghc
  • DavidEichmann/ghc
  • carter/ghc
  • harpocrates/ghc
  • ethercrow/ghc
  • mijicd/ghc
  • adamse/ghc
  • alexbiehl/ghc
  • gridaphobe/ghc
  • trofi/ghc
  • supersven/ghc
  • ppk/ghc
  • ulysses4ever/ghc
  • AndreasK/ghc
  • ghuntley/ghc
  • shayne-fletcher-da/ghc
  • fgaz/ghc
  • yav/ghc
  • osa1/ghc
  • mbbx6spp/ghc
  • JulianLeviston/ghc
  • reactormonk/ghc
  • rae/ghc
  • takenobu-hs/ghc
  • michalt/ghc
  • andrewthad/ghc
  • hsyl20/ghc
  • scottgw/ghc
  • sjakobi/ghc
  • angerman/ghc
  • RyanGlScott/ghc
  • hvr/ghc
  • howtonotwin/ghc
  • chessai/ghc
  • m-renaud/ghc
  • brprice/ghc
  • stevehartdata/ghc
  • sighingnow/ghc
  • kgardas/ghc
  • ckoparkar/ghc
  • alp/ghc
  • smaeul/ghc
  • kakkun61/ghc
  • sykloid/ghc
  • newhoggy/ghc
  • toonn/ghc
  • nineonine/ghc
  • Phyx/ghc
  • ezyang/ghc
  • tweag/ghc
  • langston/ghc
  • ndmitchell/ghc
  • rockbmb/ghc
  • artempyanykh/ghc
  • mniip/ghc
  • mynguyenbmc/ghc
  • alexfmpe/ghc
  • crockeea/ghc
  • nh2/ghc
  • vaibhavsagar/ghc
  • phadej/ghc
  • Haskell-mouse/ghc
  • lolotp/ghc
  • spacekitteh/ghc
  • michaelpj/ghc
  • mgsloan/ghc
  • HPCohen/ghc
  • tmobile/ghc
  • radrow/ghc
  • simonmar/ghc
  • _deepfire/ghc
  • Ericson2314/ghc
  • leitao/ghc
  • fumieval/ghc
  • trac-isovector/ghc
  • cblp/ghc
  • xich/ghc
  • ciil/ghc
  • erthalion/ghc
  • xldenis/ghc
  • autotaker/ghc
  • haskell-wasm/ghc
  • kcsongor/ghc
  • agander/ghc
  • Baranowski/ghc
  • trac-dredozubov/ghc
  • 23Skidoo/ghc
  • iustin/ghc
  • ningning/ghc
  • josefs/ghc
  • kabuhr/ghc
  • gallais/ghc
  • dten/ghc
  • expipiplus1/ghc
  • Pluralia/ghc
  • rohanjr/ghc
  • intricate/ghc
  • kirelagin/ghc
  • Javran/ghc
  • DanielG/ghc
  • trac-mizunashi_mana/ghc
  • pparkkin/ghc
  • bollu/ghc
  • ntc2/ghc
  • jaspervdj/ghc
  • JoshMeredith/ghc
  • wz1000/ghc
  • zkourouma/ghc
  • code5hot/ghc
  • jdprice/ghc
  • tdammers/ghc
  • J-mie6/ghc
  • trac-lantti/ghc
  • ch1bo/ghc
  • cgohla/ghc
  • lucamolteni/ghc
  • acairncross/ghc
  • amerocu/ghc
  • chreekat/ghc
  • txsmith/ghc
  • trupill/ghc
  • typetetris/ghc
  • sergv/ghc
  • fryguybob/ghc
  • erikd/ghc
  • trac-roland/ghc
  • setupminimal/ghc
  • Friede80/ghc
  • SkyWriter/ghc
  • xplorld/ghc
  • abrar/ghc
  • obsidiansystems/ghc
  • Icelandjack/ghc
  • adinapoli/ghc
  • trac-matthewbauer/ghc
  • heatsink/ghc
  • dwijnand/ghc
  • Cmdv/ghc
  • alinab/ghc
  • pepeiborra/ghc
  • fommil/ghc
  • luochen1990/ghc
  • rlupton20/ghc
  • applePrincess/ghc
  • lehins/ghc
  • ronmrdechai/ghc
  • leeadam/ghc
  • harendra/ghc
  • mightymosquito1991/ghc
  • trac-gershomb/ghc
  • lucajulian/ghc
  • Rizary/ghc
  • VictorCMiraldo/ghc
  • jamesbrock/ghc
  • andrewdmeier/ghc
  • luke/ghc
  • pranaysashank/ghc
  • cocreature/ghc
  • hithroc/ghc
  • obreitwi/ghc
  • slrtbtfs/ghc
  • kaol/ghc
  • yairchu/ghc
  • Mathemagician98/ghc
  • trac-taylorfausak/ghc
  • leungbk/ghc
  • MichaWiedenmann/ghc
  • chris-martin/ghc
  • TDecki/ghc
  • adithyaov/ghc
  • trac-gelisam/ghc
  • Lysxia/ghc
  • complyue/ghc
  • bwignall/ghc
  • sternmull/ghc
  • sonika/ghc
  • leif/ghc
  • broadwaylamb/ghc
  • myszon/ghc
  • danbroooks/ghc
  • Mechachleopteryx/ghc
  • zardyh/ghc
  • trac-vdukhovni/ghc
  • OmarKhaledAbdo/ghc
  • arrowd/ghc
  • Bodigrim/ghc
  • matheus23/ghc
  • cardenaso11/ghc
  • trac-Athas/ghc
  • mb720/ghc
  • DylanZA/ghc
  • liff/ghc
  • typedrat/ghc
  • trac-claude/ghc
  • jbm/ghc
  • Gertjan423/ghc
  • PHO/ghc
  • JKTKops/ghc
  • kockahonza/ghc
  • msakai/ghc
  • Sir4ur0n/ghc
  • barambani/ghc
  • vishnu.c/ghc
  • dcoutts/ghc
  • trac-runeks/ghc
  • trac-MaxGabriel/ghc
  • lexi.lambda/ghc
  • strake/ghc
  • spavikevik/ghc
  • JakobBruenker/ghc
  • rmanne/ghc
  • gdziadkiewicz/ghc
  • ani/ghc
  • iliastsi/ghc
  • smunix/ghc
  • judah/ghc
  • blackgnezdo/ghc
  • emilypi/ghc
  • trac-bpfoley/ghc
  • muesli4/ghc
  • trac-gkaracha/ghc
  • Kleidukos/ghc
  • nek0/ghc
  • TristanCacqueray/ghc
  • dwulive/ghc
  • mbakke/ghc
  • arybczak/ghc
  • Yang123321/ghc
  • maksbotan/ghc
  • QuietMisdreavus/ghc
  • trac-olshanskydr/ghc
  • emekoi/ghc
  • samuela/ghc
  • josephcsible/ghc
  • dramforever/ghc
  • lpsmith/ghc
  • DenisFrezzato/ghc
  • michivi/ghc
  • jneira/ghc
  • jeffhappily/ghc
  • Ivan-Yudin/ghc
  • nakaji-dayo/ghc
  • gdevanla/ghc
  • galen/ghc
  • fendor/ghc
  • yaitskov/ghc
  • rcythr/ghc
  • awpr/ghc
  • jeremyschlatter/ghc
  • Aver1y/ghc
  • mitchellvitez/ghc
  • merijn/ghc
  • tomjaguarpaw1/ghc
  • trac-NoidedSuper/ghc
  • erewok/ghc
  • trac-junji.hashimoto/ghc
  • adamwespiser/ghc
  • bjaress/ghc
  • jhrcek/ghc
  • leonschoorl/ghc
  • lukasz-golebiewski/ghc
  • sheaf/ghc
  • last-g/ghc
  • carassius1014/ghc
  • eschwartz/ghc
  • dwincort/ghc
  • felixwiemuth/ghc
  • TimWSpence/ghc
  • marcusmonteirodesouza/ghc
  • WJWH/ghc
  • vtols/ghc
  • theobat/ghc
  • BinderDavid/ghc
  • ckoparkar0/ghc
  • alexander-kjeldaas/ghc
  • dme2/ghc
  • philderbeast/ghc
  • aaronallen8455/ghc
  • rayshih/ghc
  • benkard/ghc
  • mpardalos/ghc
  • saidelman/ghc
  • leiftw/ghc
  • ca333/ghc
  • bwroga/ghc
  • nmichael44/ghc
  • trac-crobbins/ghc
  • felixonmars/ghc
  • adityagupta1089/ghc
  • hgsipiere/ghc
  • treeowl/ghc
  • alexpeits/ghc
  • CraigFe/ghc
  • dnlkrgr/ghc
  • kerckhove_ts/ghc
  • cptwunderlich/ghc
  • eiais/ghc
  • hahohihu/ghc
  • sanchayan/ghc
  • lemmih/ghc
  • sehqlr/ghc
  • trac-dbeacham/ghc
  • luite/ghc
  • trac-f-a/ghc
  • vados/ghc
  • luntain/ghc
  • fatho/ghc
  • alexbiehl-gc/ghc
  • dcbdan/ghc
  • tvh/ghc
  • liam-ly/ghc
  • timbobbarnes/ghc
  • GovanifY/ghc
  • shanth2600/ghc
  • gliboc/ghc
  • duog/ghc
  • moxonsghost/ghc
  • zander/ghc
  • masaeedu/ghc
  • georgefst/ghc
  • guibou/ghc
  • nicuveo/ghc
  • mdebruijne/ghc
  • stjordanis/ghc
  • emiflake/ghc
  • wygulmage/ghc
  • frasertweedale/ghc
  • coot/ghc
  • aratamizuki/ghc
  • tsandstr/ghc
  • mrBliss/ghc
  • Anton-Latukha/ghc
  • tadfisher/ghc
  • vapourismo/ghc
  • Sorokin-Anton/ghc
  • basile-henry/ghc
  • trac-mightybyte/ghc
  • AbsoluteNikola/ghc
  • cobrien99/ghc
  • songzh/ghc
  • blamario/ghc
  • aj4ayushjain/ghc
  • trac-utdemir/ghc
  • tangcl/ghc
  • hdgarrood/ghc
  • maerwald/ghc
  • arjun/ghc
  • ratherforky/ghc
  • haskieLambda/ghc
  • EmilGedda/ghc
  • Bogicevic/ghc
  • eddiejessup/ghc
  • kozross/ghc
  • AlistairB/ghc
  • 3Rafal/ghc
  • christiaanb/ghc
  • trac-bit/ghc
  • matsumonkie/ghc
  • trac-parsonsmatt/ghc
  • chisui/ghc
  • jaro/ghc
  • trac-kmiyazato/ghc
  • davidsd/ghc
  • Tritlo/ghc
  • I-B-3/ghc
  • lykahb/ghc
  • AriFordsham/ghc
  • turion1/ghc
  • berberman/ghc
  • christiantakle/ghc
  • zyklotomic/ghc
  • trac-ocramz/ghc
  • CSEdd/ghc
  • doyougnu/ghc
  • mmhat/ghc
  • why-not-try-calmer/ghc
  • plutotulp/ghc
  • kjekac/ghc
  • Manvi07/ghc
  • teo/ghc
  • cactus/ghc
  • CarrieMY/ghc
  • abel/ghc
  • yihming/ghc
  • tsakki/ghc
  • jessicah/ghc
  • oliverbunting/ghc
  • meld/ghc
  • friedbrice/ghc
  • Joald/ghc
  • abarbu/ghc
  • DigitalBrains1/ghc
  • sterni/ghc
  • alexDarcy/ghc
  • hexchain/ghc
  • minimario/ghc
  • zliu41/ghc
  • tommd/ghc
  • jazcarate/ghc
  • peterbecich/ghc
  • alirezaghey/ghc
  • solomon/ghc
  • mikael.urankar/ghc
  • davjam/ghc
  • int-index/ghc
  • MorrowM/ghc
  • nrnrnr/ghc
  • Sonfamm/ghc-test-only
  • afzt1/ghc
  • nguyenhaibinh-tpc/ghc
  • trac-lierdakil/ghc
  • MichaWiedenmann1/ghc
  • jmorag/ghc
  • Ziharrk/ghc
  • trac-MitchellSalad/ghc
  • juampe/ghc
  • jwaldmann/ghc
  • snowleopard/ghc
  • juhp/ghc
  • normalcoder/ghc
  • ksqsf/ghc
  • trac-jberryman/ghc
  • roberth/ghc
  • 1ntEgr8/ghc
  • epworth/ghc
  • MrAdityaAlok/ghc
  • JunmingZhao42/ghc
  • jappeace/ghc
  • trac-Gabriel439/ghc
  • alt-romes/ghc
  • HugoPeters1024/ghc
  • 10ne1/ghc-fork
  • agentultra/ghc
  • Garfield1002/ghc
  • ChickenProp/ghc
  • clyring/ghc
  • MaxHearnden/ghc
  • jumper149/ghc
  • vem/ghc
  • ketzacoatl/ghc
  • Rosuavio/ghc
  • jackohughes/ghc
  • p4l1ly/ghc
  • konsumlamm/ghc
  • shlevy/ghc
  • torsten.schmits/ghc
  • andremarianiello/ghc
  • amesgen/ghc
  • googleson78/ghc
  • InfiniteVerma/ghc
  • uhbif19/ghc
  • yiyunliu/ghc
  • raehik/ghc
  • mrkun/ghc
  • telser/ghc
  • 1Jajen1/ghc
  • slotThe/ghc
  • WinstonHartnett/ghc
  • mpilgrem/ghc
  • dreamsmasher/ghc
  • schuelermine/ghc
  • trac-Viwor/ghc
  • undergroundquizscene/ghc
  • evertedsphere/ghc
  • coltenwebb/ghc
  • oberblastmeister/ghc
  • agrue/ghc
  • lf-/ghc
  • zacwood9/ghc
  • steshaw/ghc
  • high-cloud/ghc
  • SkamDart/ghc
  • PiDelport/ghc
  • maoif/ghc
  • RossPaterson/ghc
  • CharlesTaylor7/ghc
  • ribosomerocker/ghc
  • trac-ramirez7/ghc
  • daig/ghc
  • NicolasT/ghc
  • FinleyMcIlwaine/ghc
  • lawtonnichols/ghc
  • jmtd/ghc
  • ozkutuk/ghc
  • wildsebastian/ghc
  • lrzlin/ghc
  • tobias/ghc
  • fw/ghc
  • hawkinsw/ghc
  • type-dance/ghc
  • rui314/ghc
  • ocharles/ghc
  • wavewave/ghc
  • TheKK/ghc
  • nomeata/ghc
  • trac-csabahruska/ghc
  • jonathanjameswatson/ghc
  • L-as/ghc
  • Axman6/ghc
  • barracuda156/ghc
  • trac-jship/ghc
  • jake-87/ghc
  • meooow/ghc
  • rebeccat/ghc
  • hamana55/ghc
  • Enigmage/ghc
  • kokobd/ghc
  • agevelt/ghc
  • gshen42/ghc
  • chrismwendt/ghc
  • MangoIV/ghc
  • teto/ghc
  • Sookr1/ghc
  • trac-thomasjm/ghc
  • barci2/ghc-dev
  • trac-m4dc4p/ghc
  • dixonary/ghc
  • breakerzirconia/ghc
  • alexsio27444/ghc
  • glocq/ghc
  • sourabhxyz/ghc
  • ryantrinkle/ghc
  • Jade/ghc
  • scedfaliako/ghc
  • martijnbastiaan/ghc
  • trac-george.colpitts/ghc
  • ammarbinfaisal/ghc
  • mimi.vx/ghc
  • lortabac/ghc
  • trac-zyla/ghc
  • benbellick/ghc
  • aadaa-fgtaa/ghc
  • jvanbruegge/ghc
  • archbung/ghc
  • gilmi/ghc
  • mfonism/ghc
  • alex-mckenna/ghc
  • Ei30metry/ghc
  • DiegoDiverio/ghc
  • jorgecunhamendes/ghc
  • liesnikov/ghc
  • akrmn/ghc
  • trac-simplifierticks/ghc
  • jacco/ghc
  • rhendric/ghc
  • damhiya/ghc
  • ryndubei/ghc
  • DaveBarton/ghc
  • trac-Profpatsch/ghc
  • GZGavinZhao/ghc
  • ncfavier/ghc
  • jameshaydon/ghc
  • ajccosta/ghc
  • dschrempf/ghc
  • cydparser/ghc
  • LinuxUserGD/ghc
  • elodielander/ghc
  • facundominguez/ghc
  • psilospore/ghc
  • lachrimae/ghc
  • dylan-thinnes/ghc-type-errors-plugin
  • hamishmack/ghc
  • Leary/ghc
  • lzszt/ghc
  • lyokha/ghc
  • trac-glaubitz/ghc
  • Rewbert/ghc
  • andreabedini/ghc
  • Jasagredo/ghc
  • sol/ghc
  • OlegAlexander/ghc
  • trac-sthibaul/ghc
  • avdv/ghc
  • Wendaolee/ghc
  • ur4t/ghc
  • daylily/ghc
  • boltzmannrain/ghc
  • mmzk1526/ghc
  • trac-fizzixnerd/ghc
  • soulomoon/ghc
  • rwmjones/ghc
  • j14i/ghc
  • tracsis/ghc
  • gesh/ghc
  • flip101/ghc
  • eldritch-cookie/ghc
  • LemonjamesD/ghc
  • pgujjula/ghc
  • skeuchel/ghc
  • noteed/ghc
  • Torrekie/ghc
  • jlwoodwa/ghc
  • ayanamists/ghc
  • husong998/ghc
  • trac-edmundnoble/ghc
  • josephf/ghc
  • contrun/ghc
  • baulig/ghc
  • edsko/ghc
  • mzschr/ghc-issue-24732
  • ulidtko/ghc
  • Arsen/ghc
  • trac-sjoerd_visscher/ghc
  • crumbtoo/ghc
  • L0neGamer/ghc
  • DrewFenwick/ghc
  • benz0li/ghc
  • MaciejWas/ghc
  • jordanrule/ghc
  • trac-qqwy/ghc
  • LiamGoodacre/ghc
  • isomorpheme/ghc
  • trac-danidiaz/ghc
  • Kariim/ghc
  • MTaimoorZaeem/ghc
  • hololeap/ghc
  • ticat-fp/ghc
  • meritamen/ghc
  • criskell/ghc
  • trac-kraai/ghc
  • aergus/ghc
  • jdral/ghc
  • SamB/ghc
  • Tristian/ghc
  • ywgrit/ghc
  • KatsuPatrick/ghc
  • OsePedro/ghc
  • mpscholten/ghc
  • zaquest/ghc
  • fangyi-zhou/ghc
  • augyg/ghc
  • rkirkman/ghc
  • gulin.serge/ghc-windows-aarch64-bootstrap
  • iris/ghc
  • kwxm/ghc
  • maralorn/ghc
  • rafl/ghc
  • nikshalark/ghc
  • mrcjkb/ghc
  • blackheaven/ghc
  • laurenyim/ghc
  • bolt12/ghc
  • Xitian9/ghc
  • wenkokke/ghc
  • kephas/ghc
651 results
Show changes
Commits on Source (1)
  • Bartłomiej Cieślar's avatar
    Add support for deprecating exported items (proposal #134) · 5a5bcaee
    Bartłomiej Cieślar authored
    
    This is an implementation of the deprecated exports proposal #134.
    The proposal introduces an ability to introduce warnings to exports.
    This allows for deprecating a name only when it is exported from a specific
    module, rather than always depreacting its usage. In this example:
    
        module A ({-# DEPRECATED "do not use" #-} x) where
        x = undefined
        ---
        module B where
        import A(x)
    
    `x` will emit a warning when it is explicitly imported.
    
    Like the declaration warnings, export warnings are first accumulated within
    the `Warnings` struct, then passed into the ModIface, from which they are
    then looked up and warned about in the importing module in the `lookup_ie`
    helpers of the `filterImports` function (for the explicitly imported names)
    and in the `addUsedGRE(s)` functions where they warn about regular usages
    of the imported name.
    
    In terms of the AST information, the custom warning is stored in the
    extension field of the variants of the `IE` type (see Trees that Grow for
    more information).
    
    The commit includes a bump to the haddock submodule added in MR #28
    
    Signed-off-by: default avatarBartłomiej Cieślar <bcieslar2001@gmail.com>
    5a5bcaee
Showing
with 624 additions and 221 deletions
......@@ -1394,7 +1394,7 @@ getPackageModuleInfo hsc_env mdl
tys = [ ty | name <- concatMap availNames avails,
Just ty <- [lookupTypeEnv pte name] ]
let !rdr_env = availsToGlobalRdrEnv hsc_env (moduleName mdl) avails
let !rdr_env = availsToGlobalRdrEnv hsc_env mdl avails
-- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
return (Just (ModuleInfo {
......@@ -1407,7 +1407,7 @@ getPackageModuleInfo hsc_env mdl
minf_modBreaks = emptyModBreaks
}))
availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> ModuleName -> [AvailInfo] -> IfGlobalRdrEnv
availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
availsToGlobalRdrEnv hsc_env mod avails
= forceGlobalRdrEnv rdr_env
-- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
......@@ -1416,7 +1416,7 @@ availsToGlobalRdrEnv hsc_env mod avails
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
decl = ImpDeclSpec { is_mod = mod, is_as = mod,
decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
is_qual = False,
is_dloc = srcLocSpan interactiveSrcLoc }
......
......@@ -647,6 +647,7 @@ data WarningFlag =
| Opt_WarnTermVariableCapture -- Since 9.8
| Opt_WarnMissingRoleAnnotations -- Since 9.8
| Opt_WarnImplicitRhsQuantification -- Since 9.8
| Opt_WarnIncompleteExportWarnings -- Since 9.8
deriving (Eq, Ord, Show, Enum)
-- | Return the names of a WarningFlag
......@@ -756,6 +757,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| []
Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| []
Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| []
Opt_WarnIncompleteExportWarnings -> "incomplete-export-warnings" :| []
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
......@@ -928,7 +930,8 @@ minusWallOpts
Opt_WarnUnusedRecordWildcards,
Opt_WarnRedundantRecordWildcards,
Opt_WarnIncompleteUniPatterns,
Opt_WarnIncompletePatternsRecUpd
Opt_WarnIncompletePatternsRecUpd,
Opt_WarnIncompleteExportWarnings
]
-- | Things you get with -Weverything, i.e. *all* known warnings flags
......
......@@ -2271,7 +2271,8 @@ wWarningFlagsDeps = mconcat [
warnSpec Opt_WarnTypeEqualityRequiresOperators,
warnSpec Opt_WarnTermVariableCapture,
warnSpec Opt_WarnMissingRoleAnnotations,
warnSpec Opt_WarnImplicitRhsQuantification
warnSpec Opt_WarnImplicitRhsQuantification,
warnSpec Opt_WarnIncompleteExportWarnings
]
warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
......
......@@ -38,6 +38,8 @@ import GHC.Hs.Extension
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Unit.Module.Warnings (WarningTxt)
import Data.Data
import Data.Maybe
......@@ -198,16 +200,39 @@ type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA
type instance Anno (IE (GhcPass p)) = SrcSpanAnnA
type instance XIEVar GhcPs = NoExtField
type instance XIEVar GhcRn = NoExtField
type instance XIEVar GhcTc = NoExtField
type instance XIEThingAbs (GhcPass _) = EpAnn [AddEpAnn]
type instance XIEThingAll (GhcPass _) = EpAnn [AddEpAnn]
type instance XIEThingWith (GhcPass _) = EpAnn [AddEpAnn]
type instance XIEModuleContents GhcPs = EpAnn [AddEpAnn]
type instance XIEModuleContents GhcRn = NoExtField
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
type instance XIEVar GhcPs = Maybe (LocatedP (WarningTxt GhcPs))
type instance XIEVar GhcRn = Maybe (LocatedP (WarningTxt GhcRn))
type instance XIEVar GhcTc = NoExtField
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
type instance XIEThingAbs GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
type instance XIEThingAbs GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
type instance XIEThingAbs GhcTc = EpAnn [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
type instance XIEThingAll GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
type instance XIEThingAll GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
type instance XIEThingAll GhcTc = EpAnn [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
type instance XIEThingWith GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
type instance XIEThingWith GhcRn = (Maybe (LocatedP (WarningTxt GhcRn)), EpAnn [AddEpAnn])
type instance XIEThingWith GhcTc = EpAnn [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
type instance XIEModuleContents GhcPs = (Maybe (LocatedP (WarningTxt GhcPs)), EpAnn [AddEpAnn])
type instance XIEModuleContents GhcRn = Maybe (LocatedP (WarningTxt GhcRn))
type instance XIEModuleContents GhcTc = NoExtField
type instance XIEGroup (GhcPass _) = NoExtField
......@@ -236,6 +261,22 @@ ieNames (IEGroup {}) = []
ieNames (IEDoc {}) = []
ieNames (IEDocNamed {}) = []
ieDeprecation :: forall p. IsPass p => IE (GhcPass p) -> Maybe (WarningTxt (GhcPass p))
ieDeprecation = fmap unLoc . ie_deprecation (ghcPass @p)
where
ie_deprecation :: GhcPass p -> IE (GhcPass p) -> Maybe (LocatedP (WarningTxt (GhcPass p)))
ie_deprecation GhcPs (IEVar xie _) = xie
ie_deprecation GhcPs (IEThingAbs (xie, _) _) = xie
ie_deprecation GhcPs (IEThingAll (xie, _) _) = xie
ie_deprecation GhcPs (IEThingWith (xie, _) _ _ _) = xie
ie_deprecation GhcPs (IEModuleContents (xie, _) _) = xie
ie_deprecation GhcRn (IEVar xie _) = xie
ie_deprecation GhcRn (IEThingAbs (xie, _) _) = xie
ie_deprecation GhcRn (IEThingAll (xie, _) _) = xie
ie_deprecation GhcRn (IEThingWith (xie, _) _ _ _) = xie
ie_deprecation GhcRn (IEModuleContents xie _) = xie
ie_deprecation _ _ = Nothing
ieWrappedLName :: IEWrappedName (GhcPass p) -> LIdP (GhcPass p)
ieWrappedLName (IEName _ (L l n)) = L l n
ieWrappedLName (IEPattern _ (L l n)) = L l n
......@@ -260,11 +301,11 @@ replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn
replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
ppr (IEVar _ var) = ppr (unLoc var)
ppr (IEThingAbs _ thing) = ppr (unLoc thing)
ppr (IEThingAll _ thing) = hcat [ppr (unLoc thing), text "(..)"]
ppr (IEThingWith _ thing wc withs)
= ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))
ppr ie@(IEVar _ var) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc var)]
ppr ie@(IEThingAbs _ thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing)]
ppr ie@(IEThingAll _ thing) = sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ hcat [ppr (unLoc thing), text "(..)"]]
ppr ie@(IEThingWith _ thing wc withs)
= sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ ppr (unLoc thing) <> parens (fsep (punctuate comma ppWiths))]
where
ppWiths =
case wc of
......@@ -273,8 +314,8 @@ instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
IEWildcard pos ->
let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
in bs ++ [text ".."] ++ as
ppr (IEModuleContents _ mod')
= text "module" <+> ppr mod'
ppr ie@(IEModuleContents _ mod')
= sep $ catMaybes [ppr <$> ieDeprecation ie, Just $ text "module" <+> ppr mod']
ppr (IEGroup _ n _) = text ("<IEGroup: " ++ show n ++ ">")
ppr (IEDoc _ doc) = ppr doc
ppr (IEDocNamed _ string) = text ("<IEDocNamed: " ++ string ++ ">")
......
......@@ -1210,10 +1210,16 @@ instance Outputable (Warnings pass) where
ppr = pprWarns
pprWarns :: Warnings pass -> SDoc
pprWarns NoWarnings = Outputable.empty
pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt
pprWarns (WarnSome prs) = text "Warnings:"
<+> vcat (map pprWarning prs)
pprWarns (WarnSome decl_warns export_warns)
= vcat $
case decl_warns of
[] -> []
_ -> [text "Declaration warnings:" <+> vcat (map pprWarning decl_warns)]
++
case export_warns of
[] -> []
_ -> [text "Export warnings:" <+> vcat (map pprWarning export_warns)]
where pprWarning (name, txt) = ppr name <+> ppr txt
pprIfaceAnnotation :: IfaceAnnotation -> SDoc
......
......@@ -962,7 +962,8 @@ addFingerprints hsc_env iface0
eps <- hscEPS hsc_env
let
decls = mi_decls iface0
warn_fn = mkIfaceWarnCache (mi_warns iface0)
decl_warn_fn = mkIfaceDeclWarnCache (mi_warns iface0)
export_warn_fn = mkIfaceExportWarnCache (mi_warns iface0)
fix_fn = mkIfaceFixCache (mi_fixities iface0)
-- The ABI of a declaration represents everything that is made
......@@ -1263,22 +1264,23 @@ addFingerprints hsc_env iface0
let
final_iface_exts = ModIfaceBackend
{ mi_iface_hash = iface_hash
, mi_mod_hash = mod_hash
, mi_flag_hash = flag_hash
, mi_opt_hash = opt_hash
, mi_hpc_hash = hpc_hash
, mi_plugin_hash = plugin_hash
, mi_orphan = not ( all ifRuleAuto orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
&& null orph_fis)
, mi_finsts = not (null (mi_fam_insts iface0))
, mi_exp_hash = export_hash
, mi_orphan_hash = orphan_hash
, mi_warn_fn = warn_fn
, mi_fix_fn = fix_fn
, mi_hash_fn = lookupOccEnv local_env
{ mi_iface_hash = iface_hash
, mi_mod_hash = mod_hash
, mi_flag_hash = flag_hash
, mi_opt_hash = opt_hash
, mi_hpc_hash = hpc_hash
, mi_plugin_hash = plugin_hash
, mi_orphan = not ( all ifRuleAuto orph_rules
-- See Note [Orphans and auto-generated rules]
&& null orph_insts
&& null orph_fis)
, mi_finsts = not (null (mi_fam_insts iface0))
, mi_exp_hash = export_hash
, mi_orphan_hash = orphan_hash
, mi_decl_warn_fn = decl_warn_fn
, mi_export_warn_fn = export_warn_fn
, mi_fix_fn = fix_fn
, mi_hash_fn = lookupOccEnv local_env
}
final_iface = iface0 { mi_decls = sorted_decls, mi_extra_decls = sorted_extra_decls, mi_final_exts = final_iface_exts }
--
......
......@@ -1026,11 +1026,24 @@ exportlist1 :: { OrdList (LIE GhcPs) }
-- No longer allow things like [] and (,,,) to be exported
-- They are built in syntax, always available
export :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% mkModuleImpExp (fst $ unLoc $2) $1 (snd $ unLoc $2)
>>= \ie -> fmap (unitOL . reLocA) (return (sLL (reLoc $1) $> ie)) }
| 'module' modid {% fmap (unitOL . reLocA) (acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (EpAnn (glR $1) [mj AnnModule $1] cs) $2))) }
| 'pattern' qcon { unitOL (reLocA (sLL $1 (reLocN $>)
(IEVar noExtField (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2))))) }
: maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> }
; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3)
; return $ unitOL $ reLocA $ sL span $ impExp } }
| maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 (reLoc loc)) $1) $2 }
; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3))
; return $ unitOL $ reLocA $ locImpExp } }
| maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>)
in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) }
maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
: '{-# DEPRECATED' strings '#-}'
{% fmap Just $ amsrp (sLL $1 $> $ DeprecatedTxt (sL1 $1 $ getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
(AnnPragma (mo $1) (mc $3) (fst $ unLoc $2)) }
| '{-# WARNING' warning_category strings '#-}'
{% fmap Just $ amsrp (sLL $1 $> $ WarningTxt $2 (sL1 $1 $ getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
(AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
| {- empty -} { Nothing }
export_subspec :: { Located ([AddEpAnn],ImpExpSubSpec) }
: {- empty -} { sL0 ([],ImpExpAbs) }
......@@ -1166,13 +1179,40 @@ maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs]
| {- empty -} { noLoc Nothing }
impspec :: { Located (ImportListInterpretation, LocatedL [LIE GhcPs]) }
: '(' exportlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2)
: '(' importlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2)
(AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) [])
; return $ sLL $1 $> (Exactly, es)} }
| 'hiding' '(' exportlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3)
| 'hiding' '(' importlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3)
(AnnList Nothing (Just $ mop $2) (Just $ mcp $4) (mj AnnHiding $1:fst $3) [])
; return $ sLL $1 $> (EverythingBut, es)} }
importlist :: { ([AddEpAnn], OrdList (LIE GhcPs)) }
: importlist1 { ([], $1) }
| {- empty -} { ([], nilOL) }
-- trailing comma:
| importlist1 ',' {% case $1 of
SnocOL hs t -> do
t' <- addTrailingCommaA t (gl $2)
return ([], snocOL hs t')}
| ',' { ([mj AnnComma $1], nilOL) }
importlist1 :: { OrdList (LIE GhcPs) }
: importlist1 ',' import
{% let ls = $1
in if isNilOL ls
then return (ls `appOL` $3)
else case ls of
SnocOL hs t -> do
t' <- addTrailingCommaA t (gl $2)
return (snocOL hs t' `appOL` $3)}
| import { $1 }
import :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }
| 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) }
| 'pattern' qcon { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) }
-----------------------------------------------------------------------------
-- Fixity Declarations
......
......@@ -153,6 +153,7 @@ import Data.Either
import Data.List ( findIndex )
import Data.Foldable
import qualified Data.Semigroup as Semi
import GHC.Unit.Module.Warnings
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import qualified GHC.Data.Strict as Strict
......@@ -2791,18 +2792,20 @@ data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
| ImpExpQcType EpaLocation (LocatedN RdrName)
| ImpExpQcWildcard
mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp anns (L l specname) subs = do
mkModuleImpExp :: Maybe (LocatedP (WarningTxt GhcPs)) -> [AddEpAnn] -> LocatedA ImpExpQcSpec
-> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp warning anns (L l specname) subs = do
cs <- getCommentsFor (locA l) -- AZ: IEVar can discard comments
let ann = EpAnn (spanAsAnchor $ locA l) anns cs
let ann = EpAnn (spanAsAnchor $ maybe (locA l) getLocA warning) anns cs
case subs of
ImpExpAbs
| isVarNameSpace (rdrNameSpace name)
-> return $ IEVar noExtField (L l (ieNameFromSpec specname))
| otherwise -> IEThingAbs ann . L l <$> nameT
ImpExpAll -> IEThingAll ann . L l <$> nameT
-> return $ IEVar warning
(L l (ieNameFromSpec specname))
| otherwise -> IEThingAbs (warning, ann) . L l <$> nameT
ImpExpAll -> IEThingAll (warning, ann) . L l <$> nameT
ImpExpList xs ->
(\newName -> IEThingWith ann (L l newName)
(\newName -> IEThingWith (warning, ann) (L l newName)
NoIEWildcard (wrapped xs)) <$> nameT
ImpExpAllWith xs ->
do allowed <- getBit PatternSynonymsBit
......@@ -2814,7 +2817,7 @@ mkModuleImpExp anns (L l specname) subs = do
ies :: [LocatedA (IEWrappedName GhcPs)]
ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
in (\newName
-> IEThingWith ann (L l newName) pos ies)
-> IEThingWith (warning, ann) (L l newName) pos ies)
<$> nameT
else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $
PsErrIllegalPatSynExport
......
......@@ -2,7 +2,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-2006
......@@ -79,7 +79,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Builtin.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env ( lookupNameEnv )
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Types.Hint
import GHC.Types.Error
......@@ -116,6 +116,7 @@ import Control.Monad
import Data.Either ( partitionEithers )
import Data.Function ( on )
import Data.List ( find, partition, groupBy, sortBy )
import Data.Foldable ( for_ )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semi
import System.IO.Unsafe ( unsafePerformIO )
......@@ -408,7 +409,7 @@ lookupInstDeclBndr cls what rdr
-- to use a qualified name for the method
-- (Although it'd make perfect sense.)
; mb_name <- lookupSubBndrOcc
DisableDeprecationWarnings
NoDeprecationWarnings
-- we don't give deprecated
-- warnings when a deprecated class
-- method is defined. We only warn
......@@ -554,7 +555,7 @@ lookupRecFieldOcc mb_con rdr_name
, text "rdr_name:" <+> ppr rdr_name
, text "flds:" <+> ppr flds
, text "mb_gre:" <+> ppr mb_gre ]
; mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre
; mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
; return $ flSelector . fieldGRELabel <$> mb_gre }
; case mb_nm of
{ Nothing -> do { addErr (badFieldConErr con lbl)
......@@ -1415,7 +1416,7 @@ lookupFieldGREs env (L loc rdr)
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded rdr_name =
lookupExactOrOrig_maybe rdr_name id $
do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name EnableDeprecationWarnings
do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name AllDeprecationWarnings
; case res of
GreNotFound -> lookupOneQualifiedNameGHCi WantNormal rdr_name
OneNameMatch gre -> return $ Just gre
......@@ -1635,7 +1636,7 @@ lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
-- Uses addUsedRdrName to record use and deprecations
lookupGreRn_maybe which_gres rdr_name
= do
res <- lookupGreRn_helper which_gres rdr_name EnableDeprecationWarnings
res <- lookupGreRn_helper which_gres rdr_name AllDeprecationWarnings
case res of
OneNameMatch gre -> return $ Just gre
MultipleNames gres -> do
......@@ -1688,7 +1689,7 @@ lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Uses addUsedRdrName to record use and deprecations
lookupGreAvailRn rdr_name
= do
mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name DisableDeprecationWarnings
mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name ExportDeprecationWarnings
case mb_gre of
GreNotFound ->
do
......@@ -1713,7 +1714,7 @@ lookupGreAvailRn rdr_name
Note [Handling of deprecations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* We report deprecations at each *occurrence* of the deprecated thing
(see #5867)
(see #5867 and #4879)
* We do not report deprecations for locally-defined names. For a
start, we may be exporting a deprecated thing. Also we may use a
......@@ -1721,6 +1722,10 @@ Note [Handling of deprecations]
even use a deprecated thing in the defn of a non-deprecated thing,
when changing a module's interface.
* We also report deprecations at export sites, but only for names
deprecated with export deprecations (since those are not transitive as opposed
to regular name deprecations and are only reported at the importing module)
* addUsedGREs: we do not report deprecations for sub-binders:
- the ".." completion for records
- the ".." in an export item 'T(..)'
......@@ -1730,39 +1735,43 @@ Note [Handling of deprecations]
addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
-- Remember use of in-scope data constructors (#7969)
addUsedDataCons rdr_env tycon
= addUsedGREs [ gre
| dc <- tyConDataCons tycon
, Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ]
= addUsedGREs NoDeprecationWarnings
[ gre
| dc <- tyConDataCons tycon
, Just gre <- [lookupGRE_Name rdr_env (dataConName dc)] ]
-- | Whether to report deprecation warnings when registering a used GRE
--
-- There is no option to only emit declaration warnings since everywhere
-- we emit the declaration warnings we also emit export warnings
-- (See Note [Handling of deprecations] for details)
data DeprecationWarnings
= DisableDeprecationWarnings
| EnableDeprecationWarnings
= NoDeprecationWarnings
| ExportDeprecationWarnings
| AllDeprecationWarnings
addUsedGRE :: DeprecationWarnings -> GlobalRdrElt -> RnM ()
-- Called for both local and imported things
-- Add usage *and* warn if deprecated
addUsedGRE warn_if_deprec gre
= do { case warn_if_deprec of
EnableDeprecationWarnings -> warnIfDeprecated gre
DisableDeprecationWarnings -> return ()
= do { condWarnIfDeprecated warn_if_deprec [gre]
; when (isImportedGRE gre) $ -- See Note [Using isImportedGRE in addUsedGRE]
do { env <- getGblEnv
-- Do not report the GREInfo (#23424)
; traceRn "addUsedGRE" (ppr $ greName gre)
; updTcRef (tcg_used_gres env) (gre :) } }
addUsedGREs :: [GlobalRdrElt] -> RnM ()
addUsedGREs :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
-- Record uses of any *imported* GREs
-- Used for recording used sub-bndrs
-- NB: no call to warnIfDeprecated; see Note [Handling of deprecations]
addUsedGREs gres
| null imp_gres = return ()
| otherwise = do { env <- getGblEnv
-- Do not report the GREInfo (#23424)
; traceRn "addUsedGREs"
(ppr $ map greName imp_gres)
; updTcRef (tcg_used_gres env) (imp_gres ++) }
addUsedGREs warn_if_deprec gres
= do { condWarnIfDeprecated warn_if_deprec gres
; unless (null imp_gres) $
do { env <- getGblEnv
-- Do not report the GREInfo (#23424)
; traceRn "addUsedGREs" (ppr $ map greName imp_gres)
; updTcRef (tcg_used_gres env) (imp_gres ++) } }
where
imp_gres = filter isImportedGRE gres
-- See Note [Using isImportedGRE in addUsedGRE]
......@@ -1781,22 +1790,32 @@ in which case we have both gre_lcl = False and gre_imp = emptyBag.
Geting this wrong can lead to panics in e.g. bestImport, see #23240.
-}
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated gre@(GRE { gre_imp = iss })
condWarnIfDeprecated :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
condWarnIfDeprecated NoDeprecationWarnings _ = return ()
condWarnIfDeprecated opt gres = do
this_mod <- getModule
let external_gres
= filterOut (nameIsLocalOrFrom this_mod . greName) gres
mapM_ (\gre -> warnIfExportDeprecated gre >> maybeWarnDeclDepr gre) external_gres
where
maybeWarnDeclDepr = case opt of
ExportDeprecationWarnings -> const $ return ()
AllDeprecationWarnings -> warnIfDeclDeprecated
warnIfDeclDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeclDeprecated gre@(GRE { gre_imp = iss })
| Just imp_spec <- headMaybe iss
= do { dflags <- getDynFlags
; this_mod <- getModule
; when (wopt_any_custom dflags &&
not (nameIsLocalOrFrom this_mod name)) $
; when (wopt_any_custom dflags) $
-- See Note [Handling of deprecations]
do { iface <- loadInterfaceForName doc name
; case lookupImpDeprec iface gre of
; case lookupImpDeclDeprec iface gre of
Just deprText -> addDiagnostic $
TcRnPragmaWarning {
pragma_warning_occ = occ,
pragma_warning_msg = deprText,
pragma_warning_import_mod = importSpecModule imp_spec,
pragma_warning_defined_mod = definedMod
pragma_warning_defined_mod = Just definedMod
}
Nothing -> return () } }
| otherwise
......@@ -1807,13 +1826,35 @@ warnIfDeprecated gre@(GRE { gre_imp = iss })
definedMod = moduleName $ assertPpr (isExternalName name) (ppr name) (nameModule name)
doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly"
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeprec iface gre
= mi_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` -- Bleat if the thing,
lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
lookupImpDeclDeprec iface gre
= mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` -- Bleat if the thing,
case gre_par gre of -- or its parent, is warn'd
ParentIs p -> mi_warn_fn (mi_final_exts iface) (nameOccName p)
ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
NoParent -> Nothing
warnIfExportDeprecated :: GlobalRdrElt -> RnM ()
warnIfExportDeprecated gre@(GRE { gre_imp = iss })
= do { mod_warn_mbs <- mapBagM process_import_spec iss
; for_ (sequence mod_warn_mbs) $ mapM
$ \(importing_mod, warn_txt) -> addDiagnostic $
TcRnPragmaWarning {
pragma_warning_occ = occ,
pragma_warning_msg = warn_txt,
pragma_warning_import_mod = importing_mod,
pragma_warning_defined_mod = Nothing
} }
where
occ = greOccName gre
name = greName gre
doc = text "The name" <+> quotes (ppr occ) <+> text "is mentioned explicitly"
process_import_spec :: ImportSpec -> RnM (Maybe (ModuleName, WarningTxt GhcRn))
process_import_spec is = do
let mod = is_mod $ is_decl is
iface <- loadInterfaceForModule doc mod
let mb_warn_txt = mi_export_warn_fn (mi_final_exts iface) name
return $ (moduleName mod, ) <$> mb_warn_txt
{-
Note [Used names with interface not loaded]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1902,12 +1943,12 @@ lookupQualifiedNameGHCi fos rdr_name
where
go_for_it dflags is_ghci
| Just (mod,occ) <- isQual_maybe rdr_name
| Just (mod_name,occ) <- isQual_maybe rdr_name
, let ns = occNameSpace occ
, is_ghci
, gopt Opt_ImplicitImportQualified dflags -- Enables this GHCi behaviour
, not (safeDirectImpsReq dflags) -- See Note [Safe Haskell and GHCi]
= do { res <- loadSrcInterface_maybe doc mod NotBoot NoPkgQual
= do { res <- loadSrcInterface_maybe doc mod_name NotBoot NoPkgQual
; case res of
Succeeded iface
-> do { hsc_env <- getTopEnv
......@@ -1919,7 +1960,8 @@ lookupQualifiedNameGHCi fos rdr_name
lk_ns = occNameSpace lk_occ
, occNameFS occ == occNameFS lk_occ
, ns == lk_ns || (ns == varName && isFieldNameSpace lk_ns)
, let gre = lookupGRE_PTE mod hsc_env gname
, let mod = mi_module iface
gre = lookupGRE_PTE mod hsc_env gname
, allowGRE fos gre
-- Include a field if it has a selector or we are looking for all fields;
-- see Note [NoFieldSelectors].
......@@ -1939,7 +1981,7 @@ lookupQualifiedNameGHCi fos rdr_name
-- Lookup a Name for an implicit qualified import in GHCi
-- in the given PackageTypeEnv.
lookupGRE_PTE :: ModuleName -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE mod hsc_env nm =
-- Fake a GRE so we can report a sensible name clash error if
-- -fimplicit-import-qualified is used with a module that exports the same
......@@ -1952,7 +1994,7 @@ lookupQualifiedNameGHCi fos rdr_name
, gre_info = info }
where
info = lookupGREInfo hsc_env nm
spec = ImpDeclSpec { is_mod = mod, is_as = mod, is_qual = True, is_dloc = noSrcSpan }
spec = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, is_qual = True, is_dloc = noSrcSpan }
is = ImpSpec { is_decl = spec, is_item = ImpAll }
-- | Look up the 'GREInfo' associated with the given 'Name'
......@@ -2098,7 +2140,7 @@ lookupBindGroupOcc ctxt what rdr_name
else lookup_top (`elemNameSet` ns)
where
lookup_cls_op cls
= lookupSubBndrOcc EnableDeprecationWarnings cls doc rdr_name
= lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
where
doc = text "method of class" <+> quotes (ppr cls)
......
......@@ -194,7 +194,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
-- Rename deprec decls;
-- check for duplicates and ensure that deprecated things are defined locally
-- at the moment, we don't keep these around past renaming
rn_warns <- rnSrcWarnDecls all_bndrs warn_decls ;
rn_decl_warns <- rnSrcWarnDecls all_bndrs warn_decls ;
-- (H) Rename Everything else
......@@ -236,7 +236,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
final_tcg_env = let tcg_env' = (last_tcg_env `addTcgDUs` src_dus)
in -- we return the deprecs in the env, not in the HsGroup above
tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
tcg_env' { tcg_warns = insertWarnDecls (tcg_warns tcg_env') rn_decl_warns };
} ;
traceRn "finish rnSrc" (ppr rn_group) ;
traceRn "finish Dus" (ppr src_dus ) ;
......@@ -266,9 +266,9 @@ gather them together.
-}
-- checks that the deprecations are defined locally, and that there are no duplicates
rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM (Warnings GhcRn)
rnSrcWarnDecls :: NameSet -> [LWarnDecls GhcPs] -> RnM (DeclWarnOccNames GhcRn)
rnSrcWarnDecls _ []
= return NoWarnings
= return []
rnSrcWarnDecls bndr_set decls'
= do { -- check for duplicates
......@@ -276,7 +276,7 @@ rnSrcWarnDecls bndr_set decls'
in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
warn_rdr_dups
; pairs_s <- mapM (addLocMA rn_deprec) decls
; return (WarnSome ((concat pairs_s))) }
; return $ concat pairs_s }
where
decls = concatMap (wd_warnings . unLoc) decls'
......
......@@ -386,9 +386,9 @@ rnImportDecl this_mod
when (mod_safe && not (safeImportsOn dflags)) $
addErr (TcRnSafeImportsDisabled imp_mod_name)
let
let imp_mod = mi_module iface
qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
imp_spec = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only,
is_dloc = locA loc, is_as = qual_mod_name }
-- filter the imports according to the import declaration
......@@ -620,7 +620,6 @@ warnUnqualifiedImport decl iface =
-- Modules for which we warn if we see unqualified imports
qualifiedMods = mkModuleSet [ dATA_LIST ]
{-
************************************************************************
* *
......@@ -1192,6 +1191,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
return (Just (want_hiding, L l (map fst items2)), gres)
where
import_mod = mi_module iface
all_avails = mi_exports iface
hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
imp_occ_env = mkImportOccEnv hsc_env decl_spec all_avails
......@@ -1253,6 +1253,13 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-- 'badImportItemErr'.
reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails
pure (TcRnDodgyImports (DodgyImportsHiding reason))
warning_msg (DeprecatedExport n w) =
pure (TcRnPragmaWarning {
pragma_warning_occ = occName n
, pragma_warning_msg = w
, pragma_warning_import_mod = moduleName import_mod
, pragma_warning_defined_mod = Nothing
})
run_lookup :: IELookupM a -> TcRn (Maybe a)
run_lookup m = case m of
......@@ -1282,15 +1289,20 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
IEVar _ (L l n) -> do
-- See Note [Importing DuplicateRecordFields]
xs <- lookup_names ie (ieWrappedName n)
return ( [ (IEVar noExtField (L l (replaceWrappedName n name)), [gre])
| ImpOccItem { imp_item = gre } <- NE.toList xs
let gres = map imp_item $ NE.toList xs
export_depr_warns
| want_hiding == Exactly
= mapMaybe mk_depr_export_warning gres
| otherwise = []
return ( [ (IEVar Nothing (L l (replaceWrappedName n name)), [gre])
| gre <- gres
, let name = greName gre ]
, [] )
, export_depr_warns )
IEThingAll _ (L l tc) -> do
ImpOccItem gre child_gres _ <- lookup_parent ie $ ieWrappedName tc
let name = greName gre
warns
imp_list_warn
| null child_gres
-- e.g. f(..) or T(..) where T is a type synonym
......@@ -1303,9 +1315,17 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
| otherwise
= []
renamed_ie = IEThingAll noAnn (L l (replaceWrappedName tc name))
renamed_ie = IEThingAll (Nothing, noAnn) (L l (replaceWrappedName tc name))
export_depr_warn
| want_hiding == Exactly
= maybeToList $ mk_depr_export_warning gre
-- We don't want to warn about the children as they
-- are not explicitly mentioned; the warning will
-- be emitted later on if they are used
| otherwise = []
return ([(renamed_ie, gre:child_gres)], warns)
return ( [(renamed_ie, gre:child_gres)]
, imp_list_warn ++ export_depr_warn)
IEThingAbs _ (L l tc')
......@@ -1318,33 +1338,38 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
in
case catIELookupM [ tc_name, dc_name ] of
[] -> failLookupWith (BadImport ie BadImportIsParent)
names -> return ([mkIEThingAbs tc' l (imp_item name) | name <- names], [])
names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], [])
| otherwise
-> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc')
return ([mkIEThingAbs tc' l gre], [])
return ( [mkIEThingAbs tc' l gre]
, maybeToList $ mk_depr_export_warning gre)
IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns -> do
IEThingWith (deprecation, ann) ltc@(L l rdr_tc) wc rdr_ns -> do
ImpOccItem { imp_item = gre, imp_bundled = subnames }
<- lookup_parent (IEThingAbs noAnn ltc) (ieWrappedName rdr_tc)
<- lookup_parent (IEThingAbs (Nothing, noAnn) ltc) (ieWrappedName rdr_tc)
let name = greName gre
-- Look up the children in the sub-names of the parent
-- See Note [Importing DuplicateRecordFields]
case lookupChildren subnames rdr_ns of
Failed rdrs -> failLookupWith (BadImport (IEThingWith xt ltc wc rdrs) BadImportIsSubordinate)
Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate)
-- We are trying to import T( a,b,c,d ), and failed
-- to find 'b' and 'd'. So we make up an import item
-- to report as failing, namely T( b, d ).
-- c.f. #15412
Succeeded childnames ->
return ([ (IEThingWith xt (L l name') wc childnames'
,gre : map unLoc childnames)]
, [])
return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames'
,gres)]
, export_depr_warns)
where name' = replaceWrappedName rdr_tc name
childnames' = map (to_ie_post_rn . fmap greName) childnames
gres = gre : map unLoc childnames
export_depr_warns
| want_hiding == Exactly = mapMaybe mk_depr_export_warning gres
| otherwise = []
_other -> failLookupWith IllegalImport
-- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed...
......@@ -1352,19 +1377,25 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
where
mkIEThingAbs tc l gre
= (IEThingAbs noAnn (L l (replaceWrappedName tc n)), [gre])
= (IEThingAbs (Nothing, noAnn) (L l (replaceWrappedName tc n)), [gre])
where n = greName gre
handle_bad_import m = catchIELookup m $ \err -> case err of
BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie])
_ -> failLookupWith err
mk_depr_export_warning gre
= DeprecatedExport name <$> mi_export_warn_fn (mi_final_exts iface) name
where
name = greName gre
type IELookupM = MaybeErr IELookupError
data IELookupWarning
= BadImportW (IE GhcPs)
| MissingImportList
| DodgyImport GlobalRdrElt
| DeprecatedExport Name (WarningTxt GhcRn)
data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate
......@@ -1946,10 +1977,10 @@ getMinimalImports ie_decls
to_ie rdr_env _ (Avail c) -- Note [Overloaded field import]
= do { let
gre = expectJust "getMinimalImports Avail" $ lookupGRE_Name rdr_env c
; return $ [IEVar noExtField (to_ie_post_rn $ noLocA $ greName gre)] }
; return $ [IEVar Nothing (to_ie_post_rn $ noLocA $ greName gre)] }
to_ie _ _ avail@(AvailTC n [_]) -- Exporting the main decl and nothing else
| availExportsDecl avail
= return [IEThingAbs noAnn (to_ie_post_rn $ noLocA n)]
= return [IEThingAbs (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
to_ie rdr_env iface (AvailTC n cs) =
case [ xs | avail@(AvailTC x xs) <- mi_exports iface
, x == n
......@@ -1957,11 +1988,11 @@ getMinimalImports ie_decls
] of
[xs]
| all_used xs
-> return [IEThingAll noAnn (to_ie_post_rn $ noLocA n)]
-> return [IEThingAll (Nothing, noAnn) (to_ie_post_rn $ noLocA n)]
| otherwise
-> do { let ns_gres = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs
ns = map greName ns_gres
; return [IEThingWith noAnn (to_ie_post_rn $ noLocA n) NoIEWildcard
; return [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
(map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
-- Note [Overloaded field import]
_other
......@@ -1971,8 +2002,8 @@ getMinimalImports ie_decls
fs = map fieldGREInfo fs_gres
; return $
if all_non_overloaded fs
then map (IEVar noExtField . to_ie_post_rn_var . noLocA) ns
else [IEThingWith noAnn (to_ie_post_rn $ noLocA n) NoIEWildcard
then map (IEVar Nothing . to_ie_post_rn_var . noLocA) ns
else [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard
(map (to_ie_post_rn . noLocA) (filter (/= n) ns))] }
where
......
......@@ -830,7 +830,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
HsRecFieldCon {} -> arg_in_scope lbl
_other -> True ]
; addUsedGREs dot_dot_gres
; addUsedGREs NoDeprecationWarnings dot_dot_gres
; let locn = noAnnSrcSpan loc
; return [ L (noAnnSrcSpan loc) (HsFieldBind
{ hfbAnn = noAnn
......
......@@ -357,7 +357,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
case mb_iface of
Just iface -> do
-- Try and find the required name in the exports
let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name
let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name
, is_qual = False, is_dloc = noSrcSpan }
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv
......
......@@ -1095,8 +1095,14 @@ instance Diagnostic TcRnMessage where
, pprWarningTxtForMsg pragma_warning_msg ]
where
impMsg = text "imported from" <+> ppr pragma_warning_import_mod <> extra
extra | pragma_warning_import_mod == pragma_warning_defined_mod = empty
extra | maybe True (pragma_warning_import_mod ==) pragma_warning_defined_mod = empty
| otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod
TcRnDifferentExportWarnings name locs
-> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages",
text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)]
TcRnIncompleteExportWarnings name locs
-> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "will not have its export warned about",
text "missing export warning at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)]
TcRnIllegalHsigDefaultMethods name meths
-> mkSimpleDecorated $
text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file"
......@@ -2180,6 +2186,10 @@ instance Diagnostic TcRnMessage where
-> WarningWithoutFlag
TcRnPragmaWarning{pragma_warning_msg}
-> WarningWithCategory (warningTxtCategory pragma_warning_msg)
TcRnDifferentExportWarnings _ _
-> ErrorWithoutFlag
TcRnIncompleteExportWarnings _ _
-> WarningWithFlag Opt_WarnIncompleteExportWarnings
TcRnIllegalHsigDefaultMethods{}
-> ErrorWithoutFlag
TcRnHsigFixityMismatch{}
......@@ -2818,6 +2828,10 @@ instance Diagnostic TcRnMessage where
-> [SuggestSpecialiseVisibilityHints name]
TcRnPragmaWarning{}
-> noHints
TcRnDifferentExportWarnings _ _
-> noHints
TcRnIncompleteExportWarnings _ _
-> noHints
TcRnIllegalHsigDefaultMethods{}
-> noHints
TcRnIllegalQuasiQuotes{}
......@@ -3074,13 +3088,13 @@ instance Diagnostic TcRnMessage where
TcRnRedundantSourceImport{}
-> noHints
TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) ->
let mod = is_mod is
let mod_name = moduleName $ is_mod is
occ = rdrNameOcc $ ieName ie
in case k of
BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod]
BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name]
BadImportNotExported -> noHints
BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword (is_mod is)]
BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (is_mod is, patsyns_enabled)) par]
BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name]
BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par]
BadImportNotExportedSubordinates{} -> noHints
TcRnImportLookup{}
-> noHints
......@@ -3272,7 +3286,7 @@ dodgy_msg kind tc ie
, text "but it is not a type constructor or a class" ]
dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn
dodgy_msg_insert tc_gre = IEThingAll noAnn ii
dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii
where
ii = noLocA (IEName noExtField $ noLocA $ greName tc_gre)
......@@ -5322,7 +5336,7 @@ pprImportLookup = \case
let
pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc
pprImpDeclSpec iface decl_spec =
quotes (ppr (is_mod decl_spec)) <+> case mi_boot iface of
quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of
IsBoot -> text "(hi-boot interface)"
NotBoot -> empty
withContext msgs =
......
......@@ -2528,9 +2528,31 @@ data TcRnMessage where
pragma_warning_occ :: OccName,
pragma_warning_msg :: WarningTxt GhcRn,
pragma_warning_import_mod :: ModuleName,
pragma_warning_defined_mod :: ModuleName
pragma_warning_defined_mod :: Maybe ModuleName
} -> TcRnMessage
{-| TcRnDifferentExportWarnings is an error that occurs when the
warning messages for exports of a name differ between several export items.
Test case:
DifferentExportWarnings
-}
TcRnDifferentExportWarnings :: !Name -- ^ The name with different export warnings
-> NE.NonEmpty SrcSpan -- ^ The locations of export list items that differ
-- from the one at which the error is reported
-> TcRnMessage
{-| TcRnIncompleteExportWarnings is a warning (controlled by -Wincomplete-export-warnings) that
occurs when some of the exports of a name do not have an export warning and some do
Test case:
ExportWarnings6
-}
TcRnIncompleteExportWarnings :: !Name -- ^ The name that is exported
-> NE.NonEmpty SrcSpan -- ^ The locations of export list items that are
-- missing the export warning
-> TcRnMessage
{-| TcRnIllegalHsigDefaultMethods is an error that occurs when a binding for
a class default method is provided in a Backpack signature file.
......
......@@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs) where
......@@ -15,12 +16,14 @@ import GHC.Tc.Utils.Env
( TyThing(AConLike, AnId), tcLookupGlobal, tcLookupTyCon )
import GHC.Tc.Utils.TcType
import GHC.Rename.Doc
import GHC.Rename.Module
import GHC.Rename.Names
import GHC.Rename.Env
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Utils.Error
import GHC.Unit.Module
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Warnings
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Utils.Panic
......@@ -33,7 +36,7 @@ import GHC.Driver.DynFlags
import GHC.Parser.PostProcess ( setRdrNameSpace )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Types.Unique.Set
import GHC.Types.Unique.Map
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name
import GHC.Types.Name.Env
......@@ -48,6 +51,7 @@ import Control.Arrow ( first )
import Control.Monad ( when )
import qualified Data.List.NonEmpty as NE
import Data.Traversable ( for )
import Data.List ( sortBy )
{-
************************************************************************
......@@ -133,22 +137,34 @@ into @[C{C, T;}, T{T, D;}]@ (which satisfies the AvailTC invariant).
data ExportAccum -- The type of the accumulating parameter of
-- the main worker function in rnExports
= ExportAccum
ExportOccMap -- Tracks exported occurrence names
(UniqSet ModuleName) -- Tracks (re-)exported module names
= ExportAccum {
expacc_exp_occs :: ExportOccMap,
-- ^ Tracks exported occurrence names
expacc_mods :: UniqMap ModuleName [Name],
-- ^ Tracks (re-)exported module names
-- and the names they re-export
expacc_warn_spans :: ExportWarnSpanNames,
-- ^ Information about warnings for names
expacc_dont_warn :: DontWarnExportNames
-- ^ What names not to export warnings for
-- (because they are exported without a warning)
}
emptyExportAccum :: ExportAccum
emptyExportAccum = ExportAccum emptyOccEnv emptyUniqSet
emptyExportAccum = ExportAccum emptyOccEnv emptyUniqMap [] emptyNameEnv
accumExports :: (ExportAccum -> x -> TcRn (Maybe (ExportAccum, y)))
accumExports :: (ExportAccum -> x -> TcRn (ExportAccum, Maybe y))
-> [x]
-> TcRn [y]
accumExports f = fmap (catMaybes . snd) . mapAccumLM f' emptyExportAccum
where f' acc x = do
m <- attemptM (f acc x)
pure $ case m of
Just (Just (acc', y)) -> (acc', Just y)
_ -> (acc, Nothing)
-> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames)
accumExports f xs = do
(ExportAccum _ _ export_warn_spans dont_warn_export, ys)
<- mapAccumLM f' emptyExportAccum xs
return ( catMaybes ys
, export_warn_spans
, dont_warn_export )
where f' acc x
= fromMaybe (acc, Nothing) <$> attemptM (f acc x)
type ExportOccMap = OccEnv (Name, IE GhcPs)
-- Tracks what a particular exported OccName
......@@ -173,6 +189,7 @@ rnExports explicit_mod exports
TcGblEnv { tcg_mod = this_mod
, tcg_rdr_env = rdr_env
, tcg_imports = imports
, tcg_warns = warns
, tcg_src = hsc_src } = tcg_env
default_main | mainModIs (hsc_HUE hsc_env) == this_mod
, Just main_fun <- mainFunIs dflags
......@@ -188,7 +205,7 @@ rnExports explicit_mod exports
; let real_exports
| explicit_mod = exports
| has_main
= Just (noLocA [noLocA (IEVar noExtField
= Just (noLocA [noLocA (IEVar Nothing
(noLocA (IEName noExtField $ noLocA default_main)))])
-- ToDo: the 'noLoc' here is unhelpful if 'main'
-- turns out to be out of scope
......@@ -196,7 +213,7 @@ rnExports explicit_mod exports
-- Rename the export list
; let do_it = exports_from_avail real_exports rdr_env imports this_mod
; (rn_exports, final_avails)
; (rn_exports, final_avails, new_export_warns)
<- if hsc_src == HsigFile
then do (mb_r, msgs) <- tryTc do_it
case mb_r of
......@@ -214,7 +231,17 @@ rnExports explicit_mod exports
Nothing -> Nothing
Just _ -> rn_exports
, tcg_dus = tcg_dus tcg_env `plusDU`
usesOnly final_ns }) }
usesOnly final_ns
, tcg_warns = insertWarnExports
warns new_export_warns}) }
-- | List of names and the information about their warnings
-- (warning, export list item span)
type ExportWarnSpanNames = [(Name, WarningTxt GhcRn, SrcSpan)]
-- | Map from names that should not have export warnings to
-- the spans of export list items that are missing those warnings
type DontWarnExportNames = NameEnv (NE.NonEmpty SrcSpan)
exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
-- ^ 'Nothing' means no explicit export list
......@@ -224,8 +251,8 @@ exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
-- @module Foo@ export is valid (it's not valid
-- if we didn't import @Foo@!)
-> Module
-> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
-- (Nothing, _) <=> no explicit export list
-> RnM (Maybe [(LIE GhcRn, Avails)], Avails, ExportWarnNames GhcRn)
-- (Nothing, _, _) <=> no explicit export list
-- if explicit export list is present it contains
-- each renamed export item together with its exported
-- names.
......@@ -240,7 +267,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
; let avails =
map fix_faminst . gresToAvailInfo
. filter isLocalGRE . globalRdrEnvElts $ rdr_env
; return (Nothing, avails) }
; return (Nothing, avails, []) }
where
-- #11164: when we define a data instance
-- but not data family, re-export the family
......@@ -256,12 +283,14 @@ exports_from_avail Nothing rdr_env _imports _this_mod
exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= do ie_avails <- accumExports do_litem rdr_items
= do (ie_avails, export_warn_spans, dont_warn_export)
<- accumExports do_litem rdr_items
let final_exports = nubAvails (concatMap snd ie_avails) -- Combine families
return (Just ie_avails, final_exports)
export_warn_names <- aggregate_warnings export_warn_spans dont_warn_export
return (Just ie_avails, final_exports, export_warn_names)
where
do_litem :: ExportAccum -> LIE GhcPs
-> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))
-> RnM (ExportAccum, Maybe (LIE GhcRn, Avails))
do_litem acc lie = setSrcSpan (getLocA lie) (exports_from_item acc lie)
-- Maps a parent to its in-scope children
......@@ -282,30 +311,45 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
, imv <- importedByUser xs ]
exports_from_item :: ExportAccum -> LIE GhcPs
-> RnM (Maybe (ExportAccum, (LIE GhcRn, Avails)))
exports_from_item (ExportAccum occs earlier_mods)
(L loc ie@(IEModuleContents _ lmod@(L _ mod)))
| mod `elementOfUniqSet` earlier_mods -- Duplicate export of M
-> RnM (ExportAccum, Maybe (LIE GhcRn, Avails))
exports_from_item expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_mods = earlier_mods,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
} (L loc ie@(IEModuleContents (warn_txt_ps, _) lmod@(L _ mod)))
| Just exported_names <- lookupUniqMap earlier_mods mod -- Duplicate export of M
= do { addDiagnostic (TcRnDupeModuleExport mod)
; return Nothing}
; (export_warn_spans', dont_warn_export', _) <-
process_warning export_warn_spans
dont_warn_export
exported_names
warn_txt_ps
(locA loc)
-- Checks if all the names are exported with the same warning message
-- or if they should not be warned about
; return ( expacc{ expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, Nothing ) }
| otherwise
= do { let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
; new_gres = [ gre'
| (gre, _) <- gre_prs
, gre' <- expand_tyty_gre gre ]
; new_exports = map availFromGRE new_gres
; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
; mods = addOneToUniqSet earlier_mods mod
= do { let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
; new_gres = [ gre'
| (gre, _) <- gre_prs
, gre' <- expand_tyty_gre gre ]
; new_exports = map availFromGRE new_gres
; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
; exported_names = map greName new_gres
; mods = addToUniqMap earlier_mods mod exported_names
}
; checkErr exportValid (TcRnExportedModNotImported mod)
; warnIf (exportValid && null gre_prs) (TcRnNullExportedModule mod)
; traceRn "efa" (ppr mod $$ ppr all_gres)
; addUsedGREs all_gres
; addUsedGREs ExportDeprecationWarnings all_gres
; occs' <- check_occs occs ie new_gres
-- This check_occs not only finds conflicts
......@@ -314,54 +358,114 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
-- 'M.x' is in scope in several ways, we'll have
-- several members of mod_avails with the same
-- OccName.
; (export_warn_spans', dont_warn_export', warn_txt_rn) <-
process_warning export_warn_spans
dont_warn_export
exported_names
warn_txt_ps
(locA loc)
; traceRn "export_mod"
(vcat [ ppr mod
, ppr new_exports ])
; return $ Just $
( ExportAccum occs' mods
, ( L loc (IEModuleContents noExtField lmod)
, new_exports) ) }
exports_from_item acc@(ExportAccum occs mods) (L loc ie) = do
m_new_ie <- lookup_doc_ie ie
case m_new_ie of
Just new_ie -> return $ Just (acc, (L loc new_ie, []))
; return ( ExportAccum { expacc_exp_occs = occs'
, expacc_mods = mods
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, Just (L loc (IEModuleContents warn_txt_rn lmod), new_exports) ) }
exports_from_item acc lie = do
m_doc_ie <- lookup_doc_ie lie
case m_doc_ie of
Just new_ie -> return (acc, Just (new_ie, []))
Nothing -> do
let finish (occs', new_ie, avail) = (ExportAccum occs' mods, (L loc new_ie, [avail]))
fmap finish <$> lookup_ie occs ie
m_ie <- lookup_ie acc lie
case m_ie of
Nothing -> return (acc, Nothing)
Just (acc', new_ie, avail)
-> return (acc', Just (new_ie, [avail]))
-------------
lookup_ie :: ExportOccMap -> IE GhcPs -> RnM (Maybe (ExportOccMap, IE GhcRn, AvailInfo))
lookup_ie occs ie@(IEVar ann l)
lookup_ie :: ExportAccum -> LIE GhcPs -> RnM (Maybe (ExportAccum, LIE GhcRn, AvailInfo))
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
} (L loc ie@(IEVar warn_txt_ps l))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ gre -> do
let avail = availFromGRE gre
name = greName gre
occs' <- check_occs occs ie [gre]
return (occs', IEVar ann (replaceLWrappedName l name), avail)
lookup_ie occs ie@(IEThingAbs ann l)
occs' <- check_occs occs ie [gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
[name]
warn_txt_ps
(locA loc)
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEVar warn_txt_rn (replaceLWrappedName l name))
, avail )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
} (L loc ie@(IEThingAbs (warn_txt_ps, ann) l))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ gre -> do
let avail = availFromGRE gre
name = greName gre
occs' <- check_occs occs ie [gre]
return ( occs'
, IEThingAbs ann (replaceLWrappedName l name)
, avail)
lookup_ie occs ie@(IEThingAll ann l)
occs' <- check_occs occs ie [gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
[name]
warn_txt_ps
(locA loc)
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingAbs (warn_txt_rn, ann) (replaceLWrappedName l name))
, avail )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
} (L loc ie@(IEThingAll (warn_txt_ps, ann) l))
= do mb_gre <- lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ par -> do
all_kids <- lookup_ie_kids_all ie l par
let name = greName par
kids_avails = map greName all_kids
occs' <- check_occs occs ie (par:all_kids)
return ( occs'
, IEThingAll ann (replaceLWrappedName l name)
, AvailTC name (name:kids_avails))
lookup_ie occs ie@(IEThingWith ann l wc sub_rdrs)
all_gres = par : all_kids
all_names = map greName all_gres
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
all_names
warn_txt_ps
(locA loc)
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingAll (warn_txt_rn, ann) (replaceLWrappedName l name))
, AvailTC name all_names )
lookup_ie expacc@ExportAccum{
expacc_exp_occs = occs,
expacc_warn_spans = export_warn_spans,
expacc_dont_warn = dont_warn_export
} (L loc ie@(IEThingWith (warn_txt_ps, ann) l wc sub_rdrs))
= do mb_gre <- addExportErrCtxt ie
$ lookupGreAvailRn $ lieWrappedName l
for mb_gre $ \ par -> do
......@@ -376,11 +480,22 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
let name = greName par
all_kids = with_kids ++ wc_kids
kids_avails = map greName all_kids
occs' <- check_occs occs ie (par:all_kids)
return ( occs'
, IEThingWith ann (replaceLWrappedName l name) wc subs
, AvailTC name (name:kids_avails))
all_gres = par : all_kids
all_names = map greName all_gres
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
all_names
warn_txt_ps
(locA loc)
return ( expacc{ expacc_exp_occs = occs'
, expacc_warn_spans = export_warn_spans'
, expacc_dont_warn = dont_warn_export' }
, L loc (IEThingWith (warn_txt_rn, ann) (replaceLWrappedName l name) wc subs)
, AvailTC name all_names )
lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier
......@@ -407,21 +522,102 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
; return gres }
-------------
lookup_doc_ie :: IE GhcPs -> RnM (Maybe (IE GhcRn))
lookup_doc_ie (IEGroup _ lev doc) = do
rn_warning_txt_loc :: LocatedP (WarningTxt GhcPs) -> RnM (LocatedP (WarningTxt GhcRn))
rn_warning_txt_loc (L loc warn_txt) = L loc <$> rnWarningTxt warn_txt
-- Runs for every Name
-- - If there is no new warning, flags that the old warning should not be
-- included (since a warning should only be emitted if all
-- of the export statements have a warning)
-- - If the Name already has a warning, adds it
process_warning :: ExportWarnSpanNames -- Old aggregate data about warnins
-> DontWarnExportNames -- Old names not to warn about
-> [Name] -- Names to warn about
-> Maybe (LocatedP (WarningTxt GhcPs)) -- Warning
-> SrcSpan -- Span of the export list item
-> RnM (ExportWarnSpanNames, -- Aggregate data about the warnings
DontWarnExportNames, -- Names not to warn about in the end
-- (when there was a non-warned export)
Maybe (LocatedP (WarningTxt GhcRn))) -- Renamed warning
process_warning export_warn_spans
dont_warn_export
names Nothing loc
= return ( export_warn_spans
, foldr update_dont_warn_export
dont_warn_export names
, Nothing )
where
update_dont_warn_export :: Name -> DontWarnExportNames -> DontWarnExportNames
update_dont_warn_export name dont_warn_export'
= extendNameEnv_Acc (NE.<|)
NE.singleton
dont_warn_export'
name
loc
process_warning export_warn_spans
dont_warn_export
names (Just warn_txt_ps) loc
= do
warn_txt_rn <- rn_warning_txt_loc warn_txt_ps
let new_export_warn_spans = map (, unLoc warn_txt_rn, loc) names
return ( new_export_warn_spans ++ export_warn_spans
, dont_warn_export
, Just warn_txt_rn )
-- For each name exported with any warnings throws an error
-- if there are any exports of that name with a different warning
aggregate_warnings :: ExportWarnSpanNames
-> DontWarnExportNames
-> RnM (ExportWarnNames GhcRn)
aggregate_warnings export_warn_spans dont_warn_export
= fmap catMaybes
$ mapM (aggregate_single . extract_name)
$ NE.groupBy (\(n1, _, _) (n2, _, _) -> n1 == n2)
$ sortBy (\(n1, _, _) (n2, _, _) -> n1 `compare` n2) export_warn_spans
where
extract_name :: NE.NonEmpty (Name, WarningTxt GhcRn, SrcSpan)
-> (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
extract_name l@((name, _, _) NE.:| _)
= (name, NE.map (\(_, warn_txt, span) -> (warn_txt, span)) l)
aggregate_single :: (Name, NE.NonEmpty (WarningTxt GhcRn, SrcSpan))
-> RnM (Maybe (Name, WarningTxt GhcRn))
aggregate_single (name, (warn_txt_rn, loc) NE.:| warn_spans)
= do
-- Emit an error if the warnings differ
case NE.nonEmpty spans_different of
Nothing -> return ()
Just spans_different
-> addErrAt loc (TcRnDifferentExportWarnings name spans_different)
-- Emit a warning if some export list items do not have a warning
case lookupNameEnv dont_warn_export name of
Nothing -> return $ Just (name, warn_txt_rn)
Just not_warned_spans -> do
addDiagnosticAt loc (TcRnIncompleteExportWarnings name not_warned_spans)
return Nothing
where
spans_different = map snd $ filter (not . warningTxtSame warn_txt_rn . fst) warn_spans
-------------
lookup_doc_ie :: LIE GhcPs -> RnM (Maybe (LIE GhcRn))
lookup_doc_ie (L loc (IEGroup _ lev doc)) = do
doc' <- rnLHsDoc doc
pure $ Just (IEGroup noExtField lev doc')
lookup_doc_ie (IEDoc _ doc) = do
pure $ Just (L loc (IEGroup noExtField lev doc'))
lookup_doc_ie (L loc (IEDoc _ doc)) = do
doc' <- rnLHsDoc doc
pure $ Just (IEDoc noExtField doc')
lookup_doc_ie (IEDocNamed _ str) = pure $ Just (IEDocNamed noExtField str)
pure $ Just (L loc (IEDoc noExtField doc'))
lookup_doc_ie (L loc (IEDocNamed _ str))
= pure $ Just (L loc (IEDocNamed noExtField str))
lookup_doc_ie _ = pure Nothing
-- In an export item M.T(A,B,C), we want to treat the uses of
-- A,B,C as if they were M.A, M.B, M.C
-- Happily pickGREs does just the right thing
addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
addUsedKids parent_rdr kid_gres
= addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
-- Renaming and typechecking of exports happens after everything else has
-- been typechecked.
......@@ -503,7 +699,8 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
doOne n = do
let bareName = (ieWrappedName . unLoc) n
lkup v = lookupSubBndrOcc_helper False DisableDeprecationWarnings -- Do not report export list deprecations
-- Do not report export list declaration deprecations
lkup v = lookupSubBndrOcc_helper False ExportDeprecationWarnings
spec_parent (setRdrNameSpace bareName v)
name <- combineChildLookupResult $ map lkup $
......
......@@ -54,7 +54,7 @@ import GHC.Tc.Gen.Bind ( tcLocalBinds )
import GHC.Tc.Instance.Family ( tcGetFamInstEnvs )
import GHC.Core.FamInstEnv ( FamInstEnvs )
import GHC.Rename.Expr ( mkExpandedExpr )
import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls, DeprecationWarnings(EnableDeprecationWarnings) )
import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls, DeprecationWarnings(..) )
import GHC.Tc.Utils.Env
import GHC.Tc.Gen.Arrow
import GHC.Tc.Gen.Match
......@@ -1423,7 +1423,7 @@ disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty
-- Mark the record fields as used, now that we have disambiguated.
-- There is no risk of duplicate deprecation warnings, as we have
-- not marked the GREs as used previously.
; setSrcSpanA loc $ mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre
; setSrcSpanA loc $ mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
; sel <- tcLookupId (greName fld_gre)
; return $ L l HsFieldBind
{ hfbAnn = hfbAnn upd
......
......@@ -23,7 +23,7 @@ import GHC.Tc.Utils.TcMType
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping)
import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
import GHC.Rename.Env( addUsedGRE, DeprecationWarnings(EnableDeprecationWarnings) )
import GHC.Rename.Env( addUsedGRE, DeprecationWarnings (..) )
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
......@@ -942,7 +942,7 @@ matchHasField dflags short_cut clas tys
-- it must not be higher-rank.
; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty
then do { -- See Note [Unused name reporting and HasField]
addUsedGRE EnableDeprecationWarnings gre
addUsedGRE AllDeprecationWarnings gre
; keepAlive (greName gre)
; return OneInst { cir_new_theta = theta
, cir_mk_ev = mk_ev
......
......@@ -1691,7 +1691,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
-- tcg_dus: see Note [Newtype constructor usage in foreign declarations]
-- See Note [Newtype constructor usage in foreign declarations]
addUsedGREs (bagToList fo_gres) ;
addUsedGREs NoDeprecationWarnings (bagToList fo_gres) ;
return (tcg_env', tcl_env)
}}}}}}
......
......@@ -198,6 +198,7 @@ import Data.List ( mapAccumL )
import Data.Foldable
import qualified Data.Semigroup as S
import GHC.Types.SrcLoc
import GHC.Rename.Env
#if defined(DEBUG)
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
......@@ -1372,7 +1373,7 @@ tcLookupTyCon n = wrapTcS $ TcM.tcLookupTyCon n
-- might), so it's not worth losing sleep over.
recordUsedGREs :: Bag GlobalRdrElt -> TcS ()
recordUsedGREs gres
= do { wrapTcS $ TcM.addUsedGREs gre_list
= do { wrapTcS $ TcM.addUsedGREs NoDeprecationWarnings gre_list
-- If a newtype constructor was imported, don't warn about not
-- importing it...
; wrapTcS $ traverse_ (TcM.keepAlive . greName) gre_list }
......