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
  • taimoorzaeem/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
  • rmullanix/ghc
  • GunpowderGuy/ghc
653 results
Show changes
Showing
with 756 additions and 469 deletions
...@@ -108,7 +108,11 @@ rnUnboundVar v ...@@ -108,7 +108,11 @@ rnUnboundVar v
then -- Treat this as a "hole" then -- Treat this as a "hole"
-- Do not fail right now; instead, return HsUnboundVar -- Do not fail right now; instead, return HsUnboundVar
-- and let the type checker report the error -- and let the type checker report the error
return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs) do { let occ = rdrNameOcc v
; uv <- if startsWithUnderscore occ
then return (TrueExprHole occ)
else OutOfScope occ <$> getGlobalRdrEnv
; return (HsUnboundVar noExtField uv, emptyFVs) }
else -- Fail immediately (qualified name) else -- Fail immediately (qualified name)
do { n <- reportUnboundName v do { n <- reportUnboundName v
...@@ -1500,7 +1504,7 @@ ApplicativeDo touches a few phases in the compiler: ...@@ -1500,7 +1504,7 @@ ApplicativeDo touches a few phases in the compiler:
scheduled as outlined above and transformed into applicative scheduled as outlined above and transformed into applicative
combinators. However, the code is still represented as a do-block combinators. However, the code is still represented as a do-block
with special forms of applicative statements. This allows us to with special forms of applicative statements. This allows us to
recover the original do-block when e.g. printing type errors, where recover the original do-block when e.g. printing type errors, where
we don't want to show any of the applicative combinators since they we don't want to show any of the applicative combinators since they
don't exist in the source code. don't exist in the source code.
See ApplicativeStmt and ApplicativeArg in HsExpr. See ApplicativeStmt and ApplicativeArg in HsExpr.
...@@ -1684,7 +1688,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op ...@@ -1684,7 +1688,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op
, is_body_stmt = False , is_body_stmt = False
, fail_operator = fail_op}] , fail_operator = fail_op}]
False tail' False tail'
stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_))
tail _tail_fvs tail _tail_fvs
| (False,tail') <- needJoin monad_names tail | (False,tail') <- needJoin monad_names tail
= mkApplicativeStmt ctxt = mkApplicativeStmt ctxt
...@@ -1693,7 +1697,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) ...@@ -1693,7 +1697,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)
, app_arg_pattern = nlWildPatName , app_arg_pattern = nlWildPatName
, arg_expr = rhs , arg_expr = rhs
, is_body_stmt = True , is_body_stmt = True
, fail_operator = fail_op}] False tail' , fail_operator = noSyntaxExpr}] False tail'
stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs =
return (s : tail, emptyNameSet) return (s : tail, emptyNameSet)
...@@ -1708,7 +1712,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do ...@@ -1708,7 +1712,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees
let (stmts', fvss) = unzip pairs let (stmts', fvss) = unzip pairs
let (need_join, tail') = let (need_join, tail') =
if any hasStrictPattern trees -- See Note [ApplicativeDo and refutable patterns]
if any hasRefutablePattern stmts'
then (True, tail) then (True, tail)
else needJoin monad_names tail else needJoin monad_names tail
...@@ -1723,13 +1728,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do ...@@ -1723,13 +1728,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
, is_body_stmt = False , is_body_stmt = False
, fail_operator = fail_op , fail_operator = fail_op
}, emptyFVs) }, emptyFVs)
stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) =
return (ApplicativeArgOne return (ApplicativeArgOne
{ xarg_app_arg_one = noExtField { xarg_app_arg_one = noExtField
, app_arg_pattern = nlWildPatName , app_arg_pattern = nlWildPatName
, arg_expr = exp , arg_expr = exp
, is_body_stmt = True , is_body_stmt = True
, fail_operator = fail_op , fail_operator = noSyntaxExpr
}, emptyFVs) }, emptyFVs)
stmtTreeArg ctxt tail_fvs tree = do stmtTreeArg ctxt tail_fvs tree = do
let stmts = flattenStmtTree tree let stmts = flattenStmtTree tree
...@@ -1856,12 +1861,19 @@ isStrictPattern lpat = ...@@ -1856,12 +1861,19 @@ isStrictPattern lpat =
SplicePat{} -> True SplicePat{} -> True
_otherwise -> panic "isStrictPattern" _otherwise -> panic "isStrictPattern"
hasStrictPattern :: ExprStmtTree -> Bool {-
hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat Note [ApplicativeDo and refutable patterns]
hasStrictPattern (StmtTreeOne _) = False
hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b Refutable patterns in do blocks are desugared to use the monadic 'fail' operation.
hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees This means that sometimes an applicative block needs to be wrapped in 'join' simply because
of a refutable pattern, in order for the types to work out.
-}
hasRefutablePattern :: ApplicativeArg GhcRn -> Bool
hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat
, is_body_stmt = False}) = not (isIrrefutableHsPat pat)
hasRefutablePattern _ = False
isLetStmt :: LStmt a b -> Bool isLetStmt :: LStmt a b -> Bool
isLetStmt (L _ LetStmt{}) = True isLetStmt (L _ LetStmt{}) = True
......
...@@ -377,6 +377,9 @@ rnImportDecl this_mod ...@@ -377,6 +377,9 @@ rnImportDecl this_mod
_ -> return () _ -> return ()
) )
-- Complain about -Wcompat-unqualified-imports violations.
warnUnqualifiedImport decl iface
let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe' let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe'
, ideclHiding = new_imp_details }) , ideclHiding = new_imp_details })
...@@ -484,6 +487,40 @@ calculateAvails dflags iface mod_safe' want_boot imported_by = ...@@ -484,6 +487,40 @@ calculateAvails dflags iface mod_safe' want_boot imported_by =
} }
-- | Issue a warning if the user imports Data.List without either an import
-- list or `qualified`. This is part of the migration plan for the
-- `Data.List.singleton` proposal. See #17244.
warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM ()
warnUnqualifiedImport decl iface =
whenWOptM Opt_WarnCompatUnqualifiedImports
$ when bad_import
$ addWarnAt (Reason Opt_WarnCompatUnqualifiedImports) loc warning
where
mod = mi_module iface
loc = getLoc $ ideclName decl
is_qual = isImportDeclQualified (ideclQualified decl)
has_import_list =
-- We treat a `hiding` clause as not having an import list although
-- it's not entirely clear this is the right choice.
case ideclHiding decl of
Just (False, _) -> True
_ -> False
bad_import =
mod `elemModuleSet` qualifiedMods
&& not is_qual
&& not has_import_list
warning = vcat
[ text "To ensure compatibility with future core libraries changes"
, text "imports to" <+> ppr (ideclName decl) <+> text "should be"
, text "either qualified or have an explicit import list."
]
-- Modules for which we warn if we see unqualified imports
qualifiedMods = mkModuleSet [ dATA_LIST ]
warnRedundantSourceImport :: ModuleName -> SDoc warnRedundantSourceImport :: ModuleName -> SDoc
warnRedundantSourceImport mod_name warnRedundantSourceImport mod_name
= text "Unnecessary {-# SOURCE #-} in the import of module" = text "Unnecessary {-# SOURCE #-} in the import of module"
...@@ -598,9 +635,12 @@ extendGlobalRdrEnvRn avails new_fixities ...@@ -598,9 +635,12 @@ extendGlobalRdrEnvRn avails new_fixities
| otherwise | otherwise
= return (extendGlobalRdrEnv env gre) = return (extendGlobalRdrEnv env gre)
where where
name = gre_name gre occ = greOccName gre
occ = nameOccName name dups = filter isDupGRE (lookupGlobalRdrEnv env occ)
dups = filter isLocalGRE (lookupGlobalRdrEnv env occ) -- Duplicate GREs are those defined locally with the same OccName,
-- except cases where *both* GREs are DuplicateRecordFields (#17965).
isDupGRE gre' = isLocalGRE gre'
&& not (isOverloadedRecFldGRE gre && isOverloadedRecFldGRE gre')
{- ********************************************************************* {- *********************************************************************
...@@ -1574,9 +1614,8 @@ printMinimalImports imports_w_usage ...@@ -1574,9 +1614,8 @@ printMinimalImports imports_w_usage
= do { imports' <- getMinimalImports imports_w_usage = do { imports' <- getMinimalImports imports_w_usage
; this_mod <- getModule ; this_mod <- getModule
; dflags <- getDynFlags ; dflags <- getDynFlags
; liftIO $ ; liftIO $ withFile (mkFilename dflags this_mod) WriteMode $ \h ->
do { h <- openFile (mkFilename dflags this_mod) WriteMode printForUser dflags h neverQualify (vcat (map ppr imports'))
; printForUser dflags h neverQualify (vcat (map ppr imports')) }
-- The neverQualify is important. We are printing Names -- The neverQualify is important. We are printing Names
-- but they are in the context of an 'import' decl, and -- but they are in the context of an 'import' decl, and
-- we never qualify things inside there -- we never qualify things inside there
...@@ -1732,14 +1771,13 @@ addDupDeclErr gres@(gre : _) ...@@ -1732,14 +1771,13 @@ addDupDeclErr gres@(gre : _)
= addErrAt (getSrcSpan (last sorted_names)) $ = addErrAt (getSrcSpan (last sorted_names)) $
-- Report the error at the later location -- Report the error at the later location
vcat [text "Multiple declarations of" <+> vcat [text "Multiple declarations of" <+>
quotes (ppr (nameOccName name)), quotes (ppr (greOccName gre)),
-- NB. print the OccName, not the Name, because the -- NB. print the OccName, not the Name, because the
-- latter might not be in scope in the RdrEnv and so will -- latter might not be in scope in the RdrEnv and so will
-- be printed qualified. -- be printed qualified.
text "Declared at:" <+> text "Declared at:" <+>
vcat (map (ppr . nameSrcLoc) sorted_names)] vcat (map (ppr . nameSrcLoc) sorted_names)]
where where
name = gre_name gre
sorted_names = sortWith nameSrcLoc (map gre_name gres) sorted_names = sortWith nameSrcLoc (map gre_name gres)
......
...@@ -1141,7 +1141,7 @@ badRuleLhsErr name lhs bad_e ...@@ -1141,7 +1141,7 @@ badRuleLhsErr name lhs bad_e
text "LHS must be of form (f e1 .. en) where f is not forall'd" text "LHS must be of form (f e1 .. en) where f is not forall'd"
where where
err = case bad_e of err = case bad_e of
HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual uv) HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual (unboundVarOcc uv))
_ -> text "Illegal expression:" <+> ppr bad_e _ -> text "Illegal expression:" <+> ppr bad_e
{- ************************************************************** {- **************************************************************
...@@ -1837,7 +1837,7 @@ rnLDerivStrategy doc mds thing_inside ...@@ -1837,7 +1837,7 @@ rnLDerivStrategy doc mds thing_inside
do (via_ty', fvs1) <- rnHsSigType doc TypeLevel via_ty do (via_ty', fvs1) <- rnHsSigType doc TypeLevel via_ty
let HsIB { hsib_ext = via_imp_tvs let HsIB { hsib_ext = via_imp_tvs
, hsib_body = via_body } = via_ty' , hsib_body = via_body } = via_ty'
(via_exp_tv_bndrs, _, _) = splitLHsSigmaTy via_body (via_exp_tv_bndrs, _, _) = splitLHsSigmaTyInvis via_body
via_exp_tvs = hsLTyVarNames via_exp_tv_bndrs via_exp_tvs = hsLTyVarNames via_exp_tv_bndrs
via_tvs = via_imp_tvs ++ via_exp_tvs via_tvs = via_imp_tvs ++ via_exp_tvs
(thing, fvs2) <- extendTyVarEnvFVRn via_tvs thing_inside (thing, fvs2) <- extendTyVarEnvFVRn via_tvs thing_inside
......
...@@ -1181,7 +1181,7 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment ...@@ -1181,7 +1181,7 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
-- | Name of an operator in an operator application or section -- | Name of an operator in an operator application or section
data OpName = NormalOp Name -- ^ A normal identifier data OpName = NormalOp Name -- ^ A normal identifier
| NegateOp -- ^ Prefix negation | NegateOp -- ^ Prefix negation
| UnboundOp OccName -- ^ An unbound indentifier | UnboundOp UnboundVar -- ^ An unbound indentifier
| RecFldOp (AmbiguousFieldOcc GhcRn) | RecFldOp (AmbiguousFieldOcc GhcRn)
-- ^ A (possibly ambiguous) record field occurrence -- ^ A (possibly ambiguous) record field occurrence
...@@ -1348,7 +1348,7 @@ checkSectionPrec direction section op arg ...@@ -1348,7 +1348,7 @@ checkSectionPrec direction section op arg
lookupFixityOp :: OpName -> RnM Fixity lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp n) = lookupFixityRn n lookupFixityOp (NormalOp n) = lookupFixityRn n
lookupFixityOp NegateOp = lookupFixityRn negateName lookupFixityOp NegateOp = lookupFixityRn negateName
lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName u) lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (unboundVarOcc u))
lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
......
...@@ -68,7 +68,7 @@ import UniqFM ( UniqFM, mapUFM, filterUFM ) ...@@ -68,7 +68,7 @@ import UniqFM ( UniqFM, mapUFM, filterUFM )
import MonadUtils import MonadUtils
import NameCache import NameCache
import SrcLoc import SrcLoc
import Data.List import Data.List (intersperse, groupBy, sortBy)
import Data.Ord import Data.Ord
import Data.Dynamic import Data.Dynamic
import Data.IORef import Data.IORef
......
...@@ -79,11 +79,16 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds ...@@ -79,11 +79,16 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds
(final_usage, occ_anald_binds) = go init_env binds (final_usage, occ_anald_binds) = go init_env binds
(_, occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel (_, occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel
imp_rule_edges imp_rule_edges
(flattenBinds occ_anald_binds) (flattenBinds binds)
initial_uds initial_uds
-- It's crucial to re-analyse the glommed-together bindings -- It's crucial to re-analyse the glommed-together bindings
-- so that we establish the right loop breakers. Otherwise -- so that we establish the right loop breakers. Otherwise
-- we can easily create an infinite loop (#9583 is an example) -- we can easily create an infinite loop (#9583 is an example)
--
-- Also crucial to re-analyse the /original/ bindings
-- in case the first pass accidentally discarded as dead code
-- a binding that was actually needed (albeit before its
-- definition site). #17724 threw this up.
initial_uds = addManyOccsSet emptyDetails initial_uds = addManyOccsSet emptyDetails
(rulesFreeVars imp_rules) (rulesFreeVars imp_rules)
......
...@@ -69,7 +69,7 @@ import Unique ...@@ -69,7 +69,7 @@ import Unique
import UniqSet import UniqSet
import Outputable import Outputable
import Data.List import Data.List (mapAccumL)
import FastString import FastString
#include "HsVersions.h" #include "HsVersions.h"
......
...@@ -1003,18 +1003,17 @@ notWorthFloating e abs_vars ...@@ -1003,18 +1003,17 @@ notWorthFloating e abs_vars
go (Tick t e) n = not (tickishIsCode t) && go e n go (Tick t e) n = not (tickishIsCode t) && go e n
go (Cast e _) n = go e n go (Cast e _) n = go e n
go (App e arg) n go (App e arg) n
| Type {} <- arg = go e n -- See Note [Floating applications to coercions]
| Coercion {} <- arg = go e n | Type {} <- arg = go e n
| n==0 = False | n==0 = False
| is_triv arg = go e (n-1) | is_triv arg = go e (n-1)
| otherwise = False | otherwise = False
go _ _ = False go _ _ = False
is_triv (Lit {}) = True -- Treat all literals as trivial is_triv (Lit {}) = True -- Treat all literals as trivial
is_triv (Var {}) = True -- (ie not worth floating) is_triv (Var {}) = True -- (ie not worth floating)
is_triv (Cast e _) = is_triv e is_triv (Cast e _) = is_triv e
is_triv (App e (Type {})) = is_triv e is_triv (App e (Type {})) = is_triv e -- See Note [Floating applications to coercions]
is_triv (App e (Coercion {})) = is_triv e
is_triv (Tick t e) = not (tickishIsCode t) && is_triv e is_triv (Tick t e) = not (tickishIsCode t) && is_triv e
is_triv _ = False is_triv _ = False
...@@ -1028,6 +1027,14 @@ Hence the litIsTrivial. ...@@ -1028,6 +1027,14 @@ Hence the litIsTrivial.
Ditto literal strings (LitString), which we'd like to float to top Ditto literal strings (LitString), which we'd like to float to top
level, which is now possible. level, which is now possible.
Note [Floating applications to coercions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We don’t float out variables applied only to type arguments, since the
extra binding would be pointless: type arguments are completely erased.
But *coercion* arguments aren’t (see Note [Coercion tokens] in
CoreToStg.hs and Note [Count coercion arguments in boring contexts] in
CoreUnfold.hs), so we still want to float out variables applied only to
coercion arguments.
Note [Escaping a value lambda] Note [Escaping a value lambda]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
...@@ -69,7 +69,7 @@ import Outputable ...@@ -69,7 +69,7 @@ import Outputable
import Util import Util
import UniqFM ( pprUniqFM ) import UniqFM ( pprUniqFM )
import Data.List import Data.List (mapAccumL)
{- {-
************************************************************************ ************************************************************************
......
...@@ -830,6 +830,21 @@ Ticks into the LHS, which makes matching trickier. #10665, #10745. ...@@ -830,6 +830,21 @@ Ticks into the LHS, which makes matching trickier. #10665, #10745.
Doing this to either side confounds tools like HERMIT, which seek to reason Doing this to either side confounds tools like HERMIT, which seek to reason
about and apply the RULES as originally written. See #10829. about and apply the RULES as originally written. See #10829.
There is, however, one case where we are pretty much /forced/ to transform the
LHS of a rule: postInlineUnconditionally. For instance, in the case of
let f = g @Int in f
We very much want to inline f into the body of the let. However, to do so (and
be able to safely drop f's binding) we must inline into all occurrences of f,
including those in the LHS of rules.
This can cause somewhat surprising results; for instance, in #18162 we found
that a rule template contained ticks in its arguments, because
postInlineUnconditionally substituted in a trivial expression that contains
ticks. See Note [Tick annotations in RULE matching] in GHC.Core.Rules for
details.
Note [No eta expansion in stable unfoldings] Note [No eta expansion in stable unfoldings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have a stable unfolding If we have a stable unfolding
...@@ -1251,6 +1266,10 @@ it's best to inline it anyway. We often get a=E; b=a from desugaring, ...@@ -1251,6 +1266,10 @@ it's best to inline it anyway. We often get a=E; b=a from desugaring,
with both a and b marked NOINLINE. But that seems incompatible with with both a and b marked NOINLINE. But that seems incompatible with
our new view that inlining is like a RULE, so I'm sticking to the 'active' our new view that inlining is like a RULE, so I'm sticking to the 'active'
story for now. story for now.
NB: unconditional inlining of this sort can introduce ticks in places that
may seem surprising; for instance, the LHS of rules. See Note [Simplfying
rules] for details.
-} -}
postInlineUnconditionally postInlineUnconditionally
......
...@@ -711,11 +711,15 @@ match :: RuleMatchEnv ...@@ -711,11 +711,15 @@ match :: RuleMatchEnv
-> CoreExpr -- Target -> CoreExpr -- Target
-> Maybe RuleSubst -> Maybe RuleSubst
-- We look through certain ticks. See note [Tick annotations in RULE matching] -- We look through certain ticks. See Note [Tick annotations in RULE matching]
match renv subst e1 (Tick t e2) match renv subst e1 (Tick t e2)
| tickishFloatable t | tickishFloatable t
= match renv subst' e1 e2 = match renv subst' e1 e2
where subst' = subst { rs_binds = rs_binds subst . mkTick t } where subst' = subst { rs_binds = rs_binds subst . mkTick t }
match renv subst (Tick t e1) e2
-- Ignore ticks in rule template.
| tickishFloatable t
= match renv subst e1 e2
match _ _ e@Tick{} _ match _ _ e@Tick{} _
= pprPanic "Tick in rule" (ppr e) = pprPanic "Tick in rule" (ppr e)
...@@ -1013,7 +1017,7 @@ Hence, (a) the guard (not (isLocallyBoundR v2)) ...@@ -1013,7 +1017,7 @@ Hence, (a) the guard (not (isLocallyBoundR v2))
Note [Tick annotations in RULE matching] Note [Tick annotations in RULE matching]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used to unconditionally look through Notes in both template and We used to unconditionally look through ticks in both template and
expression being matched. This is actually illegal for counting or expression being matched. This is actually illegal for counting or
cost-centre-scoped ticks, because we have no place to put them without cost-centre-scoped ticks, because we have no place to put them without
changing entry counts and/or costs. So now we just fail the match in changing entry counts and/or costs. So now we just fail the match in
...@@ -1022,7 +1026,12 @@ these cases. ...@@ -1022,7 +1026,12 @@ these cases.
On the other hand, where we are allowed to insert new cost into the On the other hand, where we are allowed to insert new cost into the
tick scope, we can float them upwards to the rule application site. tick scope, we can float them upwards to the rule application site.
cf Note [Notes in call patterns] in SpecConstr Moreover, we may encounter ticks in the template of a rule. There are a few
ways in which these may be introduced (e.g. #18162, #17619). Such ticks are
ignored by the matcher. See Note [Simplifying rules] in
GHC.Core.Opt.Simplify.Utils for details.
cf Note [Notes in call patterns] in GHC.Core.Opt.SpecConstr
Note [Matching lets] Note [Matching lets]
~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~
......
This diff is collapsed.
...@@ -198,6 +198,26 @@ import Control.Monad (ap) ...@@ -198,6 +198,26 @@ import Control.Monad (ap)
-- do we set CCCS from it; so we just slam in -- do we set CCCS from it; so we just slam in
-- dontCareCostCentre. -- dontCareCostCentre.
-- Note [Coercion tokens]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- In coreToStgArgs, we drop type arguments completely, but we replace
-- coercions with a special coercionToken# placeholder. Why? Consider:
--
-- f :: forall a. Int ~# Bool -> a
-- f = /\a. \(co :: Int ~# Bool) -> error "impossible"
--
-- If we erased the coercion argument completely, we’d end up with just
-- f = error "impossible", but then f `seq` () would be ⊥!
--
-- This is an artificial example, but back in the day we *did* treat
-- coercion lambdas like type lambdas, and we had bug reports as a
-- result. So now we treat coercion lambdas like value lambdas, but we
-- treat coercions themselves as zero-width arguments — coercionToken#
-- has representation VoidRep — which gets the best of both worlds.
--
-- (For the gory details, see also the (unpublished) paper, “Practical
-- aspects of evidence-based compilation in System FC.”)
-- -------------------------------------------------------------- -- --------------------------------------------------------------
-- Setting variable info: top-level, binds, RHSs -- Setting variable info: top-level, binds, RHSs
-- -------------------------------------------------------------- -- --------------------------------------------------------------
...@@ -384,8 +404,10 @@ coreToStgExpr (App (Lit LitRubbish) _some_unlifted_type) ...@@ -384,8 +404,10 @@ coreToStgExpr (App (Lit LitRubbish) _some_unlifted_type)
-- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in -- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in
-- a STG to Cmm pass. -- a STG to Cmm pass.
= coreToStgExpr (Var unitDataConId) = coreToStgExpr (Var unitDataConId)
coreToStgExpr (Var v) = coreToStgApp v [] [] coreToStgExpr (Var v) = coreToStgApp v [] []
coreToStgExpr (Coercion _) = coreToStgApp coercionTokenId [] [] coreToStgExpr (Coercion _)
-- See Note [Coercion tokens]
= coreToStgApp coercionTokenId [] []
coreToStgExpr expr@(App _ _) coreToStgExpr expr@(App _ _)
= coreToStgApp f args ticks = coreToStgApp f args ticks
...@@ -569,7 +591,7 @@ coreToStgArgs (Type _ : args) = do -- Type argument ...@@ -569,7 +591,7 @@ coreToStgArgs (Type _ : args) = do -- Type argument
(args', ts) <- coreToStgArgs args (args', ts) <- coreToStgArgs args
return (args', ts) return (args', ts)
coreToStgArgs (Coercion _ : args) -- Coercion argument; replace with place holder coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion tokens]
= do { (args', ts) <- coreToStgArgs args = do { (args', ts) <- coreToStgArgs args
; return (StgVarArg coercionTokenId : args', ts) } ; return (StgVarArg coercionTokenId : args', ts) }
......
...@@ -23,7 +23,7 @@ import CoreSeq ( seqBinds ) ...@@ -23,7 +23,7 @@ import CoreSeq ( seqBinds )
import Outputable import Outputable
import VarEnv import VarEnv
import BasicTypes import BasicTypes
import Data.List import Data.List ( mapAccumL, sortBy )
import DataCon import DataCon
import Id import Id
import CoreUtils ( exprIsHNF, exprType, exprIsTrivial, exprOkForSpeculation ) import CoreUtils ( exprIsHNF, exprType, exprIsTrivial, exprOkForSpeculation )
...@@ -333,7 +333,10 @@ io_hack_reqd scrut con bndrs ...@@ -333,7 +333,10 @@ io_hack_reqd scrut con bndrs
| (bndr:_) <- bndrs | (bndr:_) <- bndrs
, con == tupleDataCon Unboxed 2 , con == tupleDataCon Unboxed 2
, idType bndr `eqType` realWorldStatePrimTy , idType bndr `eqType` realWorldStatePrimTy
= not (exprOkForSpeculation scrut) , (fun, _) <- collectArgs scrut
= case fun of
Var f -> not (isPrimOpId f)
_ -> True
| otherwise | otherwise
= False = False
...@@ -384,18 +387,15 @@ getMaskingState# is not going to diverge or throw an exception! This ...@@ -384,18 +387,15 @@ getMaskingState# is not going to diverge or throw an exception! This
situation actually arises in GHC.IO.Handle.Internals.wantReadableHandle situation actually arises in GHC.IO.Handle.Internals.wantReadableHandle
(on an MVar not an Int), and made a material difference. (on an MVar not an Int), and made a material difference.
So if the scrutinee is ok-for-speculation, we *don't* apply the state hack, So if the scrutinee is a primop call, we *don't* apply the
because we are free to push evaluation of the scrutinee after evaluation of state hack:
expressions from the (single) case alternative.
A few examples for different scrutinees:
- If it is a simple, terminating one like getMaskingState, - If it is a simple, terminating one like getMaskingState,
applying the hack would be over-conservative. applying the hack is over-conservative.
- If the primop is raise# then it returns bottom (so not ok-for-speculation), - If the primop is raise# then it returns bottom, so
but the result from the case alternatives are discarded anyway. the case alternatives are already discarded.
- If the primop can raise a non-IO exception, like - If the primop can raise a non-IO exception, like
divide by zero (so not ok-for-speculation), then we are also bottoming out divide by zero or seg-fault (eg writing an array
anyway and don't mind evaluating 'x' first. out of bounds) then we don't mind evaluating 'x' first.
Note [Demand on the scrutinee of a product case] Note [Demand on the scrutinee of a product case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
...@@ -66,7 +66,7 @@ module Constraint ( ...@@ -66,7 +66,7 @@ module Constraint (
pprEvVars, pprEvVarWithType, pprEvVars, pprEvVarWithType,
-- holes -- holes
HoleSort(..), Hole(..), holeOcc,
) )
where where
...@@ -78,6 +78,7 @@ import GhcPrelude ...@@ -78,6 +78,7 @@ import GhcPrelude
import {-# SOURCE #-} TcRnTypes ( TcLclEnv, setLclEnvTcLevel, getLclEnvTcLevel import {-# SOURCE #-} TcRnTypes ( TcLclEnv, setLclEnvTcLevel, getLclEnvTcLevel
, setLclEnvLoc, getLclEnvLoc ) , setLclEnvLoc, getLclEnvLoc )
import GHC.Hs.Expr ( UnboundVar(..), unboundVarOcc )
import Predicate import Predicate
import Type import Type
import Coercion import Coercion
...@@ -209,8 +210,7 @@ data Ct ...@@ -209,8 +210,7 @@ data Ct
-- Treated as an "insoluble" constraint -- Treated as an "insoluble" constraint
-- See Note [Insoluble constraints] -- See Note [Insoluble constraints]
cc_ev :: CtEvidence, cc_ev :: CtEvidence,
cc_occ :: OccName, -- The name of this hole cc_hole :: Hole
cc_hole :: HoleSort -- The sort of this hole (expr, type, ...)
} }
| CQuantCan QCInst -- A quantified constraint | CQuantCan QCInst -- A quantified constraint
...@@ -233,19 +233,27 @@ instance Outputable QCInst where ...@@ -233,19 +233,27 @@ instance Outputable QCInst where
ppr (QCI { qci_ev = ev }) = ppr ev ppr (QCI { qci_ev = ev }) = ppr ev
------------ ------------
-- | Used to indicate which sort of hole we have. -- | An expression or type hole
data HoleSort = ExprHole data Hole = ExprHole UnboundVar
-- ^ Either an out-of-scope variable or a "true" hole in an -- ^ Either an out-of-scope variable or a "true" hole in an
-- expression (TypedHoles) -- expression (TypedHoles)
| TypeHole | TypeHole OccName
-- ^ A hole in a type (PartialTypeSignatures) -- ^ A hole in a type (PartialTypeSignatures)
instance Outputable Hole where
ppr (ExprHole ub) = ppr ub
ppr (TypeHole occ) = text "TypeHole" <> parens (ppr occ)
holeOcc :: Hole -> OccName
holeOcc (ExprHole uv) = unboundVarOcc uv
holeOcc (TypeHole occ) = occ
{- Note [Hole constraints] {- Note [Hole constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~
CHoleCan constraints are used for two kinds of holes, CHoleCan constraints are used for two kinds of holes,
distinguished by cc_hole: distinguished by cc_hole:
* For holes in expressions * For holes in expressions (includings variables not in scope)
e.g. f x = g _ x e.g. f x = g _ x
* For holes in type signatures * For holes in type signatures
...@@ -411,7 +419,7 @@ instance Outputable Ct where ...@@ -411,7 +419,7 @@ instance Outputable Ct where
CIrredCan { cc_insol = insol } CIrredCan { cc_insol = insol }
| insol -> text "CIrredCan(insol)" | insol -> text "CIrredCan(insol)"
| otherwise -> text "CIrredCan(sol)" | otherwise -> text "CIrredCan(sol)"
CHoleCan { cc_occ = occ } -> text "CHoleCan:" <+> ppr occ CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr hole
CQuantCan (QCI { qci_pend_sc = pend_sc }) CQuantCan (QCI { qci_pend_sc = pend_sc })
| pend_sc -> text "CQuantCan(psc)" | pend_sc -> text "CQuantCan(psc)"
| otherwise -> text "CQuantCan" | otherwise -> text "CQuantCan"
...@@ -687,18 +695,17 @@ isHoleCt (CHoleCan {}) = True ...@@ -687,18 +695,17 @@ isHoleCt (CHoleCan {}) = True
isHoleCt _ = False isHoleCt _ = False
isOutOfScopeCt :: Ct -> Bool isOutOfScopeCt :: Ct -> Bool
-- A Hole that does not have a leading underscore is -- We treat expression holes representing out-of-scope variables a bit
-- simply an out-of-scope variable, and we treat that -- differently when it comes to error reporting
-- a bit differently when it comes to error reporting isOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True
isOutOfScopeCt (CHoleCan { cc_occ = occ }) = not (startsWithUnderscore occ)
isOutOfScopeCt _ = False isOutOfScopeCt _ = False
isExprHoleCt :: Ct -> Bool isExprHoleCt :: Ct -> Bool
isExprHoleCt (CHoleCan { cc_hole = ExprHole }) = True isExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True
isExprHoleCt _ = False isExprHoleCt _ = False
isTypeHoleCt :: Ct -> Bool isTypeHoleCt :: Ct -> Bool
isTypeHoleCt (CHoleCan { cc_hole = TypeHole }) = True isTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True
isTypeHoleCt _ = False isTypeHoleCt _ = False
......
...@@ -523,6 +523,7 @@ mergeSignatures ...@@ -523,6 +523,7 @@ mergeSignatures
-- tcg_dus? -- tcg_dus?
-- tcg_th_used = tcg_th_used orig_tcg_env, -- tcg_th_used = tcg_th_used orig_tcg_env,
-- tcg_th_splice_used = tcg_th_splice_used orig_tcg_env -- tcg_th_splice_used = tcg_th_splice_used orig_tcg_env
-- tcg_th_top_level_locs = tcg_th_top_level_locs orig_tcg_env
}) $ do }) $ do
tcg_env <- getGblEnv tcg_env <- getGblEnv
......
...@@ -1634,7 +1634,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn ...@@ -1634,7 +1634,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn
= [ null theta = [ null theta
| TcIdSig (PartialSig { psig_hs_ty = hs_ty }) | TcIdSig (PartialSig { psig_hs_ty = hs_ty })
<- mapMaybe sig_fn (collectHsBindListBinders lbinds) <- mapMaybe sig_fn (collectHsBindListBinders lbinds)
, let (_, dL->L _ theta, _) = splitLHsSigmaTy (hsSigWcType hs_ty) ] , let (_, dL->L _ theta, _) = splitLHsSigmaTyInvis (hsSigWcType hs_ty) ]
has_partial_sigs = not (null partial_sig_mrs) has_partial_sigs = not (null partial_sig_mrs)
......
...@@ -34,7 +34,6 @@ import FamInst ( tcTopNormaliseNewTypeTF_maybe ) ...@@ -34,7 +34,6 @@ import FamInst ( tcTopNormaliseNewTypeTF_maybe )
import Var import Var
import VarEnv( mkInScopeSet ) import VarEnv( mkInScopeSet )
import VarSet( delVarSetList ) import VarSet( delVarSetList )
import OccName ( OccName )
import Outputable import Outputable
import DynFlags( DynFlags ) import DynFlags( DynFlags )
import NameSet import NameSet
...@@ -137,8 +136,8 @@ canonicalize (CFunEqCan { cc_ev = ev ...@@ -137,8 +136,8 @@ canonicalize (CFunEqCan { cc_ev = ev
= {-# SCC "canEqLeafFunEq" #-} = {-# SCC "canEqLeafFunEq" #-}
canCFunEqCan ev fn xis1 fsk canCFunEqCan ev fn xis1 fsk
canonicalize (CHoleCan { cc_ev = ev, cc_occ = occ, cc_hole = hole }) canonicalize (CHoleCan { cc_ev = ev, cc_hole = hole })
= canHole ev occ hole = canHole ev hole
{- {-
************************************************************************ ************************************************************************
...@@ -643,14 +642,13 @@ canIrred ev ...@@ -643,14 +642,13 @@ canIrred ev
_ -> continueWith $ _ -> continueWith $
mkIrredCt new_ev } } mkIrredCt new_ev } }
canHole :: CtEvidence -> OccName -> HoleSort -> TcS (StopOrContinue Ct) canHole :: CtEvidence -> Hole -> TcS (StopOrContinue Ct)
canHole ev occ hole_sort canHole ev hole
= do { let pred = ctEvPred ev = do { let pred = ctEvPred ev
; (xi,co) <- flatten FM_SubstOnly ev pred -- co :: xi ~ pred ; (xi,co) <- flatten FM_SubstOnly ev pred -- co :: xi ~ pred
; rewriteEvidence ev xi co `andWhenContinue` \ new_ev -> ; rewriteEvidence ev xi co `andWhenContinue` \ new_ev ->
do { updInertIrreds (`snocCts` (CHoleCan { cc_ev = new_ev do { updInertIrreds (`snocCts` (CHoleCan { cc_ev = new_ev
, cc_occ = occ , cc_hole = hole }))
, cc_hole = hole_sort }))
; stopWith new_ev "Emit insoluble hole" } } ; stopWith new_ev "Emit insoluble hole" } }
...@@ -763,13 +761,16 @@ solveForAll ev tv_bndrs theta pred pend_sc ...@@ -763,13 +761,16 @@ solveForAll ev tv_bndrs theta pred pend_sc
; (subst, skol_tvs) <- tcInstSkolTyVarsX empty_subst tvs ; (subst, skol_tvs) <- tcInstSkolTyVarsX empty_subst tvs
; given_ev_vars <- mapM newEvVar (substTheta subst theta) ; given_ev_vars <- mapM newEvVar (substTheta subst theta)
; (w_id, ev_binds) ; (lvl, (w_id, wanteds))
<- checkConstraintsTcS skol_info skol_tvs given_ev_vars $ <- pushLevelNoWorkList (ppr skol_info) $
do { wanted_ev <- newWantedEvVarNC loc $ do { wanted_ev <- newWantedEvVarNC loc $
substTy subst pred substTy subst pred
; return ( ctEvEvId wanted_ev ; return ( ctEvEvId wanted_ev
, unitBag (mkNonCanonical wanted_ev)) } , unitBag (mkNonCanonical wanted_ev)) }
; ev_binds <- emitImplicationTcS lvl skol_info skol_tvs
given_ev_vars wanteds
; setWantedEvTerm dest $ ; setWantedEvTerm dest $
EvFun { et_tvs = skol_tvs, et_given = given_ev_vars EvFun { et_tvs = skol_tvs, et_given = given_ev_vars
, et_binds = ev_binds, et_body = w_id } , et_binds = ev_binds, et_body = w_id }
...@@ -1029,8 +1030,9 @@ can_eq_nc_forall ev eq_rel s1 s2 ...@@ -1029,8 +1030,9 @@ can_eq_nc_forall ev eq_rel s1 s2
empty_subst2 = mkEmptyTCvSubst (getTCvInScope subst1) empty_subst2 = mkEmptyTCvSubst (getTCvInScope subst1)
; all_co <- checkTvConstraintsTcS skol_info skol_tvs $ ; (lvl, (all_co, wanteds)) <- pushLevelNoWorkList (ppr skol_info) $
go skol_tvs empty_subst2 bndrs2 go skol_tvs empty_subst2 bndrs2
; emitTvImplicationTcS lvl skol_info skol_tvs wanteds
; setWantedEq orig_dest all_co ; setWantedEq orig_dest all_co
; stopWith ev "Deferred polytype equality" } } ; stopWith ev "Deferred polytype equality" } }
......
...@@ -282,7 +282,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ...@@ -282,7 +282,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn
, sig_loc = getLoc (hsSigType hs_ty) } , sig_loc = getLoc (hsSigType hs_ty) }
; (ev_binds, (tc_bind, _)) ; (ev_binds, (tc_bind, _))
<- checkConstraints (TyConSkol ClassFlavour (getName clas)) tyvars [this_dict] $ <- checkConstraints skol_info tyvars [this_dict] $
tcPolyCheck no_prag_fn local_dm_sig tcPolyCheck no_prag_fn local_dm_sig
(L bind_loc lm_bind) (L bind_loc lm_bind)
...@@ -303,6 +303,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ...@@ -303,6 +303,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn
| otherwise = pprPanic "tcDefMeth" (ppr sel_id) | otherwise = pprPanic "tcDefMeth" (ppr sel_id)
where where
skol_info = TyConSkol ClassFlavour (getName clas)
sel_name = idName sel_id sel_name = idName sel_id
no_prag_fn = emptyPragEnv -- No pragmas for local_meth_id; no_prag_fn = emptyPragEnv -- No pragmas for local_meth_id;
-- they are all for meth_id -- they are all for meth_id
......
...@@ -70,7 +70,7 @@ import qualified GHC.LanguageExtensions as LangExt ...@@ -70,7 +70,7 @@ import qualified GHC.LanguageExtensions as LangExt
import Control.Monad import Control.Monad
import Control.Monad.Trans.Class import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Data.List import Data.List (partition, find)
{- {-
************************************************************************ ************************************************************************
...@@ -716,7 +716,7 @@ tcStandaloneDerivInstType ...@@ -716,7 +716,7 @@ tcStandaloneDerivInstType
tcStandaloneDerivInstType ctxt tcStandaloneDerivInstType ctxt
(HsWC { hswc_body = deriv_ty@(HsIB { hsib_ext = vars (HsWC { hswc_body = deriv_ty@(HsIB { hsib_ext = vars
, hsib_body = deriv_ty_body })}) , hsib_body = deriv_ty_body })})
| (tvs, theta, rho) <- splitLHsSigmaTy deriv_ty_body | (tvs, theta, rho) <- splitLHsSigmaTyInvis deriv_ty_body
, L _ [wc_pred] <- theta , L _ [wc_pred] <- theta
, L wc_span (HsWildCardTy _) <- ignoreParens wc_pred , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred
= do dfun_ty <- tcHsClsInstType ctxt $ = do dfun_ty <- tcHsClsInstType ctxt $
......