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
  • nikshalark/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
  • gulin.serge/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
  • fp/ghc
  • zaquest/ghc
  • fangyi-zhou/ghc
  • augyg/ghc
640 results
Show changes
Commits on Source (71)
Showing
with 537 additions and 1025 deletions
......@@ -264,7 +264,7 @@ def setNightlyTags(ghcup_metadata):
for version in ghcup_metadata['ghcupDownloads']['GHC']:
if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]:
ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly")
ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly")
ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly")
......
......@@ -36,6 +36,7 @@
/compiler/GHC/Rename/ @simonpj @rae
/compiler/GHC/Types/ @simonpj @rae
/compiler/GHC/HsToCore/ @simonpj @rae
/compiler/GHC/HsToCore/Pmc* @sgraf
/compiler/GHC/Tc/Deriv/ @RyanGlScott
/compiler/GHC/CmmToAsm/ @simonmar @bgamari @AndreasK
/compiler/GHC/CmmToAsm/Wasm/ @TerrorJack
......@@ -43,13 +44,12 @@
/compiler/GHC/StgToCmm/ @simonmar @osa1
/compiler/GHC/Cmm/ @simonmar @osa1
/compiler/ghci/ @simonmar
/compiler/GHC/Core/Op/CallArity.hs @nomeata
/compiler/utils/UnVarGraph.hs @nomeata
/compiler/GHC/Core/Op/Exitify.hs @nomeata
/compiler/GHC/Core/Opt/CallArity.hs @nomeata
/compiler/GHC/Core/Opt/Exitify.hs @nomeata
/compiler/GHC/Stg/CSE.hs @nomeata
/compiler/GHC/Stg/Lift.hs @sgraf
/compiler/GHC/Stg/Lift* @sgraf
/compiler/GHC/Cmm/Switch.hs @nomeata
/compiler/GHC/Core/Op/DmdAnal.hs @simonpj @sgraf
/compiler/GHC/Core/Opt/ @simonpj @sgraf
/compiler/GHC/ThToHs.hs @rae
/compiler/GHC/Wasm/ @nrnrnr
......
......@@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry
======================================
Make sure your system has the necessary tools to compile GHC. You can
find an overview here:
find an overview of how to prepare your system for compiling GHC here:
<https://gitlab.haskell.org/ghc/ghc/wikis/building/preparation>
Next, clone the repository and all the associated libraries:
After you have prepared your system, you can build GHC following the instructions described here:
```
$ git clone --recursive git@gitlab.haskell.org:ghc/ghc.git
```
<https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian>
On Windows, you need an extra repository containing some build tools.
These can be downloaded for you by `configure`. This only needs to be done once by running:
```
$ ./configure --enable-tarballs-autodownload
```
First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has
your preferred build settings. (You probably want to at least set
`BuildFlavour` to `quick`):
```
$ cp mk/build.mk.sample mk/build.mk
$ ... double-check mk/build.mk ...
```
Now build. The convenient `validate` script will build the tree in a way which
is both quick to build and consistent with our testsuite:
```
$ ./validate --build-only
```
You can use the `_validatebuild/stage1/bin/ghc` binary to play with the
newly built compiler.
Now, hack on your copy and rebuild (with `make`) as necessary.
Then start by making your commits however you want. When you're done, you can submit
a pull request on Github for small changes. For larger changes the patch needs to be
submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review.
Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues).
The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes).
......
......@@ -110,8 +110,11 @@ templateHaskellNames = [
-- TyVarBndr
plainTVName, kindedTVName,
plainInvisTVName, kindedInvisTVName,
plainBndrTVName, kindedBndrTVName,
-- Specificity
specifiedSpecName, inferredSpecName,
-- Visibility
bndrReqName, bndrInvisName,
-- Role
nominalRName, representationalRName, phantomRName, inferRName,
-- Kind
......@@ -157,7 +160,9 @@ templateHaskellNames = [
expQTyConName, fieldExpTyConName, predTyConName,
stmtTyConName, decsTyConName, conTyConName, bangTypeTyConName,
varBangTypeTyConName, typeQTyConName, expTyConName, decTyConName,
typeTyConName, tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, clauseTyConName,
typeTyConName,
tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, tyVarBndrVisTyConName,
clauseTyConName,
patQTyConName, funDepTyConName, decsQTyConName,
ruleBndrTyConName, tySynEqnTyConName,
roleTyConName, codeTyConName, injAnnTyConName, kindTyConName,
......@@ -499,11 +504,20 @@ plainInvisTVName, kindedInvisTVName :: Name
plainInvisTVName = libFun (fsLit "plainInvisTV") plainInvisTVIdKey
kindedInvisTVName = libFun (fsLit "kindedInvisTV") kindedInvisTVIdKey
plainBndrTVName, kindedBndrTVName :: Name
plainBndrTVName = libFun (fsLit "plainBndrTV") plainBndrTVIdKey
kindedBndrTVName = libFun (fsLit "kindedBndrTV") kindedBndrTVIdKey
-- data Specificity = ...
specifiedSpecName, inferredSpecName :: Name
specifiedSpecName = libFun (fsLit "specifiedSpec") specifiedSpecKey
inferredSpecName = libFun (fsLit "inferredSpec") inferredSpecKey
-- data BndrVis = ...
bndrReqName, bndrInvisName :: Name
bndrReqName = libFun (fsLit "bndrReq") bndrReqKey
bndrInvisName = libFun (fsLit "bndrInvis") bndrInvisKey
-- data Role = ...
nominalRName, representationalRName, phantomRName, inferRName :: Name
nominalRName = libFun (fsLit "nominalR") nominalRIdKey
......@@ -576,7 +590,7 @@ patQTyConName, expQTyConName, stmtTyConName,
varBangTypeTyConName, typeQTyConName,
decsQTyConName, ruleBndrTyConName, tySynEqnTyConName, roleTyConName,
derivClauseTyConName, kindTyConName,
tyVarBndrUnitTyConName, tyVarBndrSpecTyConName,
tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, tyVarBndrVisTyConName,
derivStrategyTyConName :: Name
-- These are only used for the types of top-level splices
expQTyConName = libTc (fsLit "ExpQ") expQTyConKey
......@@ -596,6 +610,7 @@ derivClauseTyConName = thTc (fsLit "DerivClause") derivClauseTyConKey
kindTyConName = thTc (fsLit "Kind") kindTyConKey
tyVarBndrUnitTyConName = libTc (fsLit "TyVarBndrUnit") tyVarBndrUnitTyConKey
tyVarBndrSpecTyConName = libTc (fsLit "TyVarBndrSpec") tyVarBndrSpecTyConKey
tyVarBndrVisTyConName = libTc (fsLit "TyVarBndrVis") tyVarBndrVisTyConKey
derivStrategyTyConName = thTc (fsLit "DerivStrategy") derivStrategyTyConKey
-- quasiquoting
......@@ -659,7 +674,7 @@ quoteClassKey = mkPreludeClassUnique 201
expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
patTyConKey,
stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey,
tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey,
tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey, tyVarBndrVisTyConKey,
decTyConKey, bangTypeTyConKey, varBangTypeTyConKey,
fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
funDepTyConKey, predTyConKey,
......@@ -701,6 +716,7 @@ decsTyConKey = mkPreludeTyConUnique 236
tyVarBndrSpecTyConKey = mkPreludeTyConUnique 237
codeTyConKey = mkPreludeTyConUnique 238
modNameTyConKey = mkPreludeTyConUnique 239
tyVarBndrVisTyConKey = mkPreludeTyConUnique 240
{- *********************************************************************
* *
......@@ -1030,6 +1046,10 @@ plainInvisTVIdKey, kindedInvisTVIdKey :: Unique
plainInvisTVIdKey = mkPreludeMiscIdUnique 482
kindedInvisTVIdKey = mkPreludeMiscIdUnique 483
plainBndrTVIdKey, kindedBndrTVIdKey :: Unique
plainBndrTVIdKey = mkPreludeMiscIdUnique 484
kindedBndrTVIdKey = mkPreludeMiscIdUnique 485
-- data Role = ...
nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
nominalRIdKey = mkPreludeMiscIdUnique 416
......@@ -1114,6 +1134,11 @@ specifiedSpecKey, inferredSpecKey :: Unique
specifiedSpecKey = mkPreludeMiscIdUnique 498
inferredSpecKey = mkPreludeMiscIdUnique 499
-- data BndrVis = ...
bndrReqKey, bndrInvisKey :: Unique
bndrReqKey = mkPreludeMiscIdUnique 800 -- TODO (int-index): make up some room in the 5** numberspace?
bndrInvisKey = mkPreludeMiscIdUnique 801
{-
************************************************************************
* *
......
......@@ -763,6 +763,11 @@ Wrinkles
(W3) We need a TypeOrConstraint flag in LitRubbish.
(W4) In the CPR transformation, we can't unbox constructors with constraint
arguments because unboxed tuples (# …, … #) currently only supports fields
of type TYPE rr. See (CPR2) in Note [Which types are unboxed?] in
GHC.Core.Opt.WorkWrap.Utils.
Note [Type and Constraint are not apart]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Type and Constraint are not equal (eqType) but they are not /apart/
......
------------------------------------
-- ByteArray# operations
------------------------------------
-- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py.
-- To regenerate run,
--
-- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp
------------------------------------
-- aligned index operations
------------------------------------
primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
ByteArray# -> Int# -> Char#
{Read a 8-bit character; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
ByteArray# -> Int# -> Char#
{Read a 32-bit character; offset in 4-byte words.}
with can_fail = True
primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
ByteArray# -> Int# -> Int#
{Read a word-sized integer; offset in machine words.}
with can_fail = True
primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
ByteArray# -> Int# -> Word#
{Read a word-sized unsigned integer; offset in machine words.}
with can_fail = True
primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
ByteArray# -> Int# -> Addr#
{Read a machine address; offset in machine words.}
with can_fail = True
primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
ByteArray# -> Int# -> Float#
{Read a single-precision floating-point value; offset in 4-byte words.}
with can_fail = True
primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
ByteArray# -> Int# -> Double#
{Read a double-precision floating-point value; offset in 8-byte words.}
with can_fail = True
primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
ByteArray# -> Int# -> StablePtr# a
{Read a 'StablePtr#' value; offset in machine words.}
with can_fail = True
primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
ByteArray# -> Int# -> Int8#
{Read a 8-bit signed integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
ByteArray# -> Int# -> Int16#
{Read a 16-bit signed integer; offset in 2-byte words.}
with can_fail = True
primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
ByteArray# -> Int# -> Int32#
{Read a 32-bit signed integer; offset in 4-byte words.}
with can_fail = True
primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
ByteArray# -> Int# -> Int64#
{Read a 64-bit signed integer; offset in 8-byte words.}
with can_fail = True
primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
ByteArray# -> Int# -> Word8#
{Read a 8-bit unsigned integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
ByteArray# -> Int# -> Word16#
{Read a 16-bit unsigned integer; offset in 2-byte words.}
with can_fail = True
primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
ByteArray# -> Int# -> Word32#
{Read a 32-bit unsigned integer; offset in 4-byte words.}
with can_fail = True
primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
ByteArray# -> Int# -> Word64#
{Read a 64-bit unsigned integer; offset in 8-byte words.}
with can_fail = True
------------------------------------
-- unaligned index operations
------------------------------------
primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp
ByteArray# -> Int# -> Char#
{Read a 8-bit character; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp
ByteArray# -> Int# -> Char#
{Read a 32-bit character; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp
ByteArray# -> Int# -> Int#
{Read a word-sized integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp
ByteArray# -> Int# -> Word#
{Read a word-sized unsigned integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp
ByteArray# -> Int# -> Addr#
{Read a machine address; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp
ByteArray# -> Int# -> Float#
{Read a single-precision floating-point value; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp
ByteArray# -> Int# -> Double#
{Read a double-precision floating-point value; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp
ByteArray# -> Int# -> StablePtr# a
{Read a 'StablePtr#' value; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp
ByteArray# -> Int# -> Int16#
{Read a 16-bit signed integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp
ByteArray# -> Int# -> Int32#
{Read a 32-bit signed integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp
ByteArray# -> Int# -> Int64#
{Read a 64-bit signed integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp
ByteArray# -> Int# -> Word16#
{Read a 16-bit unsigned integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp
ByteArray# -> Int# -> Word32#
{Read a 32-bit unsigned integer; offset in bytes.}
with can_fail = True
primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp
ByteArray# -> Int# -> Word64#
{Read a 64-bit unsigned integer; offset in bytes.}
with can_fail = True
------------------------------------
-- aligned read operations
------------------------------------
primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
{Read a 8-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
{Read a 32-bit character; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
{Read a word-sized integer; offset in machine words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
{Read a word-sized unsigned integer; offset in machine words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
{Read a machine address; offset in machine words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
{Read a single-precision floating-point value; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
{Read a double-precision floating-point value; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
{Read a 'StablePtr#' value; offset in machine words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #)
{Read a 8-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #)
{Read a 16-bit signed integer; offset in 2-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #)
{Read a 32-bit signed integer; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
{Read a 64-bit signed integer; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #)
{Read a 8-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #)
{Read a 16-bit unsigned integer; offset in 2-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #)
{Read a 32-bit unsigned integer; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
{Read a 64-bit unsigned integer; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
------------------------------------
-- unaligned read operations
------------------------------------
primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
{Read a 8-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
{Read a 32-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
{Read a word-sized integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
{Read a word-sized unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
{Read a machine address; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
{Read a single-precision floating-point value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
{Read a double-precision floating-point value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
{Read a 'StablePtr#' value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #)
{Read a 16-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #)
{Read a 32-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
{Read a 64-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #)
{Read a 16-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #)
{Read a 32-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
{Read a 64-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
------------------------------------
-- aligned write operations
------------------------------------
primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
{Write a 8-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
{Write a 32-bit character; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
{Write a word-sized integer; offset in machine words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp
MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
{Write a word-sized unsigned integer; offset in machine words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp
MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
{Write a machine address; offset in machine words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp
MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
{Write a single-precision floating-point value; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp
MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
{Write a double-precision floating-point value; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp
MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
{Write a 'StablePtr#' value; offset in machine words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp
MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s
{Write a 8-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s
{Write a 16-bit signed integer; offset in 2-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s
{Write a 32-bit signed integer; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
{Write a 64-bit signed integer; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s
{Write a 8-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
{Write a 16-bit unsigned integer; offset in 2-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
{Write a 32-bit unsigned integer; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
{Write a 64-bit unsigned integer; offset in 8-byte words.}
with has_side_effects = True
can_fail = True
------------------------------------
-- unaligned write operations
------------------------------------
primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp
MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
{Write a 8-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp
MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
{Write a 32-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp
MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
{Write a word-sized integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp
MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
{Write a word-sized unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp
MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s
{Write a machine address; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp
MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
{Write a single-precision floating-point value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp
MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
{Write a double-precision floating-point value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp
MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s
{Write a 'StablePtr#' value; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp
MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s
{Write a 16-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp
MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s
{Write a 32-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp
MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
{Write a 64-bit signed integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp
MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s
{Write a 16-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp
MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s
{Write a 32-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp
MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
{Write a 64-bit unsigned integer; offset in bytes.}
with has_side_effects = True
can_fail = True
#!/usr/bin/env python
# -*- coding: utf-8 -*-
# This script generates the primop descriptions for many similar ByteArray#
# and Addr# access operations. Its output is #include-d into primops.txt.pp.
from typing import Optional, NamedTuple
import textwrap
import argparse
arg_parser = argparse.ArgumentParser()
arg_parser.add_argument('addr_or_bytearray',
choices = ["addr-access-ops", "bytearray-access-ops"],
)
arg_parser.add_argument('output_file',
type=argparse.FileType('w'),
metavar='FILE',
)
args = arg_parser.parse_args()
write = args.output_file.write
write('''
-- Do not edit.
-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py.
-- (The build system should take care of this for you.)
''')
class ElementType(NamedTuple):
name: str
......@@ -28,26 +52,13 @@ element_types = [
ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD),
]
# TODO: Eventually when the sized integer primops use proper unboxed types we
# should rather do:
#
#for n in [8,16,32,64]:
# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ]
#
#for n in [8,16,32,64]:
# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ]
element_types += [
ElementType("Int8", "Int8#", "8-bit signed integer", 1),
ElementType("Int16", "Int16#", "16-bit signed integer", 2),
ElementType("Int32", "Int32#", "32-bit signed integer", 4),
ElementType("Int64", "Int64#", "64-bit signed integer", 8),
ElementType("Word8", "Word8#", "8-bit unsigned integer", 1),
ElementType("Word16", "Word16#", "16-bit unsigned integer", 2),
ElementType("Word32", "Word32#", "32-bit unsigned integer", 4),
ElementType("Word64", "Word64#", "64-bit unsigned integer", 8),
]
for n in [8,16,32,64]:
element_types += [
ElementType(f"Int{n}", f"Int{n}#",
f"{n}-bit signed integer", n // 8),
ElementType(f"Word{n}", f"Word{n}#",
f"{n}-bit unsigned integer", n // 8)
]
def pretty_offset(n: Optional[int]) -> str:
if n == MACH_WORD:
......@@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str:
else:
return f'{n}-byte words'
def get_align_warn(n: ElementType) -> str:
if n.width == 1:
return ''
return '''
On some platforms, the access may fail
for an insufficiently aligned @Addr#@.
'''
def print_block(template: str, **kwargs) -> None:
print(textwrap.dedent(template.format(**kwargs)).lstrip())
write(textwrap.dedent(template.format(**kwargs)).lstrip())
write('\n')
def header(s: str):
print('')
write('\n')
print_block('''
------------------------------------
-- {s}
------------------------------------
''', s=s)
if args.addr_or_bytearray == "bytearray-access-ops":
header("ByteArray# operations")
header("ByteArray# operations")
print('''
-- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py.
-- To regenerate run,
--
-- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp
''')
header('aligned index operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
header('aligned index operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp
ByteArray# -> Int# -> {rep_ty}
{{Read a {desc}; offset in {offset}.}}
with can_fail = True
''', offset = offset, **t._asdict())
''', offset = offset, **t._asdict())
header('unaligned index operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
header('unaligned index operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp
ByteArray# -> Int# -> {rep_ty}
{{Read a {desc}; offset in bytes.}}
with can_fail = True
''', **t._asdict())
''', **t._asdict())
header('aligned read operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
header('aligned read operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
{{Read a {desc}; offset in {offset}.}}
with has_side_effects = True
can_fail = True
''', offset = offset, **t._asdict())
''', offset = offset, **t._asdict())
header('unaligned read operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
header('unaligned read operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #)
{{Read a {desc}; offset in bytes.}}
with has_side_effects = True
can_fail = True
''', **t._asdict())
''', **t._asdict())
header('aligned write operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
header('aligned write operations')
for t in element_types:
offset = pretty_offset(t.width)
print_block('''
primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp
MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
{{Write a {desc}; offset in {offset}.}}
with has_side_effects = True
can_fail = True
''', offset = offset, **t._asdict())
''', offset = offset, **t._asdict())
header('unaligned write operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
header('unaligned write operations')
for t in element_types:
if t.name in ['Int8', 'Word8']: continue
print_block('''
primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp
MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s
{{Write a {desc}; offset in bytes.}}
with has_side_effects = True
can_fail = True
''', **t._asdict())
''', **t._asdict())
else: # addr_or_bytearray == "addr-access-ops":
header("Addr# access operations")
header('aligned index operations')
for t in element_types:
offset = pretty_offset(t.width)
align_warn = get_align_warn(t)
print_block('''
primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp
Addr# -> Int# -> {rep_ty}
{{ Read a {desc}; offset in {offset}.
{align_warn}
}}
with can_fail = True
''', offset = offset, align_warn = align_warn, **t._asdict())
header('aligned read operations')
for t in element_types:
offset = pretty_offset(t.width)
align_warn = get_align_warn(t)
print_block('''
primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #)
{{ Read a {desc}; offset in {offset}.
{align_warn}
}}
with has_side_effects = True
can_fail = True
''', offset = offset, align_warn = align_warn, **t._asdict())
header('aligned write operations')
for t in element_types:
offset = pretty_offset(t.width)
align_warn = get_align_warn(t)
print_block('''
primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp
Addr# -> Int# -> {rep_ty} -> State# s -> State# s
{{ Write a {desc}; offset in {offset}.
{align_warn}
}}
with has_side_effects = True
can_fail = True
''', offset = offset, align_warn = align_warn, **t._asdict())
......@@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
@since 0.5.0.0}
#include "bytearray-ops.txt.pp"
#include "bytearray-access-ops.txt.pp"
primop CompareByteArraysOp "compareByteArrays#" GenPrimOp
ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
......@@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int#
primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int#
primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int#
primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
{Reads 8-bit character; offset in bytes.}
with can_fail = True
primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
{Reads 31-bit character; offset in 4-byte words.}
with can_fail = True
primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
Addr# -> Int# -> Int#
with can_fail = True
primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp
Addr# -> Int# -> Word#
with can_fail = True
primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp
Addr# -> Int# -> Addr#
with can_fail = True
primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp
Addr# -> Int# -> Float#
with can_fail = True
primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp
Addr# -> Int# -> Double#
with can_fail = True
primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp
Addr# -> Int# -> StablePtr# a
with can_fail = True
primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp
Addr# -> Int# -> Int8#
with can_fail = True
primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
Addr# -> Int# -> Int16#
with can_fail = True
primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
Addr# -> Int# -> Int32#
with can_fail = True
primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
Addr# -> Int# -> Int64#
with can_fail = True
primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
Addr# -> Int# -> Word8#
with can_fail = True
primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
Addr# -> Int# -> Word16#
with can_fail = True
primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
Addr# -> Int# -> Word32#
with can_fail = True
primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
Addr# -> Int# -> Word64#
with can_fail = True
primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
{Reads 8-bit character; offset in bytes.}
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
{Reads 31-bit character; offset in 4-byte words.}
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Addr# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Float# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Double# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int8# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int16# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int32# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int64# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word8# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word16# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word32# #)
with has_side_effects = True
can_fail = True
primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word64# #)
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
Addr# -> Int# -> Int# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp
Addr# -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
Addr# -> Int# -> Addr# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
Addr# -> Int# -> Float# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp
Addr# -> Int# -> Double# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp
Addr# -> Int# -> StablePtr# a -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp
Addr# -> Int# -> Int8# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
Addr# -> Int# -> Int16# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
Addr# -> Int# -> Int32# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
Addr# -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
Addr# -> Int# -> Word8# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
Addr# -> Int# -> Word16# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
Addr# -> Int# -> Word32# -> State# s -> State# s
with has_side_effects = True
can_fail = True
primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
Addr# -> Int# -> Word64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
#include "addr-access-ops.txt.pp"
primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp
Addr# -> Addr# -> State# s -> (# State# s, Addr# #)
......
......@@ -302,6 +302,10 @@ path does not result in allocation in the hot path. This can be surprisingly
impactful. Changing `lint_app` reduced allocations for one test program I was
looking at by ~4%.
Note [MCInfo for Lint]
~~~~~~~~~~~~~~~~~~~~~~
When printing a Lint message, use the MCInfo severity so that the
message is printed on stderr rather than stdout (#13342).
************************************************************************
* *
......@@ -425,7 +429,7 @@ displayLintResults :: Logger
-> IO ()
displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
| not (isEmptyBag errs)
= do { logMsg logger Err.MCDump noSrcSpan
= do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint]
$ withPprStyle defaultDumpStyle
(vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs
, text "*** Offending Program ***"
......@@ -436,9 +440,7 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
| not (isEmptyBag warns)
, log_enable_debug (logFlags logger)
, display_warnings
-- If the Core linter encounters an error, output to stderr instead of
-- stdout (#13342)
= logMsg logger Err.MCInfo noSrcSpan
= logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint]
$ withPprStyle defaultDumpStyle
(lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
......
......@@ -2863,18 +2863,11 @@ pushCoValArg co
= Just (MRefl, MRefl)
| isFunTy tyL
, (co_mult, co1, co2) <- decomposeFunCo co
, (_, co1, co2) <- decomposeFunCo co
-- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2)
-- then co1 :: tyL1 ~ tyR1
-- co2 :: tyL2 ~ tyR2
, isReflexiveCo co_mult
-- We can't push the coercion in the case where co_mult isn't reflexivity:
-- it could be an unsafe axiom, and losing this information could yield
-- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x)
-- with co :: (Int -> ()) ~ (Int %1 -> ()), would reduce to (fun x ::(1) Int
-- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed.
, typeHasFixedRuntimeRep new_arg_ty
-- We can't push the coercion inside if it would give rise to
-- a representation-polymorphic argument.
......@@ -2907,10 +2900,7 @@ pushCoercionIntoLambda in_scope x e co
, Pair s1s2 t1t2 <- coercionKind co
, Just {} <- splitFunTy_maybe s1s2
, Just (_, w1, t1,_t2) <- splitFunTy_maybe t1t2
, (co_mult, co1, co2) <- decomposeFunCo co
, isReflexiveCo co_mult
-- We can't push the coercion in the case where co_mult isn't
-- reflexivity. See pushCoValArg for more details.
, (_, co1, co2) <- decomposeFunCo co
, typeHasFixedRuntimeRep t1
-- We can't push the coercion into the lambda if it would create
-- a representation-polymorphic binder.
......
......@@ -15,14 +15,11 @@ module GHC.Core.Opt.CallerCC
, parseCallerCcFilter
) where
import Data.Word (Word8)
import Data.Maybe
import Control.Applicative
import GHC.Utils.Monad.State.Strict
import Data.Either
import Control.Monad
import qualified Text.ParserCombinators.ReadP as P
import GHC.Prelude
import GHC.Utils.Outputable as Outputable
......@@ -38,11 +35,8 @@ import GHC.Unit.Types
import GHC.Data.FastString
import GHC.Core
import GHC.Core.Opt.Monad
import GHC.Utils.Panic
import qualified GHC.Utils.Binary as B
import Data.Char
import GHC.Core.Opt.CallerCC.Types
import Language.Haskell.Syntax.Module.Name
addCallerCostCentres :: ModGuts -> CoreM ModGuts
addCallerCostCentres guts = do
......@@ -139,90 +133,3 @@ needsCallSiteCostCentre env i =
checkFunc =
occNameMatches (ccfFuncName ccf) (getOccName i)
data NamePattern
= PChar Char NamePattern
| PWildcard NamePattern
| PEnd
instance Outputable NamePattern where
ppr (PChar c rest) = char c <> ppr rest
ppr (PWildcard rest) = char '*' <> ppr rest
ppr PEnd = Outputable.empty
instance B.Binary NamePattern where
get bh = do
tag <- B.get bh
case tag :: Word8 of
0 -> PChar <$> B.get bh <*> B.get bh
1 -> PWildcard <$> B.get bh
2 -> pure PEnd
_ -> panic "Binary(NamePattern): Invalid tag"
put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
put_ bh PEnd = B.put_ bh (2 :: Word8)
occNameMatches :: NamePattern -> OccName -> Bool
occNameMatches pat = go pat . occNameString
where
go :: NamePattern -> String -> Bool
go PEnd "" = True
go (PChar c rest) (d:s)
= d == c && go rest s
go (PWildcard rest) s
= go rest s || go (PWildcard rest) (tail s)
go _ _ = False
type Parser = P.ReadP
parseNamePattern :: Parser NamePattern
parseNamePattern = pattern
where
pattern = star P.<++ wildcard P.<++ char P.<++ end
star = PChar '*' <$ P.string "\\*" <*> pattern
wildcard = do
void $ P.char '*'
PWildcard <$> pattern
char = PChar <$> P.get <*> pattern
end = PEnd <$ P.eof
data CallerCcFilter
= CallerCcFilter { ccfModuleName :: Maybe ModuleName
, ccfFuncName :: NamePattern
}
instance Outputable CallerCcFilter where
ppr ccf =
maybe (char '*') ppr (ccfModuleName ccf)
<> char '.'
<> ppr (ccfFuncName ccf)
instance B.Binary CallerCcFilter where
get bh = CallerCcFilter <$> B.get bh <*> B.get bh
put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
parseCallerCcFilter :: String -> Either String CallerCcFilter
parseCallerCcFilter inp =
case P.readP_to_S parseCallerCcFilter' inp of
((result, ""):_) -> Right result
_ -> Left $ "parse error on " ++ inp
parseCallerCcFilter' :: Parser CallerCcFilter
parseCallerCcFilter' =
CallerCcFilter
<$> moduleFilter
<* P.char '.'
<*> parseNamePattern
where
moduleFilter :: Parser (Maybe ModuleName)
moduleFilter =
(Just . mkModuleName <$> moduleName)
<|>
(Nothing <$ P.char '*')
moduleName :: Parser String
moduleName = do
c <- P.satisfy isUpper
cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_')
rest <- optional $ P.char '.' >> fmap ('.':) moduleName
return $ c : (cs ++ fromMaybe "" rest)
module GHC.Core.Opt.CallerCC where
import GHC.Prelude
-- Necessary due to import in GHC.Driver.Session.
data CallerCcFilter
parseCallerCcFilter :: String -> Either String CallerCcFilter
module GHC.Core.Opt.CallerCC.Types ( NamePattern(..)
, CallerCcFilter(..)
, occNameMatches
, parseCallerCcFilter
, parseNamePattern
) where
import Data.Word (Word8)
import Data.Maybe
import Control.Applicative
import Data.Either
import Control.Monad
import qualified Text.ParserCombinators.ReadP as P
import GHC.Prelude
import GHC.Utils.Outputable as Outputable
import GHC.Types.Name hiding (varName)
import GHC.Utils.Panic
import qualified GHC.Utils.Binary as B
import Data.Char
import Language.Haskell.Syntax.Module.Name
data NamePattern
= PChar Char NamePattern
| PWildcard NamePattern
| PEnd
instance Outputable NamePattern where
ppr (PChar c rest) = char c <> ppr rest
ppr (PWildcard rest) = char '*' <> ppr rest
ppr PEnd = Outputable.empty
instance B.Binary NamePattern where
get bh = do
tag <- B.get bh
case tag :: Word8 of
0 -> PChar <$> B.get bh <*> B.get bh
1 -> PWildcard <$> B.get bh
2 -> pure PEnd
_ -> panic "Binary(NamePattern): Invalid tag"
put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
put_ bh PEnd = B.put_ bh (2 :: Word8)
occNameMatches :: NamePattern -> OccName -> Bool
occNameMatches pat = go pat . occNameString
where
go :: NamePattern -> String -> Bool
go PEnd "" = True
go (PChar c rest) (d:s)
= d == c && go rest s
go (PWildcard rest) s
= go rest s || go (PWildcard rest) (tail s)
go _ _ = False
type Parser = P.ReadP
parseNamePattern :: Parser NamePattern
parseNamePattern = pattern
where
pattern = star P.<++ wildcard P.<++ char P.<++ end
star = PChar '*' <$ P.string "\\*" <*> pattern
wildcard = do
void $ P.char '*'
PWildcard <$> pattern
char = PChar <$> P.get <*> pattern
end = PEnd <$ P.eof
data CallerCcFilter
= CallerCcFilter { ccfModuleName :: Maybe ModuleName
, ccfFuncName :: NamePattern
}
instance Outputable CallerCcFilter where
ppr ccf =
maybe (char '*') ppr (ccfModuleName ccf)
<> char '.'
<> ppr (ccfFuncName ccf)
instance B.Binary CallerCcFilter where
get bh = CallerCcFilter <$> B.get bh <*> B.get bh
put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
parseCallerCcFilter :: String -> Either String CallerCcFilter
parseCallerCcFilter inp =
case P.readP_to_S parseCallerCcFilter' inp of
((result, ""):_) -> Right result
_ -> Left $ "parse error on " ++ inp
parseCallerCcFilter' :: Parser CallerCcFilter
parseCallerCcFilter' =
CallerCcFilter
<$> moduleFilter
<* P.char '.'
<*> parseNamePattern
where
moduleFilter :: Parser (Maybe ModuleName)
moduleFilter =
(Just . mkModuleName <$> moduleName)
<|>
(Nothing <$ P.char '*')
moduleName :: Parser String
moduleName = do
c <- P.satisfy isUpper
cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_')
rest <- optional $ P.char '.' >> fmap ('.':) moduleName
return $ c : (cs ++ fromMaybe "" rest)
\ No newline at end of file
......@@ -2300,7 +2300,7 @@ prepareAlts scrut case_bndr alts
-- The multiplicity on case_bndr's is the multiplicity of the
-- case expression The newly introduced patterns in
-- refineDefaultAlt must be scaled by this multiplicity
(yes3, idcs3, alts3) = combineIdenticalAlts idcs1 alts2
(yes3, idcs3, alts3) = combineIdenticalAlts scrut case_bndr idcs1 alts2
-- "idcs" stands for "impossible default data constructors"
-- i.e. the constructors that can't match the default case
; when yes2 $ tick (FillInCaseDefault case_bndr)
......
......@@ -674,13 +674,11 @@ canUnboxResult fam_envs ty cpr
-- type constructor via a .hs-boot file (#8743)
, let dc = dcs `getNth` (con_tag - fIRST_TAG)
, null (dataConExTyCoVars dc) -- no existentials;
-- See Note [Which types are unboxed?]
-- See (CPR1) in Note [Which types are unboxed?]
-- and GHC.Core.Opt.CprAnal.argCprType
-- where we also check this.
, all isLinear (dataConInstArgTys dc tc_args)
-- Deactivates CPR worker/wrapper splits on constructors with non-linear
-- arguments, for the moment, because they require unboxed tuple with variable
-- multiplicity fields.
, null (dataConTheta dc) -- no constraints;
-- See (CPR2) in Note [Which types are unboxed?]
= DoUnbox (DataConPatContext { dcpc_dc = dc, dcpc_tc_args = tc_args
, dcpc_co = co, dcpc_args = arg_cprs })
......@@ -691,13 +689,6 @@ canUnboxResult fam_envs ty cpr
-- See Note [non-algebraic or open body type warning]
open_body_ty_warning = warnPprTrace True "canUnboxResult: non-algebraic or open body type" (ppr ty) Nothing
isLinear :: Scaled a -> Bool
isLinear (Scaled w _ ) =
case w of
OneTy -> True
_ -> False
{- Note [Which types are unboxed?]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Worker/wrapper will unbox
......@@ -719,25 +710,28 @@ Worker/wrapper will unbox
* is not recursive (as per 'isRecDataCon')
* (might have multiple constructors, in contrast to (1))
* the applied data constructor *does not* bind existentials
* nor does it bind constraints (equalities or dictionaries)
We can transform
> f x y = let ... in D a b
to
> $wf x y = let ... in (# a, b #)
via 'mkWWcpr'.
NB: We don't allow existentials for CPR W/W, because we don't have unboxed
dependent tuples (yet?). Otherwise, we could transform
(CPR1). We don't allow existentials for CPR W/W, because we don't have
unboxed dependent tuples (yet?). Otherwise, we could transform
> f x y = let ... in D @ex (a :: ..ex..) (b :: ..ex..)
to
> $wf x y = let ... in (# @ex, (a :: ..ex..), (b :: ..ex..) #)
(CPR2) we don't allow constraints for CPR W/W, because an unboxed tuple
contains types of kind `TYPE rr`, but not of kind `CONSTRAINT rr`.
This is annoying; there is no real reason for this except that we don't
have TYPE/CONSTAINT polymorphism. See Note [TYPE and CONSTRAINT]
in GHC.Builtin.Types.Prim.
The respective tests are in 'canUnboxArg' and
'canUnboxResult', respectively.
Note that the data constructor /can/ have evidence arguments: equality
constraints, type classes etc. So it can be GADT. These evidence
arguments are simply value arguments, and should not get in the way.
Note [mkWWstr and unsafeCoerce]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
By using unsafeCoerce, it is possible to make the number of demands fail to
......
......@@ -25,7 +25,8 @@ module GHC.Core.TyCon(
mkRequiredTyConBinder,
mkAnonTyConBinder, mkAnonTyConBinders,
tyConBinderForAllTyFlag, tyConBndrVisForAllTyFlag, isNamedTyConBinder,
isVisibleTyConBinder, isInvisibleTyConBinder, isVisibleTcbVis,
isVisibleTyConBinder, isInvisibleTyConBinder,
isVisibleTcbVis, isInvisSpecTcbVis,
-- ** Field labels
tyConFieldLabels, lookupTyConFieldLabel,
......@@ -508,6 +509,10 @@ isVisibleTcbVis :: TyConBndrVis -> Bool
isVisibleTcbVis (NamedTCB vis) = isVisibleForAllTyFlag vis
isVisibleTcbVis AnonTCB = True
isInvisSpecTcbVis :: TyConBndrVis -> Bool
isInvisSpecTcbVis (NamedTCB Specified) = True
isInvisSpecTcbVis _ = False
isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
-- Works for IfaceTyConBinder too
isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)
......@@ -889,8 +894,8 @@ data TyConDetails =
promDcInfo :: PromDataConInfo -- ^ See comments with 'PromDataConInfo'
}
-- | These exist only during type-checking. See Note [How TcTyCons work]
-- in "GHC.Tc.TyCl"
-- | These exist only during type-checking.
-- See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in "GHC.Tc.TyCl"
| TcTyCon {
-- NB: the tyConArity of a TcTyCon must match
-- the number of Required (positional, user-specified)
......@@ -924,7 +929,7 @@ where
* tyConArity = length required_tvs
tcTyConScopedTyVars are used only for MonoTcTyCons, not PolyTcTyCons.
See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.Utils.TcType.
See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl
Note [Representation-polymorphic TyCons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1843,13 +1848,11 @@ mkSumTyCon name binders res_kind cons parent
-- right-hand side. It lives only during the type-checking of a
-- mutually-recursive group of tycons; it is then zonked to a proper
-- TyCon in zonkTcTyCon.
-- See also Note [Kind checking recursive type and class declarations]
-- in "GHC.Tc.TyCl".
-- See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in "GHC.Tc.TyCl"
mkTcTyCon :: Name
-> [TyConBinder]
-> Kind -- ^ /result/ kind only
-> [(Name,TcTyVar)] -- ^ Scoped type variables;
-- see Note [How TcTyCons work] in GHC.Tc.TyCl
-> Bool -- ^ Is this TcTyCon generalised already?
-> TyConFlavour TyCon -- ^ What sort of 'TyCon' this represents
-> TyCon
......@@ -1997,7 +2000,7 @@ isInjectiveTyCon (TyCon { tyConDetails = details }) role
go (TcTyCon {}) _ = True
-- Reply True for TcTyCon to minimise knock on type errors
-- See Note [How TcTyCons work] item (1) in GHC.Tc.TyCl
-- See (W1) in Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl
-- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds
......
......@@ -3,7 +3,7 @@
--
-- Type - public interface
{-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-}
{-# LANGUAGE FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf, RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Main functions for manipulating types and type-related things
......@@ -889,7 +889,8 @@ data TyCoMapper env m
-- ^ What to do with coercion holes.
-- See Note [Coercion holes] in "GHC.Core.TyCo.Rep".
, tcm_tycobinder :: env -> TyCoVar -> ForAllTyFlag -> m (env, TyCoVar)
, tcm_tycobinder :: forall r. env -> TyCoVar -> ForAllTyFlag
-> (env -> TyCoVar -> m r) -> m r
-- ^ The returned env is used in the extended scope
, tcm_tycon :: TyCon -> m TyCon
......@@ -902,10 +903,10 @@ data TyCoMapper env m
{-# INLINE mapTyCo #-} -- See Note [Specialising mappers]
mapTyCo :: Monad m => TyCoMapper () m
-> ( Type -> m Type
, [Type] -> m [Type]
, Coercion -> m Coercion
, [Coercion] -> m[Coercion])
-> ( Type -> m Type
, [Type] -> m [Type]
, Coercion -> m Coercion
, [Coercion] -> m [Coercion] )
mapTyCo mapper
= case mapTyCoX mapper of
(go_ty, go_tys, go_co, go_cos)
......@@ -916,7 +917,7 @@ mapTyCoX :: Monad m => TyCoMapper env m
-> ( env -> Type -> m Type
, env -> [Type] -> m [Type]
, env -> Coercion -> m Coercion
, env -> [Coercion] -> m[Coercion])
, env -> [Coercion] -> m [Coercion] )
mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
, tcm_tycobinder = tycobinder
, tcm_tycon = tycon
......@@ -924,20 +925,20 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
, tcm_hole = cohole })
= (go_ty, go_tys, go_co, go_cos)
where
go_tys _ [] = return []
go_tys env (ty:tys) = (:) <$> go_ty env ty <*> go_tys env tys
go_tys !_ [] = return []
go_tys !env (ty:tys) = (:) <$> go_ty env ty <*> go_tys env tys
go_ty env (TyVarTy tv) = tyvar env tv
go_ty env (AppTy t1 t2) = mkAppTy <$> go_ty env t1 <*> go_ty env t2
go_ty _ ty@(LitTy {}) = return ty
go_ty env (CastTy ty co) = mkCastTy <$> go_ty env ty <*> go_co env co
go_ty env (CoercionTy co) = CoercionTy <$> go_co env co
go_ty !env (TyVarTy tv) = tyvar env tv
go_ty !env (AppTy t1 t2) = mkAppTy <$> go_ty env t1 <*> go_ty env t2
go_ty !_ ty@(LitTy {}) = return ty
go_ty !env (CastTy ty co) = mkCastTy <$> go_ty env ty <*> go_co env co
go_ty !env (CoercionTy co) = CoercionTy <$> go_co env co
go_ty env ty@(FunTy _ w arg res)
go_ty !env ty@(FunTy _ w arg res)
= do { w' <- go_ty env w; arg' <- go_ty env arg; res' <- go_ty env res
; return (ty { ft_mult = w', ft_arg = arg', ft_res = res' }) }
go_ty env ty@(TyConApp tc tys)
go_ty !env ty@(TyConApp tc tys)
| isTcTyCon tc
= do { tc' <- tycon tc
; mkTyConApp tc' <$> go_tys env tys }
......@@ -949,36 +950,36 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
| otherwise
= mkTyConApp tc <$> go_tys env tys
go_ty env (ForAllTy (Bndr tv vis) inner)
= do { (env', tv') <- tycobinder env tv vis
go_ty !env (ForAllTy (Bndr tv vis) inner)
= do { tycobinder env tv vis $ \env' tv' -> do
; inner' <- go_ty env' inner
; return $ ForAllTy (Bndr tv' vis) inner' }
go_cos _ [] = return []
go_cos env (co:cos) = (:) <$> go_co env co <*> go_cos env cos
go_cos !_ [] = return []
go_cos !env (co:cos) = (:) <$> go_co env co <*> go_cos env cos
go_mco _ MRefl = return MRefl
go_mco env (MCo co) = MCo <$> (go_co env co)
go_mco !_ MRefl = return MRefl
go_mco !env (MCo co) = MCo <$> (go_co env co)
go_co env (Refl ty) = Refl <$> go_ty env ty
go_co env (GRefl r ty mco) = mkGReflCo r <$> go_ty env ty <*> go_mco env mco
go_co env (AppCo c1 c2) = mkAppCo <$> go_co env c1 <*> go_co env c2
go_co env (FunCo r afl afr cw c1 c2) = mkFunCo2 r afl afr <$> go_co env cw
go_co !env (Refl ty) = Refl <$> go_ty env ty
go_co !env (GRefl r ty mco) = mkGReflCo r <$> go_ty env ty <*> go_mco env mco
go_co !env (AppCo c1 c2) = mkAppCo <$> go_co env c1 <*> go_co env c2
go_co !env (FunCo r afl afr cw c1 c2) = mkFunCo2 r afl afr <$> go_co env cw
<*> go_co env c1 <*> go_co env c2
go_co env (CoVarCo cv) = covar env cv
go_co env (HoleCo hole) = cohole env hole
go_co env (UnivCo p r t1 t2) = mkUnivCo <$> go_prov env p <*> pure r
go_co !env (CoVarCo cv) = covar env cv
go_co !env (HoleCo hole) = cohole env hole
go_co !env (UnivCo p r t1 t2) = mkUnivCo <$> go_prov env p <*> pure r
<*> go_ty env t1 <*> go_ty env t2
go_co env (SymCo co) = mkSymCo <$> go_co env co
go_co env (TransCo c1 c2) = mkTransCo <$> go_co env c1 <*> go_co env c2
go_co env (AxiomRuleCo r cos) = AxiomRuleCo r <$> go_cos env cos
go_co env (SelCo i co) = mkSelCo i <$> go_co env co
go_co env (LRCo lr co) = mkLRCo lr <$> go_co env co
go_co env (InstCo co arg) = mkInstCo <$> go_co env co <*> go_co env arg
go_co env (KindCo co) = mkKindCo <$> go_co env co
go_co env (SubCo co) = mkSubCo <$> go_co env co
go_co env (AxiomInstCo ax i cos) = mkAxiomInstCo ax i <$> go_cos env cos
go_co env co@(TyConAppCo r tc cos)
go_co !env (SymCo co) = mkSymCo <$> go_co env co
go_co !env (TransCo c1 c2) = mkTransCo <$> go_co env c1 <*> go_co env c2
go_co !env (AxiomRuleCo r cos) = AxiomRuleCo r <$> go_cos env cos
go_co !env (SelCo i co) = mkSelCo i <$> go_co env co
go_co !env (LRCo lr co) = mkLRCo lr <$> go_co env co
go_co !env (InstCo co arg) = mkInstCo <$> go_co env co <*> go_co env arg
go_co !env (KindCo co) = mkKindCo <$> go_co env co
go_co !env (SubCo co) = mkSubCo <$> go_co env co
go_co !env (AxiomInstCo ax i cos) = mkAxiomInstCo ax i <$> go_cos env cos
go_co !env co@(TyConAppCo r tc cos)
| isTcTyCon tc
= do { tc' <- tycon tc
; mkTyConAppCo r tc' <$> go_cos env cos }
......@@ -989,17 +990,17 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
| otherwise
= mkTyConAppCo r tc <$> go_cos env cos
go_co env (ForAllCo tv kind_co co)
go_co !env (ForAllCo tv kind_co co)
= do { kind_co' <- go_co env kind_co
; (env', tv') <- tycobinder env tv Inferred
; tycobinder env tv Inferred $ \env' tv' -> do
; co' <- go_co env' co
; return $ mkForAllCo tv' kind_co' co' }
-- See Note [Efficiency for ForAllCo case of mapTyCoX]
go_prov env (PhantomProv co) = PhantomProv <$> go_co env co
go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co
go_prov _ p@(PluginProv _) = return p
go_prov _ p@(CorePrepProv _) = return p
go_prov !env (PhantomProv co) = PhantomProv <$> go_co env co
go_prov !env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co
go_prov !_ p@(PluginProv _) = return p
go_prov !_ p@(CorePrepProv _) = return p
{- *********************************************************************
......
......@@ -1430,13 +1430,16 @@ data UMState = UMState
newtype UM a
= UM' { unUM :: UMState -> UnifyResultM (UMState, a) }
-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
deriving (Functor)
pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a
-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
pattern UM m <- UM' m
where
UM m = UM' (oneShot m)
{-# COMPLETE UM #-}
instance Functor UM where
fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s))
instance Applicative UM where
pure a = UM (\s -> pure (s, a))
......
......@@ -109,7 +109,7 @@ import GHC.Utils.Misc
import Data.ByteString ( ByteString )
import Data.Function ( on )
import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL )
import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL, (\\) )
import Data.Ord ( comparing )
import qualified Data.Set as Set
import GHC.Types.RepType (isZeroBitTy)
......@@ -909,6 +909,50 @@ Note [Combine identical alternatives: wrinkles]
here.
See Note [Combine case alts: awkward corner] in GHC.Core.Opt.CSE).
Note [Combine identical alternatives: Unfoldings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data Int = I# Int#
g :: Int -> Int
g n = case n of
2 -> 2
n -> n
This is just the identity function in disguise. We encountered this artificial
example in #20138. The Simplifier sees
T20138.g
= \ (n_awv [Occ=Once1!] :: GHC.Types.Int) ->
case n_awv of wild_X1 [Occ=Once1]
{ GHC.Types.I# ds_dSv [Occ=Once1!] ->
case ds_dSv of {
__DEFAULT -> wild_X1;
2# -> GHC.Types.I# 2#
}
}
and we would really like to combine the alts, yielding the underlying identity
function.
For that we need a special kind of 'cheapEqExpr', called 'cheapEqAlts', that
1. Looks through the unfolding of wild_X1, so that the first Alt reads
`I# ds_dSv`
2. Knows and unfolds the local equality `ds_dSv ~ 2#` from the 2# branch of
the inner Alt.
(This is often called equality modulo δ, that is, equality modulo replacing
occurrences with their definition, as in
https://coq.inria.fr/refman/language/core/conversion.html#delta-reduction-sect.)
'cheapEqAlts' accomplishes (1) by simply expanding unfoldings such that of
wild_X1 and (2) by applying a poor-man's substitution
`[ds_dSv :-> 2#] :: VarEnv CoreExpr` to variables in the supposed
DEFAULT alt that encodes the local equality..
It does *not* need to take an in-scope set because it will give up on the first
binding construct. The caller must be sure not to pass on equalities that had
already been shadowed.
Note [Care with impossible-constructors when combining alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have (#10538)
......@@ -952,14 +996,16 @@ missed the first one.)
-}
combineIdenticalAlts :: [AltCon] -- Constructors that cannot match DEFAULT
combineIdenticalAlts :: CoreExpr -- Scrutinee
-> Id -- Case binder
-> [AltCon] -- Constructors that cannot match DEFAULT
-> [CoreAlt]
-> (Bool, -- True <=> something happened
[AltCon], -- New constructors that cannot match DEFAULT
[CoreAlt]) -- New alternatives
-- See Note [Combine identical alternatives]
-- True <=> we did some combining, result is a single DEFAULT alternative
combineIdenticalAlts imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts)
combineIdenticalAlts scrut case_bndr imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts)
| all isDeadBinder bndrs1 -- Remember the default
, not (null elim_rest) -- alternative comes first
= (True, imposs_deflt_cons', deflt_alt : filtered_rest)
......@@ -974,12 +1020,18 @@ combineIdenticalAlts imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts)
DEFAULT -> []
_ -> [con1]
cheapEqTicked e1 e2 = cheapEqExpr' tickishFloatable e1 e2
identical_to_alt1 (Alt _con bndrs rhs)
= all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1
identical_to_alt1 (Alt con bndrs rhs)
= all isDeadBinder bndrs && cheapEqAlts unfs rhs rhs1
where
unfs
| DEFAULT <- con = emptyVarEnv
| otherwise = mkVarEnv [ (v,mkAltExpr con bndrs arg_tys) | v <- subst_bndrs ]
subst_bndrs = (case_bndr : [ scrut_var | Var scrut_var <- [scrut] ]) Data.List.\\ bndrs1
arg_tys = tyConAppArgs (idType case_bndr)
tickss = map (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) elim_rest
combineIdenticalAlts imposs_cons alts
combineIdenticalAlts _ _ imposs_cons alts
= (False, imposs_cons, alts)
-- Scales the multiplicity of the binders of a list of case alternatives. That
......@@ -993,6 +1045,39 @@ scaleAltsBy w alts = map scaleAlt alts
scaleBndr :: CoreBndr -> CoreBndr
scaleBndr b = scaleVarBy w b
-- | Cheap expression equality test comparing to the (soon to be) DEFAULT RHS.
-- The IdEnv encodes local equalities to be applied in the DEFAULT RHS that hold
-- in the RHS we try to equate to.
--
-- This is a close sibling of 'cheapEqExpr' to accommodate
-- Note [Combine identical alternatives: Unfoldings]
cheapEqAlts :: IdEnv CoreExpr -> CoreExpr -> CoreExpr -> Bool
cheapEqAlts unf_env rhs default_rhs
= go rhs default_rhs
where
go e1 (Var v2)
| Just unf <- lookupVarEnv unf_env v2 -- only need to expand the case binder in the DEFAULT alt
= go e1 unf
| Just unf <- get_unf v2 = go e1 unf
go (Var v1) e2
| Just unf <- get_unf v1 = go unf e2
go (Var v1) (Var v2) = v1 == v2
go (Lit lit1) (Lit lit2) = lit1 == lit2
go (Type t1) (Type t2) = t1 `eqType` t2
go (Coercion c1) (Coercion c2) = c1 `eqCoercion` c2
go (App f1 a1) (App f2 a2) = f1 `go` f2 && a1 `go` a2
go (Cast e1 t1) (Cast e2 t2) = e1 `go` e2 && t1 `eqCoercion` t2
go (Tick t1 e1) e2 | tickishFloatable t1 = go e1 e2
go e1 (Tick t2 e2) | tickishFloatable t2 = go e1 e2
go (Tick t1 e1) (Tick t2 e2) = t1 == t2 && e1 `go` e2
go _ _ = False
get_unf :: Var -> Maybe CoreExpr
get_unf v | isId v = expandUnfolding_maybe (idUnfolding v)
| otherwise = Nothing
{- *********************************************************************
* *
......
......@@ -2108,9 +2108,9 @@ subst_tyco_mapper = TyCoMapper
{ tcm_tyvar = \env tv -> return (lookup_tce_tv env tv)
, tcm_covar = \env cv -> return (lookup_tce_cv env cv)
, tcm_hole = \_ hole -> pprPanic "subst_co_mapper:hole" (ppr hole)
, tcm_tycobinder = \env tcv _vis -> if isTyVar tcv
then return (subst_tv_bndr env tcv)
else return (subst_cv_bndr env tcv)
, tcm_tycobinder = \env tcv _vis k -> if isTyVar tcv
then uncurry k (subst_tv_bndr env tcv)
else uncurry k (subst_cv_bndr env tcv)
, tcm_tycon = \tc -> return tc }
subst_ty :: CpeTyCoEnv -> Type -> Identity Type
......