Skip to content
Snippets Groups Projects

Compare revisions

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

Source

Select target project
No results found

Target

Select target project
  • ghc/ghc
  • bgamari/ghc
  • syd/ghc
  • ggreif/ghc
  • watashi/ghc
  • RolandSenn/ghc
  • mpickering/ghc
  • DavidEichmann/ghc
  • carter/ghc
  • harpocrates/ghc
  • ethercrow/ghc
  • mijicd/ghc
  • adamse/ghc
  • alexbiehl/ghc
  • gridaphobe/ghc
  • trofi/ghc
  • supersven/ghc
  • ppk/ghc
  • ulysses4ever/ghc
  • AndreasK/ghc
  • ghuntley/ghc
  • shayne-fletcher-da/ghc
  • fgaz/ghc
  • yav/ghc
  • osa1/ghc
  • mbbx6spp/ghc
  • JulianLeviston/ghc
  • reactormonk/ghc
  • rae/ghc
  • takenobu-hs/ghc
  • michalt/ghc
  • andrewthad/ghc
  • hsyl20/ghc
  • scottgw/ghc
  • sjakobi/ghc
  • angerman/ghc
  • RyanGlScott/ghc
  • hvr/ghc
  • howtonotwin/ghc
  • chessai/ghc
  • m-renaud/ghc
  • brprice/ghc
  • stevehartdata/ghc
  • sighingnow/ghc
  • kgardas/ghc
  • ckoparkar/ghc
  • alp/ghc
  • smaeul/ghc
  • kakkun61/ghc
  • sykloid/ghc
  • newhoggy/ghc
  • toonn/ghc
  • nineonine/ghc
  • Phyx/ghc
  • ezyang/ghc
  • tweag/ghc
  • langston/ghc
  • ndmitchell/ghc
  • rockbmb/ghc
  • artempyanykh/ghc
  • mniip/ghc
  • mynguyenbmc/ghc
  • alexfmpe/ghc
  • crockeea/ghc
  • nh2/ghc
  • vaibhavsagar/ghc
  • phadej/ghc
  • Haskell-mouse/ghc
  • lolotp/ghc
  • spacekitteh/ghc
  • michaelpj/ghc
  • mgsloan/ghc
  • HPCohen/ghc
  • tmobile/ghc
  • radrow/ghc
  • simonmar/ghc
  • _deepfire/ghc
  • Ericson2314/ghc
  • leitao/ghc
  • fumieval/ghc
  • trac-isovector/ghc
  • cblp/ghc
  • xich/ghc
  • ciil/ghc
  • erthalion/ghc
  • xldenis/ghc
  • autotaker/ghc
  • haskell-wasm/ghc
  • kcsongor/ghc
  • agander/ghc
  • Baranowski/ghc
  • trac-dredozubov/ghc
  • 23Skidoo/ghc
  • iustin/ghc
  • ningning/ghc
  • josefs/ghc
  • kabuhr/ghc
  • gallais/ghc
  • dten/ghc
  • expipiplus1/ghc
  • Pluralia/ghc
  • rohanjr/ghc
  • intricate/ghc
  • kirelagin/ghc
  • Javran/ghc
  • DanielG/ghc
  • trac-mizunashi_mana/ghc
  • pparkkin/ghc
  • bollu/ghc
  • ntc2/ghc
  • jaspervdj/ghc
  • JoshMeredith/ghc
  • wz1000/ghc
  • zkourouma/ghc
  • code5hot/ghc
  • jdprice/ghc
  • tdammers/ghc
  • J-mie6/ghc
  • trac-lantti/ghc
  • ch1bo/ghc
  • cgohla/ghc
  • lucamolteni/ghc
  • acairncross/ghc
  • amerocu/ghc
  • chreekat/ghc
  • txsmith/ghc
  • trupill/ghc
  • typetetris/ghc
  • sergv/ghc
  • fryguybob/ghc
  • erikd/ghc
  • trac-roland/ghc
  • setupminimal/ghc
  • Friede80/ghc
  • SkyWriter/ghc
  • xplorld/ghc
  • abrar/ghc
  • obsidiansystems/ghc
  • Icelandjack/ghc
  • adinapoli/ghc
  • trac-matthewbauer/ghc
  • heatsink/ghc
  • dwijnand/ghc
  • Cmdv/ghc
  • alinab/ghc
  • pepeiborra/ghc
  • fommil/ghc
  • luochen1990/ghc
  • rlupton20/ghc
  • applePrincess/ghc
  • lehins/ghc
  • ronmrdechai/ghc
  • leeadam/ghc
  • harendra/ghc
  • mightymosquito1991/ghc
  • trac-gershomb/ghc
  • lucajulian/ghc
  • Rizary/ghc
  • VictorCMiraldo/ghc
  • jamesbrock/ghc
  • andrewdmeier/ghc
  • luke/ghc
  • pranaysashank/ghc
  • cocreature/ghc
  • hithroc/ghc
  • obreitwi/ghc
  • slrtbtfs/ghc
  • kaol/ghc
  • yairchu/ghc
  • Mathemagician98/ghc
  • trac-taylorfausak/ghc
  • leungbk/ghc
  • MichaWiedenmann/ghc
  • chris-martin/ghc
  • TDecki/ghc
  • adithyaov/ghc
  • trac-gelisam/ghc
  • Lysxia/ghc
  • complyue/ghc
  • bwignall/ghc
  • sternmull/ghc
  • sonika/ghc
  • leif/ghc
  • broadwaylamb/ghc
  • myszon/ghc
  • danbroooks/ghc
  • Mechachleopteryx/ghc
  • zardyh/ghc
  • trac-vdukhovni/ghc
  • OmarKhaledAbdo/ghc
  • arrowd/ghc
  • Bodigrim/ghc
  • matheus23/ghc
  • cardenaso11/ghc
  • trac-Athas/ghc
  • mb720/ghc
  • DylanZA/ghc
  • liff/ghc
  • typedrat/ghc
  • trac-claude/ghc
  • jbm/ghc
  • Gertjan423/ghc
  • PHO/ghc
  • JKTKops/ghc
  • kockahonza/ghc
  • msakai/ghc
  • Sir4ur0n/ghc
  • barambani/ghc
  • vishnu.c/ghc
  • dcoutts/ghc
  • trac-runeks/ghc
  • trac-MaxGabriel/ghc
  • lexi.lambda/ghc
  • strake/ghc
  • spavikevik/ghc
  • JakobBruenker/ghc
  • rmanne/ghc
  • gdziadkiewicz/ghc
  • ani/ghc
  • iliastsi/ghc
  • smunix/ghc
  • judah/ghc
  • blackgnezdo/ghc
  • emilypi/ghc
  • trac-bpfoley/ghc
  • muesli4/ghc
  • trac-gkaracha/ghc
  • Kleidukos/ghc
  • nek0/ghc
  • TristanCacqueray/ghc
  • dwulive/ghc
  • mbakke/ghc
  • arybczak/ghc
  • Yang123321/ghc
  • maksbotan/ghc
  • QuietMisdreavus/ghc
  • trac-olshanskydr/ghc
  • emekoi/ghc
  • samuela/ghc
  • josephcsible/ghc
  • dramforever/ghc
  • lpsmith/ghc
  • DenisFrezzato/ghc
  • michivi/ghc
  • jneira/ghc
  • jeffhappily/ghc
  • Ivan-Yudin/ghc
  • nakaji-dayo/ghc
  • gdevanla/ghc
  • galen/ghc
  • fendor/ghc
  • yaitskov/ghc
  • rcythr/ghc
  • awpr/ghc
  • jeremyschlatter/ghc
  • Aver1y/ghc
  • mitchellvitez/ghc
  • merijn/ghc
  • tomjaguarpaw1/ghc
  • trac-NoidedSuper/ghc
  • erewok/ghc
  • trac-junji.hashimoto/ghc
  • adamwespiser/ghc
  • bjaress/ghc
  • jhrcek/ghc
  • leonschoorl/ghc
  • lukasz-golebiewski/ghc
  • sheaf/ghc
  • last-g/ghc
  • carassius1014/ghc
  • eschwartz/ghc
  • dwincort/ghc
  • felixwiemuth/ghc
  • TimWSpence/ghc
  • marcusmonteirodesouza/ghc
  • WJWH/ghc
  • vtols/ghc
  • theobat/ghc
  • BinderDavid/ghc
  • ckoparkar0/ghc
  • alexander-kjeldaas/ghc
  • dme2/ghc
  • philderbeast/ghc
  • aaronallen8455/ghc
  • rayshih/ghc
  • benkard/ghc
  • mpardalos/ghc
  • saidelman/ghc
  • leiftw/ghc
  • ca333/ghc
  • bwroga/ghc
  • nmichael44/ghc
  • trac-crobbins/ghc
  • felixonmars/ghc
  • adityagupta1089/ghc
  • hgsipiere/ghc
  • treeowl/ghc
  • alexpeits/ghc
  • CraigFe/ghc
  • dnlkrgr/ghc
  • kerckhove_ts/ghc
  • cptwunderlich/ghc
  • eiais/ghc
  • hahohihu/ghc
  • sanchayan/ghc
  • lemmih/ghc
  • sehqlr/ghc
  • trac-dbeacham/ghc
  • luite/ghc
  • trac-f-a/ghc
  • vados/ghc
  • luntain/ghc
  • fatho/ghc
  • alexbiehl-gc/ghc
  • dcbdan/ghc
  • tvh/ghc
  • liam-ly/ghc
  • timbobbarnes/ghc
  • GovanifY/ghc
  • shanth2600/ghc
  • gliboc/ghc
  • duog/ghc
  • moxonsghost/ghc
  • zander/ghc
  • masaeedu/ghc
  • georgefst/ghc
  • guibou/ghc
  • nicuveo/ghc
  • mdebruijne/ghc
  • stjordanis/ghc
  • emiflake/ghc
  • wygulmage/ghc
  • frasertweedale/ghc
  • coot/ghc
  • aratamizuki/ghc
  • tsandstr/ghc
  • mrBliss/ghc
  • Anton-Latukha/ghc
  • tadfisher/ghc
  • vapourismo/ghc
  • Sorokin-Anton/ghc
  • basile-henry/ghc
  • trac-mightybyte/ghc
  • AbsoluteNikola/ghc
  • cobrien99/ghc
  • songzh/ghc
  • blamario/ghc
  • aj4ayushjain/ghc
  • trac-utdemir/ghc
  • tangcl/ghc
  • hdgarrood/ghc
  • maerwald/ghc
  • arjun/ghc
  • ratherforky/ghc
  • haskieLambda/ghc
  • EmilGedda/ghc
  • Bogicevic/ghc
  • eddiejessup/ghc
  • kozross/ghc
  • AlistairB/ghc
  • 3Rafal/ghc
  • christiaanb/ghc
  • trac-bit/ghc
  • matsumonkie/ghc
  • trac-parsonsmatt/ghc
  • chisui/ghc
  • jaro/ghc
  • trac-kmiyazato/ghc
  • davidsd/ghc
  • Tritlo/ghc
  • I-B-3/ghc
  • lykahb/ghc
  • AriFordsham/ghc
  • turion1/ghc
  • berberman/ghc
  • christiantakle/ghc
  • zyklotomic/ghc
  • trac-ocramz/ghc
  • CSEdd/ghc
  • doyougnu/ghc
  • mmhat/ghc
  • why-not-try-calmer/ghc
  • plutotulp/ghc
  • kjekac/ghc
  • Manvi07/ghc
  • teo/ghc
  • cactus/ghc
  • CarrieMY/ghc
  • abel/ghc
  • yihming/ghc
  • tsakki/ghc
  • jessicah/ghc
  • oliverbunting/ghc
  • meld/ghc
  • friedbrice/ghc
  • Joald/ghc
  • abarbu/ghc
  • DigitalBrains1/ghc
  • sterni/ghc
  • alexDarcy/ghc
  • hexchain/ghc
  • minimario/ghc
  • zliu41/ghc
  • tommd/ghc
  • jazcarate/ghc
  • peterbecich/ghc
  • alirezaghey/ghc
  • solomon/ghc
  • mikael.urankar/ghc
  • davjam/ghc
  • int-index/ghc
  • MorrowM/ghc
  • nrnrnr/ghc
  • Sonfamm/ghc-test-only
  • afzt1/ghc
  • nguyenhaibinh-tpc/ghc
  • trac-lierdakil/ghc
  • MichaWiedenmann1/ghc
  • jmorag/ghc
  • Ziharrk/ghc
  • trac-MitchellSalad/ghc
  • juampe/ghc
  • jwaldmann/ghc
  • snowleopard/ghc
  • juhp/ghc
  • normalcoder/ghc
  • ksqsf/ghc
  • trac-jberryman/ghc
  • roberth/ghc
  • 1ntEgr8/ghc
  • epworth/ghc
  • MrAdityaAlok/ghc
  • JunmingZhao42/ghc
  • jappeace/ghc
  • trac-Gabriel439/ghc
  • alt-romes/ghc
  • HugoPeters1024/ghc
  • 10ne1/ghc-fork
  • agentultra/ghc
  • Garfield1002/ghc
  • ChickenProp/ghc
  • clyring/ghc
  • MaxHearnden/ghc
  • jumper149/ghc
  • vem/ghc
  • ketzacoatl/ghc
  • Rosuavio/ghc
  • jackohughes/ghc
  • p4l1ly/ghc
  • konsumlamm/ghc
  • shlevy/ghc
  • torsten.schmits/ghc
  • andremarianiello/ghc
  • amesgen/ghc
  • googleson78/ghc
  • InfiniteVerma/ghc
  • uhbif19/ghc
  • yiyunliu/ghc
  • raehik/ghc
  • mrkun/ghc
  • telser/ghc
  • 1Jajen1/ghc
  • slotThe/ghc
  • WinstonHartnett/ghc
  • mpilgrem/ghc
  • dreamsmasher/ghc
  • schuelermine/ghc
  • trac-Viwor/ghc
  • undergroundquizscene/ghc
  • evertedsphere/ghc
  • coltenwebb/ghc
  • oberblastmeister/ghc
  • agrue/ghc
  • lf-/ghc
  • zacwood9/ghc
  • steshaw/ghc
  • high-cloud/ghc
  • SkamDart/ghc
  • PiDelport/ghc
  • maoif/ghc
  • RossPaterson/ghc
  • CharlesTaylor7/ghc
  • ribosomerocker/ghc
  • trac-ramirez7/ghc
  • daig/ghc
  • NicolasT/ghc
  • FinleyMcIlwaine/ghc
  • lawtonnichols/ghc
  • jmtd/ghc
  • ozkutuk/ghc
  • wildsebastian/ghc
  • lrzlin/ghc
  • tobias/ghc
  • fw/ghc
  • hawkinsw/ghc
  • type-dance/ghc
  • rui314/ghc
  • ocharles/ghc
  • wavewave/ghc
  • TheKK/ghc
  • nomeata/ghc
  • trac-csabahruska/ghc
  • jonathanjameswatson/ghc
  • L-as/ghc
  • Axman6/ghc
  • barracuda156/ghc
  • trac-jship/ghc
  • jake-87/ghc
  • meooow/ghc
  • rebeccat/ghc
  • hamana55/ghc
  • Enigmage/ghc
  • kokobd/ghc
  • agevelt/ghc
  • gshen42/ghc
  • chrismwendt/ghc
  • MangoIV/ghc
  • teto/ghc
  • Sookr1/ghc
  • trac-thomasjm/ghc
  • barci2/ghc-dev
  • trac-m4dc4p/ghc
  • dixonary/ghc
  • breakerzirconia/ghc
  • alexsio27444/ghc
  • glocq/ghc
  • sourabhxyz/ghc
  • ryantrinkle/ghc
  • Jade/ghc
  • scedfaliako/ghc
  • martijnbastiaan/ghc
  • trac-george.colpitts/ghc
  • ammarbinfaisal/ghc
  • mimi.vx/ghc
  • lortabac/ghc
  • trac-zyla/ghc
  • benbellick/ghc
  • aadaa-fgtaa/ghc
  • jvanbruegge/ghc
  • archbung/ghc
  • gilmi/ghc
  • mfonism/ghc
  • alex-mckenna/ghc
  • Ei30metry/ghc
  • DiegoDiverio/ghc
  • jorgecunhamendes/ghc
  • liesnikov/ghc
  • akrmn/ghc
  • trac-simplifierticks/ghc
  • jacco/ghc
  • rhendric/ghc
  • damhiya/ghc
  • ryndubei/ghc
  • DaveBarton/ghc
  • trac-Profpatsch/ghc
  • GZGavinZhao/ghc
  • ncfavier/ghc
  • jameshaydon/ghc
  • ajccosta/ghc
  • dschrempf/ghc
  • cydparser/ghc
  • LinuxUserGD/ghc
  • elodielander/ghc
  • facundominguez/ghc
  • psilospore/ghc
  • lachrimae/ghc
  • dylan-thinnes/ghc-type-errors-plugin
  • hamishmack/ghc
  • Leary/ghc
  • lzszt/ghc
  • lyokha/ghc
  • trac-glaubitz/ghc
  • Rewbert/ghc
  • andreabedini/ghc
  • Jasagredo/ghc
  • sol/ghc
  • OlegAlexander/ghc
  • trac-sthibaul/ghc
  • avdv/ghc
  • Wendaolee/ghc
  • ur4t/ghc
  • daylily/ghc
  • boltzmannrain/ghc
  • mmzk1526/ghc
  • trac-fizzixnerd/ghc
  • soulomoon/ghc
  • rwmjones/ghc
  • j14i/ghc
  • tracsis/ghc
  • gesh/ghc
  • flip101/ghc
  • eldritch-cookie/ghc
  • LemonjamesD/ghc
  • pgujjula/ghc
  • skeuchel/ghc
  • noteed/ghc
  • Torrekie/ghc
  • jlwoodwa/ghc
  • ayanamists/ghc
  • husong998/ghc
  • trac-edmundnoble/ghc
  • josephf/ghc
  • contrun/ghc
  • baulig/ghc
  • edsko/ghc
  • mzschr/ghc-issue-24732
  • ulidtko/ghc
  • Arsen/ghc
  • trac-sjoerd_visscher/ghc
  • crumbtoo/ghc
  • L0neGamer/ghc
  • DrewFenwick/ghc
  • benz0li/ghc
  • MaciejWas/ghc
  • jordanrule/ghc
  • trac-qqwy/ghc
  • LiamGoodacre/ghc
  • isomorpheme/ghc
  • trac-danidiaz/ghc
  • Kariim/ghc
  • MTaimoorZaeem/ghc
  • hololeap/ghc
  • ticat-fp/ghc
  • meritamen/ghc
  • criskell/ghc
  • trac-kraai/ghc
  • aergus/ghc
  • jdral/ghc
  • SamB/ghc
  • Tristian/ghc
  • ywgrit/ghc
  • KatsuPatrick/ghc
  • OsePedro/ghc
  • mpscholten/ghc
  • zaquest/ghc
  • fangyi-zhou/ghc
  • augyg/ghc
  • rkirkman/ghc
  • gulin.serge/ghc-windows-aarch64-bootstrap
  • iris/ghc
  • kwxm/ghc
  • maralorn/ghc
  • rafl/ghc
  • nikshalark/ghc
  • mrcjkb/ghc
  • blackheaven/ghc
  • laurenyim/ghc
  • bolt12/ghc
  • Xitian9/ghc
  • wenkokke/ghc
650 results
Show changes
Commits on Source (168)
Showing
with 514 additions and 235 deletions
...@@ -154,3 +154,11 @@ _darcs/ ...@@ -154,3 +154,11 @@ _darcs/
.tm_properties .tm_properties
VERSION VERSION
GIT_COMMIT_ID GIT_COMMIT_ID
# -------------------------------------------------------------------------------------
# when using a docker image, one can mount the source code directory as the home folder
# -------------------------------------------------------------------------------------
.arcrc
.ghc
.bash_history
.gitconfig
...@@ -10,6 +10,7 @@ ...@@ -10,6 +10,7 @@
path = libraries/Cabal path = libraries/Cabal
url = ../packages/Cabal.git url = ../packages/Cabal.git
ignore = untracked ignore = untracked
branch = 1.22
[submodule "libraries/containers"] [submodule "libraries/containers"]
path = libraries/containers path = libraries/containers
url = ../packages/containers.git url = ../packages/containers.git
...@@ -102,7 +103,7 @@ ...@@ -102,7 +103,7 @@
path = utils/haddock path = utils/haddock
url = ../haddock.git url = ../haddock.git
ignore = none ignore = none
branch = ghc-head branch = master
[submodule "nofib"] [submodule "nofib"]
path = nofib path = nofib
url = ../nofib.git url = ../nofib.git
......
Building & Installing
=====================
For full information on building GHC, see the GHC Building Guide [1].
Here follows a summary - if you get into trouble, the Building Guide
has all the answers.
Before building GHC you may need to install some other tools and
libraries. See "Setting up your system for building GHC" [2].
NB. in particular you need GHC installed in order to build GHC,
because the compiler is itself written in Haskell. For instructions
on how to port GHC to a new platform, see the Building Guide [1].
For building library documentation, you'll need Haddock [3]. To build
the compiler documentation, you need a good DocBook XML toolchain and
dblatex.
Quick start: the following gives you a default build:
$ perl boot
$ ./configure
$ make
$ make install
The "perl boot" step is only necessary if this is a tree checked out
from git. For source distributions downloaded from GHC's web site,
this step has already been performed.
These steps give you the default build, which includes everything
optimised and built in various ways (eg. profiling libs are built).
It can take a long time. To customise the build, see the file
`HACKING.md`.
References
==========
[1] http://www.haskell.org/ghc/
[2] http://hackage.haskell.org/trac/ghc/wiki/Building/Preparation
[3] http://www.haskell.org/haddock/
Using the GHC build system
--------------------------
For a "Getting Started" guide, see:
http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking
Common commands:
make
Builds everything: ghc stages 1 and 2, all libraries and tools.
make -j2
Parallel build: runs up to 2 commands at a time (use the number of
CPUs in your machine in place of '2')
cd <dir>; make
Builds everything in the given directory.
cd <dir>; make help
Shows the targets available in <dir>
make install
Installs GHC, libraries and tools under $(prefix)
make sdist
make binary-dist
Builds a source or binary distribution respectively
make show VALUE=<var>
Displays the value of make variable <var>
make clean
make distclean
make maintainer-clean
Various levels of cleaning: "clean" restores the tree to the
state after "./configure", "distclean" restores to the state
after "perl boot", and maintainer-clean restores the tree to the
completely clean checked-out state.
Quick `make` guide for GHC
==========================
For a "Getting Started" guide, see:
http://ghc.haskell.org/trac/ghc/wiki/Building/Hacking
Common commands:
- `make`
Builds everything: ghc stages 1 and 2, all libraries and tools.
- `make -j2`
Parallel build: runs up to 2 commands at a time.
- `cd <dir>; make`
Builds everything in the given directory.
- cd <dir>; make help
Shows the targets available in <dir>
- make install
Installs GHC, libraries and tools under $(prefix)
- make sdist
- make binary-dist
Builds a source or binary distribution respectively
- `make show VALUE=<var>`
Displays the value of make variable <var>
- make clean
- make distclean
- make maintainer-clean
Various levels of cleaning: "clean" restores the tree to the
state after "./configure", "distclean" restores to the state
after "perl boot", and maintainer-clean restores the tree to the
completely clean checked-out state.
Using `make` in subdirectories
==============================
- `make`
Builds everything in this directory (including dependencies elsewhere
in the tree, if necessary)
- `make fast`
The same as 'make', but omits some phases and does not
recalculate dependencies. Useful for saving time if you are sure
the rest of the tree is up to date.
- `make clean`
- `make distclean`
- `make maintainer-clean`
Clean just this directory
- `make html`
- `make pdf`
- `make ps`
Make documentation in this directory (if any)
- `make show VALUE=var`
Show the value of $(var)
- `make <file>`
Bring a particular file up to date, e.g. make dist/build/Module.o
The name <file> is relative to the current directory
make
Builds everything in this directory (including dependencies elsewhere
in the tree, if necessary)
make fast
The same as 'make', but omits some phases and does not
recalculate dependencies. Useful for saving time if you are sure
the rest of the tree is up to date.
make clean
make distclean
make maintainer-clean
Clean just this directory
make html
make pdf
make ps
Make documentation in this directory (if any)
make show VALUE=var
Show the value of $(var)
make <file>
Bring a particular file up to date, e.g. make dist/build/Module.o
The name <file> is relative to the current directory
...@@ -565,6 +565,11 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ...@@ -565,6 +565,11 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
$3="$$3 -D_HPUX_SOURCE" $3="$$3 -D_HPUX_SOURCE"
$5="$$5 -D_HPUX_SOURCE" $5="$$5 -D_HPUX_SOURCE"
;; ;;
arm*linux*)
# On arm/linux and arm/android, tell gcc to link using the gold linker.
# Forcing LD to be ld.gold is done in configre.ac.
$3="$$3 -fuse-ld=gold"
;;
esac esac
# If gcc knows about the stack protector, turn it off. # If gcc knows about the stack protector, turn it off.
...@@ -1826,6 +1831,28 @@ AC_DEFUN([FP_GMP], ...@@ -1826,6 +1831,28 @@ AC_DEFUN([FP_GMP],
AC_SUBST(GMP_LIB_DIRS) AC_SUBST(GMP_LIB_DIRS)
])# FP_GMP ])# FP_GMP
# FP_CURSES
# -------------
AC_DEFUN([FP_CURSES],
[
dnl--------------------------------------------------------------------
dnl * Deal with arguments telling us curses is somewhere odd
dnl--------------------------------------------------------------------
AC_ARG_WITH([curses-includes],
[AC_HELP_STRING([--with-curses-includes],
[directory containing curses headers])],
[CURSES_INCLUDE_DIRS=$withval])
AC_ARG_WITH([curses-libraries],
[AC_HELP_STRING([--with-curses-libraries],
[directory containing curses libraries])],
[CURSES_LIB_DIRS=$withval])
AC_SUBST(CURSES_INCLUDE_DIRS)
AC_SUBST(CURSES_LIB_DIRS)
])# FP_CURSES
# -------------------------------------------------------------- # --------------------------------------------------------------
# Calculate absolute path to build tree # Calculate absolute path to build tree
# -------------------------------------------------------------- # --------------------------------------------------------------
...@@ -2072,7 +2099,7 @@ AC_DEFUN([XCODE_VERSION],[ ...@@ -2072,7 +2099,7 @@ AC_DEFUN([XCODE_VERSION],[
# #
AC_DEFUN([FIND_LLVM_PROG],[ AC_DEFUN([FIND_LLVM_PROG],[
FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL_NOTARGET([$1], [$2], [$3]) FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL_NOTARGET([$1], [$2], [$3])
if test "$$1" == ""; then if test "$$1" = ""; then
save_IFS=$IFS save_IFS=$IFS
IFS=":;" IFS=":;"
for p in ${PATH}; do for p in ${PATH}; do
......
...@@ -84,7 +84,9 @@ module BasicTypes( ...@@ -84,7 +84,9 @@ module BasicTypes(
FractionalLit(..), negateFractionalLit, integralFractionalLit, FractionalLit(..), negateFractionalLit, integralFractionalLit,
HValue(..) HValue(..),
SourceText
) where ) where
import FastString import FastString
...@@ -261,14 +263,15 @@ initialVersion = 1 ...@@ -261,14 +263,15 @@ initialVersion = 1
-} -}
-- reason/explanation from a WARNING or DEPRECATED pragma -- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt = WarningTxt [Located FastString] -- For SourceText usage, see note [Pragma source text]
| DeprecatedTxt [Located FastString] data WarningTxt = WarningTxt (Located SourceText) [Located FastString]
| DeprecatedTxt (Located SourceText) [Located FastString]
deriving (Eq, Data, Typeable) deriving (Eq, Data, Typeable)
instance Outputable WarningTxt where instance Outputable WarningTxt where
ppr (WarningTxt ws) = doubleQuotes (vcat (map (ftext . unLoc) ws)) ppr (WarningTxt _ ws) = doubleQuotes (vcat (map (ftext . unLoc) ws))
ppr (DeprecatedTxt ds) = text "Deprecated:" <+> ppr (DeprecatedTxt _ ds) = text "Deprecated:" <+>
doubleQuotes (vcat (map (ftext . unLoc) ds)) doubleQuotes (vcat (map (ftext . unLoc) ds))
{- {-
************************************************************************ ************************************************************************
...@@ -446,6 +449,15 @@ instance Outputable Origin where ...@@ -446,6 +449,15 @@ instance Outputable Origin where
-- | The semantics allowed for overlapping instances for a particular -- | The semantics allowed for overlapping instances for a particular
-- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a
-- explanation of the `isSafeOverlap` field. -- explanation of the `isSafeOverlap` field.
--
-- - 'ApiAnnotation.AnnKeywordId' :
-- 'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
-- @'\{-\# OVERLAPPING'@ or
-- @'\{-\# OVERLAPS'@ or
-- @'\{-\# INCOHERENT'@,
-- 'ApiAnnotation.AnnClose' @`\#-\}`@,
-- For details on above see note [Api annotations] in ApiAnnotation
data OverlapFlag = OverlapFlag data OverlapFlag = OverlapFlag
{ overlapMode :: OverlapMode { overlapMode :: OverlapMode
, isSafeOverlap :: Bool , isSafeOverlap :: Bool
...@@ -458,27 +470,29 @@ setOverlapModeMaybe f (Just m) = f { overlapMode = m } ...@@ -458,27 +470,29 @@ setOverlapModeMaybe f (Just m) = f { overlapMode = m }
hasOverlappableFlag :: OverlapMode -> Bool hasOverlappableFlag :: OverlapMode -> Bool
hasOverlappableFlag mode = hasOverlappableFlag mode =
case mode of case mode of
Overlappable -> True Overlappable _ -> True
Overlaps -> True Overlaps _ -> True
Incoherent -> True Incoherent _ -> True
_ -> False _ -> False
hasOverlappingFlag :: OverlapMode -> Bool hasOverlappingFlag :: OverlapMode -> Bool
hasOverlappingFlag mode = hasOverlappingFlag mode =
case mode of case mode of
Overlapping -> True Overlapping _ -> True
Overlaps -> True Overlaps _ -> True
Incoherent -> True Incoherent _ -> True
_ -> False _ -> False
data OverlapMode -- See Note [Rules for instance lookup] in InstEnv data OverlapMode -- See Note [Rules for instance lookup] in InstEnv
= NoOverlap = NoOverlap SourceText
-- See Note [Pragma source text]
-- ^ This instance must not overlap another `NoOverlap` instance. -- ^ This instance must not overlap another `NoOverlap` instance.
-- However, it may be overlapped by `Overlapping` instances, -- However, it may be overlapped by `Overlapping` instances,
-- and it may overlap `Overlappable` instances. -- and it may overlap `Overlappable` instances.
| Overlappable | Overlappable SourceText
-- See Note [Pragma source text]
-- ^ Silently ignore this instance if you find a -- ^ Silently ignore this instance if you find a
-- more specific one that matches the constraint -- more specific one that matches the constraint
-- you are trying to resolve -- you are trying to resolve
...@@ -492,7 +506,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in InstEnv ...@@ -492,7 +506,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in InstEnv
-- its ambiguous which to choose) -- its ambiguous which to choose)
| Overlapping | Overlapping SourceText
-- See Note [Pragma source text]
-- ^ Silently ignore any more general instances that may be -- ^ Silently ignore any more general instances that may be
-- used to solve the constraint. -- used to solve the constraint.
-- --
...@@ -505,10 +520,12 @@ data OverlapMode -- See Note [Rules for instance lookup] in InstEnv ...@@ -505,10 +520,12 @@ data OverlapMode -- See Note [Rules for instance lookup] in InstEnv
-- it is ambiguous which to choose) -- it is ambiguous which to choose)
| Overlaps | Overlaps SourceText
-- See Note [Pragma source text]
-- ^ Equivalent to having both `Overlapping` and `Overlappable` flags. -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
| Incoherent | Incoherent SourceText
-- See Note [Pragma source text]
-- ^ Behave like Overlappable and Overlapping, and in addition pick -- ^ Behave like Overlappable and Overlapping, and in addition pick
-- an an arbitrary one if there are multiple matching candidates, and -- an an arbitrary one if there are multiple matching candidates, and
-- don't worry about later instantiation -- don't worry about later instantiation
...@@ -527,11 +544,11 @@ instance Outputable OverlapFlag where ...@@ -527,11 +544,11 @@ instance Outputable OverlapFlag where
ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
instance Outputable OverlapMode where instance Outputable OverlapMode where
ppr NoOverlap = empty ppr (NoOverlap _) = empty
ppr Overlappable = ptext (sLit "[overlappable]") ppr (Overlappable _) = ptext (sLit "[overlappable]")
ppr Overlapping = ptext (sLit "[overlapping]") ppr (Overlapping _) = ptext (sLit "[overlapping]")
ppr Overlaps = ptext (sLit "[overlap ok]") ppr (Overlaps _) = ptext (sLit "[overlap ok]")
ppr Incoherent = ptext (sLit "[incoherent]") ppr (Incoherent _) = ptext (sLit "[incoherent]")
pprSafeOverlap :: Bool -> SDoc pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = ptext $ sLit "[safe]" pprSafeOverlap True = ptext $ sLit "[safe]"
...@@ -763,6 +780,70 @@ succeeded Failed = False ...@@ -763,6 +780,70 @@ succeeded Failed = False
failed Succeeded = False failed Succeeded = False
failed Failed = True failed Failed = True
{-
************************************************************************
* *
\subsection{Source Text}
* *
************************************************************************
Keeping Source Text for source to source conversions
Note [Pragma source text]
~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer does a case-insensitive match for pragmas, as well as
accepting both UK and US spelling variants.
So
{-# SPECIALISE #-}
{-# SPECIALIZE #-}
{-# Specialize #-}
will all generate ITspec_prag token for the start of the pragma.
In order to be able to do source to source conversions, the original
source text for the token needs to be preserved, hence the
`SourceText` field.
So the lexer will then generate
ITspec_prag "{ -# SPECIALISE"
ITspec_prag "{ -# SPECIALIZE"
ITspec_prag "{ -# Specialize"
for the cases above.
[without the space between '{' and '-', otherwise this comment won't parse]
Note [Literal source text]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer/parser converts literals from their original source text
versions to an appropriate internal representation. This is a problem
for tools doing source to source conversions, so the original source
text is stored in literals where this can occur.
Motivating examples for HsLit
HsChar '\n' == '\x20`
HsCharPrim '\x41`# == `A`
HsString "\x20\x41" == " A"
HsStringPrim "\x20"# == " "#
HsInt 001 == 1
HsIntPrim 002# == 2#
HsWordPrim 003## == 3##
HsInt64Prim 004## == 4##
HsWord64Prim 005## == 5##
HsInteger 006 == 6
For OverLitVal
HsIntegral 003 == 0x003
HsIsString "\x41nd" == "And"
-}
type SourceText = String -- Note [Literal source text],[Pragma source text]
{- {-
************************************************************************ ************************************************************************
* * * *
...@@ -798,7 +879,8 @@ data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma] ...@@ -798,7 +879,8 @@ data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
data InlinePragma -- Note [InlinePragma] data InlinePragma -- Note [InlinePragma]
= InlinePragma = InlinePragma
{ inl_inline :: InlineSpec { inl_src :: SourceText -- Note [Pragma source text]
, inl_inline :: InlineSpec
, inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
-- explicit (non-type, non-dictionary) args -- explicit (non-type, non-dictionary) args
...@@ -888,7 +970,8 @@ isEmptyInlineSpec _ = False ...@@ -888,7 +970,8 @@ isEmptyInlineSpec _ = False
defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
:: InlinePragma :: InlinePragma
defaultInlinePragma = InlinePragma { inl_act = AlwaysActive defaultInlinePragma = InlinePragma { inl_src = "{-# INLINE"
, inl_act = AlwaysActive
, inl_rule = FunLike , inl_rule = FunLike
, inl_inline = EmptyInlineSpec , inl_inline = EmptyInlineSpec
, inl_sat = Nothing } , inl_sat = Nothing }
......
...@@ -9,7 +9,9 @@ ...@@ -9,7 +9,9 @@
module DataCon ( module DataCon (
-- * Main data types -- * Main data types
DataCon, DataConRep(..), HsBang(..), StrictnessMark(..), DataCon, DataConRep(..),
HsBang(..), HsSrcBang, HsImplBang,
StrictnessMark(..),
ConTag, ConTag,
-- ** Type construction -- ** Type construction
...@@ -26,11 +28,11 @@ module DataCon ( ...@@ -26,11 +28,11 @@ module DataCon (
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy, dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys, dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType, dataConFieldLabels, dataConFieldType,
dataConStrictMarks, dataConSrcBangs,
dataConSourceArity, dataConRepArity, dataConRepRepArity, dataConSourceArity, dataConRepArity, dataConRepRepArity,
dataConIsInfix, dataConIsInfix,
dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
dataConRepStrictness, dataConRepBangs, dataConBoxer, dataConRepStrictness, dataConImplBangs, dataConBoxer,
splitDataProductType_maybe, splitDataProductType_maybe,
...@@ -248,6 +250,8 @@ Note that (Foo a) might not be an instance of Ord. ...@@ -248,6 +250,8 @@ Note that (Foo a) might not be an instance of Ord.
-- --
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
-- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma' -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'
-- For details on above see note [Api annotations] in ApiAnnotation
data DataCon data DataCon
= MkData { = MkData {
dcName :: Name, -- This is the name of the *source data con* dcName :: Name, -- This is the name of the *source data con*
...@@ -341,9 +345,14 @@ data DataCon ...@@ -341,9 +345,14 @@ data DataCon
-- The OrigResTy is T [a], but the dcRepTyCon might be :T123 -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
-- Now the strictness annotations and field labels of the constructor -- Now the strictness annotations and field labels of the constructor
-- See Note [Bangs on data constructor arguments] dcSrcBangs :: [HsBang],
dcArgBangs :: [HsBang], -- See Note [Bangs on data constructor arguments]
-- Strictness annotations as decided by the compiler. -- For DataCons defined in this module:
-- the [HsSrcBang] as written by the programmer.
-- For DataCons imported from an interface file:
-- the [HsImplBang] determined when compiling the
-- defining module
--
-- Matches 1-1 with dcOrigArgTys -- Matches 1-1 with dcOrigArgTys
-- Hence length = dataConSourceArity dataCon -- Hence length = dataConSourceArity dataCon
...@@ -406,9 +415,9 @@ data DataConRep ...@@ -406,9 +415,9 @@ data DataConRep
, dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys
-- See also Note [Data-con worker strictness] in MkId.lhs -- See also Note [Data-con worker strictness] in MkId.lhs
, dcr_bangs :: [HsBang] -- The actual decisions made (including failures) , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures)
-- 1-1 with orig_arg_tys -- about the original arguments; 1-1 with orig_arg_tys
-- See Note [Bangs on data constructor arguments] -- See Note [Bangs on data constructor arguments]
} }
-- Algebraic data types always have a worker, and -- Algebraic data types always have a worker, and
...@@ -437,30 +446,79 @@ data DataConRep ...@@ -437,30 +446,79 @@ data DataConRep
-- when we bring bits of unfoldings together.) -- when we bring bits of unfoldings together.)
------------------------- -------------------------
-- HsBang describes what the *programmer* wrote -- HsBang describes the strictness/unpack status of one
-- This info is retained in the DataCon.dcStrictMarks field -- of the original data constructor arguments (i.e. *not*
-- of the representation data constructor which may have
-- more arguments after the originals have been unpacked)
-- See Note [Bangs on data constructor arguments]
data HsBang data HsBang
= HsUserBang -- The user's source-code request = HsNoBang -- Equivalent to (HsSrcBang Nothing False)
| HsSrcBang -- What the user wrote in the source code
(Maybe SourceText) -- Note [Pragma source text] in BasicTypes
(Maybe Bool) -- Just True {-# UNPACK #-} (Maybe Bool) -- Just True {-# UNPACK #-}
-- Just False {-# NOUNPACK #-} -- Just False {-# NOUNPACK #-}
-- Nothing no pragma -- Nothing no pragma
Bool -- True <=> '!' specified Bool -- True <=> '!' specified
-- (HsSrcBang (Just True) False) makes no sense
-- We emit a warning (in checkValidDataCon) and treat it
-- just like (HsSrcBang Nothing False)
| HsNoBang -- Lazy field -- Definite implementation commitments, generated by the compiler
-- HsUserBang Nothing False means the same as HsNoBang -- after consulting HsSrcBang (if any), flags, etc
| HsUnpack -- Definite commitment: this field is strict and unboxed | HsUnpack -- Definite commitment: this field is strict and unboxed
(Maybe Coercion) -- co :: arg-ty ~ product-ty (Maybe Coercion) -- co :: arg-ty ~ product-ty
| HsStrict -- Definite commitment: this field is strict but not unboxed | HsStrict -- Definite commitment: this field is strict but not unboxed
deriving (Data.Data, Data.Typeable) deriving (Data.Data, Data.Typeable)
-- Two type-insecure, but useful, synonyms
type HsSrcBang = HsBang -- What the user wrote; hence always HsNoBang or HsSrcBang
type HsImplBang = HsBang -- A HsBang implementation decision,
-- as determined by the compiler
-- Never HsSrcBang
------------------------- -------------------------
-- StrictnessMark is internal only, used to indicate strictness -- StrictnessMark is internal only, used to indicate strictness
-- of the DataCon *worker* fields -- of the DataCon *worker* fields
data StrictnessMark = MarkedStrict | NotMarkedStrict data StrictnessMark = MarkedStrict | NotMarkedStrict
{- {- Note [Bangs on data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data T = MkT !Int {-# UNPACK #-} !Int Bool
When compiling the module, GHC will decide how to represent
MkT, depending on the optimisation level, and settings of
flags like -funbox-small-strict-fields.
Terminology:
* HsSrcBang: What the user wrote
Constructors: HsNoBang, HsUserBang
* HsImplBang: What GHC decided
Constructors: HsNoBang, HsStrict, HsUnpack
* If T was defined in this module, MkT's dcSrcBangs field
records the [HsSrcBang] of what the user wrote; in the example
[ HsSrcBang Nothing True
, HsSrcBang (Just True) True
, HsNoBang]
* However, if T was defined in an imported module, MkT's dcSrcBangs
field gives the [HsImplBang] recording the decisions of the
defining module. The importing module must follow those decisions,
regardless of the flag settings in the importing module.
* The dcr_bangs field of the dcRep field records the [HsImplBang]
If T was defined in this module, Without -O the dcr_bangs might be
[HsStrict, HsStrict, HsNoBang]
With -O it might be
[HsStrict, HsUnpack, HsNoBang]
With -funbox-small-strict-fields it might be
[HsUnpack, HsUnpack, HsNoBang]
Note [Data con representation] Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The dcRepType field contains the type of the representation of a contructor The dcRepType field contains the type of the representation of a contructor
...@@ -479,26 +537,6 @@ but the rep type is ...@@ -479,26 +537,6 @@ but the rep type is
Trep :: Int# -> a -> T a Trep :: Int# -> a -> T a
Actually, the unboxed part isn't implemented yet! Actually, the unboxed part isn't implemented yet!
Note [Bangs on data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data T = MkT !Int {-# UNPACK #-} !Int Bool
Its dcArgBangs field records the *users* specifications, in this case
[ HsUserBang Nothing True
, HsUserBang (Just True) True
, HsNoBang]
See the declaration of HsBang in BasicTypes
The dcr_bangs field of the dcRep field records the *actual, decided*
representation of the data constructor. Without -O this might be
[HsStrict, HsStrict, HsNoBang]
With -O it might be
[HsStrict, HsUnpack, HsNoBang]
With -funbox-small-strict-fields it might be
[HsUnpack, HsUnpack, HsNoBang]
For imported data types, the dcArgBangs field is just the same as the
dcr_bangs field; we don't know what the user originally said.
************************************************************************ ************************************************************************
...@@ -539,11 +577,11 @@ instance Data.Data DataCon where ...@@ -539,11 +577,11 @@ instance Data.Data DataCon where
dataTypeOf _ = mkNoRepType "DataCon" dataTypeOf _ = mkNoRepType "DataCon"
instance Outputable HsBang where instance Outputable HsBang where
ppr HsNoBang = empty ppr HsNoBang = empty
ppr (HsUserBang prag bang) = pp_unpk prag <+> ppWhen bang (char '!') ppr (HsSrcBang _ prag bang) = pp_unpk prag <+> ppWhen bang (char '!')
ppr (HsUnpack Nothing) = ptext (sLit "Unpk") ppr (HsUnpack Nothing) = ptext (sLit "Unpk")
ppr (HsUnpack (Just co)) = ptext (sLit "Unpk") <> parens (ppr co) ppr (HsUnpack (Just co)) = ptext (sLit "Unpk") <> parens (ppr co)
ppr HsStrict = ptext (sLit "SrictNotUnpacked") ppr HsStrict = ptext (sLit "SrictNotUnpacked")
pp_unpk :: Maybe Bool -> SDoc pp_unpk :: Maybe Bool -> SDoc
pp_unpk Nothing = empty pp_unpk Nothing = empty
...@@ -558,15 +596,16 @@ instance Outputable StrictnessMark where ...@@ -558,15 +596,16 @@ instance Outputable StrictnessMark where
eqHsBang :: HsBang -> HsBang -> Bool eqHsBang :: HsBang -> HsBang -> Bool
eqHsBang HsNoBang HsNoBang = True eqHsBang HsNoBang HsNoBang = True
eqHsBang HsStrict HsStrict = True eqHsBang HsStrict HsStrict = True
eqHsBang (HsUserBang u1 b1) (HsUserBang u2 b2) = u1==u2 && b1==b2 eqHsBang (HsSrcBang _ u1 b1) (HsSrcBang _ u2 b2) = u1==u2 && b1==b2
eqHsBang (HsUnpack Nothing) (HsUnpack Nothing) = True eqHsBang (HsUnpack Nothing) (HsUnpack Nothing) = True
eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2)) = eqType (coercionType c1) (coercionType c2) eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2)) = eqType (coercionType c1) (coercionType c2)
eqHsBang _ _ = False eqHsBang _ _ = False
isBanged :: HsBang -> Bool isBanged :: HsBang -> Bool
isBanged HsNoBang = False isBanged HsNoBang = False
isBanged (HsUserBang Nothing bang) = bang isBanged (HsSrcBang _ _ bang) = bang
isBanged _ = True isBanged (HsUnpack {}) = True
isBanged (HsStrict {}) = True
isMarkedStrict :: StrictnessMark -> Bool isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict NotMarkedStrict = False isMarkedStrict NotMarkedStrict = False
...@@ -583,7 +622,8 @@ isMarkedStrict _ = True -- All others are strict ...@@ -583,7 +622,8 @@ isMarkedStrict _ = True -- All others are strict
-- | Build a new data constructor -- | Build a new data constructor
mkDataCon :: Name mkDataCon :: Name
-> Bool -- ^ Is the constructor declared infix? -> Bool -- ^ Is the constructor declared infix?
-> [HsBang] -- ^ Strictness annotations written in the source file -> [HsBang] -- ^ Strictness/unpack annotations, from user;
-- or, for imported DataCons, from the interface file
-> [FieldLabel] -- ^ Field labels for the constructor, if it is a record, -> [FieldLabel] -- ^ Field labels for the constructor, if it is a record,
-- otherwise empty -- otherwise empty
-> [TyVar] -- ^ Universally quantified type variables -> [TyVar] -- ^ Universally quantified type variables
...@@ -626,7 +666,7 @@ mkDataCon name declared_infix ...@@ -626,7 +666,7 @@ mkDataCon name declared_infix
dcStupidTheta = stupid_theta, dcStupidTheta = stupid_theta,
dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
dcRepTyCon = rep_tycon, dcRepTyCon = rep_tycon,
dcArgBangs = arg_stricts, dcSrcBangs = arg_stricts,
dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcFields = fields, dcTag = tag, dcRepType = rep_ty,
dcWorkId = work_id, dcWorkId = work_id,
dcRep = rep, dcRep = rep,
...@@ -764,10 +804,10 @@ dataConFieldType con label ...@@ -764,10 +804,10 @@ dataConFieldType con label
Just ty -> ty Just ty -> ty
Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label) Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
-- | The strictness markings decided on by the compiler. Does not include those for -- | The strictness markings written by the porgrammer.
-- existential dictionaries. The list is in one-to-one correspondence with the arity of the 'DataCon' -- The list is in one-to-one correspondence with the arity of the 'DataCon'
dataConStrictMarks :: DataCon -> [HsBang] dataConSrcBangs :: DataCon -> [HsSrcBang]
dataConStrictMarks = dcArgBangs dataConSrcBangs = dcSrcBangs
-- | Source-level arity of the data constructor -- | Source-level arity of the data constructor
dataConSourceArity :: DataCon -> Arity dataConSourceArity :: DataCon -> Arity
...@@ -800,10 +840,13 @@ dataConRepStrictness dc = case dcRep dc of ...@@ -800,10 +840,13 @@ dataConRepStrictness dc = case dcRep dc of
NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]
DCR { dcr_stricts = strs } -> strs DCR { dcr_stricts = strs } -> strs
dataConRepBangs :: DataCon -> [HsBang] dataConImplBangs :: DataCon -> [HsImplBang]
dataConRepBangs dc = case dcRep dc of -- The implementation decisions about the strictness/unpack of each
NoDataConRep -> dcArgBangs dc -- source program argument to the data constructor
DCR { dcr_bangs = bangs } -> bangs dataConImplBangs dc
= case dcRep dc of
NoDataConRep -> replicate (dcSourceArity dc) HsNoBang
DCR { dcr_bangs = bangs } -> bangs
dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer :: DataCon -> Maybe DataConBoxer
dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer
......
...@@ -32,6 +32,7 @@ module MkId ( ...@@ -32,6 +32,7 @@ module MkId (
voidPrimId, voidArgId, voidPrimId, voidArgId,
nullAddrId, seqId, lazyId, lazyIdKey, nullAddrId, seqId, lazyId, lazyIdKey,
coercionTokenId, magicDictId, coerceId, coercionTokenId, magicDictId, coerceId,
proxyHashId,
-- Re-export error Ids -- Re-export error Ids
module PrelRules module PrelRules
...@@ -519,7 +520,7 @@ mkDataConRep dflags fam_envs wrap_name data_con ...@@ -519,7 +520,7 @@ mkDataConRep dflags fam_envs wrap_name data_con
wrap_ty = dataConUserType data_con wrap_ty = dataConUserType data_con
ev_tys = eqSpecPreds eq_spec ++ theta ev_tys = eqSpecPreds eq_spec ++ theta
all_arg_tys = ev_tys ++ orig_arg_tys all_arg_tys = ev_tys ++ orig_arg_tys
orig_bangs = map mk_pred_strict_mark ev_tys ++ dataConStrictMarks data_con orig_bangs = map mk_pred_strict_mark ev_tys ++ dataConSrcBangs data_con
wrap_arg_tys = theta ++ orig_arg_tys wrap_arg_tys = theta ++ orig_arg_tys
wrap_arity = length wrap_arg_tys wrap_arity = length wrap_arg_tys
...@@ -580,19 +581,26 @@ newLocal ty = do { uniq <- getUniqueM ...@@ -580,19 +581,26 @@ newLocal ty = do { uniq <- getUniqueM
dataConArgRep dataConArgRep
:: DynFlags :: DynFlags
-> FamInstEnvs -> FamInstEnvs
-> Type -> HsBang -> Type
-> ( HsBang -- Like input but with HsUnpackFailed if necy -> HsSrcBang -- For DataCons defined in this module, this is the
-- bang/unpack annotation that the programmer wrote
-- For DataCons imported from an interface file, this
-- is the HsImplBang implementation decision taken
-- by the compiler in the defining module; just follow
-- it slavishly, so that we make the same decision as
-- in the defining module
-> ( HsImplBang -- Implementation decision about unpack strategy
, [(Type, StrictnessMark)] -- Rep types , [(Type, StrictnessMark)] -- Rep types
, (Unboxer, Boxer) ) , (Unboxer, Boxer) )
dataConArgRep _ _ arg_ty HsNoBang dataConArgRep _ _ arg_ty HsNoBang
= (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) = (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
dataConArgRep _ _ arg_ty (HsUserBang _ False) -- No '!' dataConArgRep _ _ arg_ty (HsSrcBang _ _ False) -- No '!'
= (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) = (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
dataConArgRep dflags fam_envs arg_ty dataConArgRep dflags fam_envs arg_ty
(HsUserBang unpk_prag True) -- {-# UNPACK #-} ! (HsSrcBang _ unpk_prag True) -- {-# UNPACK #-} !
| not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
-- Don't unpack if we aren't optimising; rather arbitrarily, -- Don't unpack if we aren't optimising; rather arbitrarily,
-- we use -fomit-iface-pragmas as the indication -- we use -fomit-iface-pragmas as the indication
...@@ -625,7 +633,7 @@ dataConArgRep _ _ _ (HsUnpack (Just co)) ...@@ -625,7 +633,7 @@ dataConArgRep _ _ _ (HsUnpack (Just co))
, (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
= (HsUnpack (Just co), rep_tys, wrapCo co co_rep_ty wrappers) = (HsUnpack (Just co), rep_tys, wrapCo co co_rep_ty wrappers)
strict_but_not_unpacked :: Type -> (HsBang, [(Type,StrictnessMark)], (Unboxer, Boxer)) strict_but_not_unpacked :: Type -> (HsImplBang, [(Type,StrictnessMark)], (Unboxer, Boxer))
strict_but_not_unpacked arg_ty strict_but_not_unpacked arg_ty
= (HsStrict, [(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) = (HsStrict, [(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
...@@ -716,15 +724,15 @@ isUnpackableType fam_envs ty ...@@ -716,15 +724,15 @@ isUnpackableType fam_envs ty
= True = True
ok_con_args tcs con ok_con_args tcs con
= all (ok_arg tcs) (dataConOrigArgTys con `zip` dataConStrictMarks con) = all (ok_arg tcs) (dataConOrigArgTys con `zip` dataConSrcBangs con)
-- NB: dataConStrictMarks gives the *user* request; -- NB: dataConSrcBangs gives the *user* request;
-- We'd get a black hole if we used dataConRepBangs -- We'd get a black hole if we used dataConImplBangs
attempt_unpack (HsUnpack {}) = True attempt_unpack (HsUnpack {}) = True
attempt_unpack (HsUserBang (Just unpk) bang) = bang && unpk attempt_unpack (HsSrcBang _ (Just unpk) bang) = bang && unpk
attempt_unpack (HsUserBang Nothing bang) = bang -- Be conservative attempt_unpack (HsSrcBang _ Nothing bang) = bang -- Be conservative
attempt_unpack HsStrict = False attempt_unpack HsStrict = False
attempt_unpack HsNoBang = False attempt_unpack HsNoBang = False
{- {-
Note [Unpack one-wide fields] Note [Unpack one-wide fields]
...@@ -789,7 +797,7 @@ heavy lifting. This one line makes every GADT take a word less ...@@ -789,7 +797,7 @@ heavy lifting. This one line makes every GADT take a word less
space for each equality predicate, so it's pretty important! space for each equality predicate, so it's pretty important!
-} -}
mk_pred_strict_mark :: PredType -> HsBang mk_pred_strict_mark :: PredType -> HsSrcBang
mk_pred_strict_mark pred mk_pred_strict_mark pred
| isEqPred pred = HsUnpack Nothing -- Note [Unpack equality predicates] | isEqPred pred = HsUnpack Nothing -- Note [Unpack equality predicates]
| otherwise = HsNoBang | otherwise = HsNoBang
......
...@@ -189,7 +189,6 @@ nameSrcSpan name = n_loc name ...@@ -189,7 +189,6 @@ nameSrcSpan name = n_loc name
************************************************************************ ************************************************************************
-} -}
nameIsLocalOrFrom :: Module -> Name -> Bool
isInternalName :: Name -> Bool isInternalName :: Name -> Bool
isExternalName :: Name -> Bool isExternalName :: Name -> Bool
isSystemName :: Name -> Bool isSystemName :: Name -> Bool
...@@ -218,9 +217,32 @@ nameModule_maybe (Name { n_sort = External mod}) = Just mod ...@@ -218,9 +217,32 @@ nameModule_maybe (Name { n_sort = External mod}) = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
nameModule_maybe _ = Nothing nameModule_maybe _ = Nothing
nameIsLocalOrFrom :: Module -> Name -> Bool
-- ^ Returns True if the name is
-- (a) Internal
-- (b) External but from the specified module
-- (c) External but from the 'interactive' package
--
-- The key idea is that
-- False means: the entity is defined in some other module
-- you can find the details (type, fixity, instances)
-- in some interface file
-- those details will be stored in the EPT or HPT
--
-- True means: the entity is defined in this module or earlier in
-- the GHCi session
-- you can find details (type, fixity, instances) in the
-- TcGblEnv or TcLclEnv
--
-- The isInteractiveModule part is because successive interactions of a GCHi session
-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come
-- from the magic 'interactive' package; and all the details are kept in the
-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.
-- See Note [The interactive package] in HscTypes
nameIsLocalOrFrom from name nameIsLocalOrFrom from name
| isExternalName name = from == nameModule name | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod
| otherwise = True | otherwise = True
isTyVarName :: Name -> Bool isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name) isTyVarName name = isTvOcc (nameOccName name)
...@@ -334,7 +356,8 @@ localiseName n = n { n_sort = Internal } ...@@ -334,7 +356,8 @@ localiseName n = n { n_sort = Internal }
-- |Create a localised variant of a name. -- |Create a localised variant of a name.
-- --
-- If the name is external, encode the original's module name to disambiguate. -- If the name is external, encode the original's module name to disambiguate.
-- -- SPJ says: this looks like a rather odd-looking function; but it seems to
-- be used only during vectorisation, so I'm not going to worry
mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name) mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
where where
......
...@@ -86,6 +86,22 @@ import Data.Data ...@@ -86,6 +86,22 @@ import Data.Data
-- | Do not use the data constructors of RdrName directly: prefer the family -- | Do not use the data constructors of RdrName directly: prefer the family
-- of functions that creates them, such as 'mkRdrUnqual' -- of functions that creates them, such as 'mkRdrUnqual'
--
-- - Note: A Located RdrName will only have API Annotations if it is a
-- compound one,
-- e.g.
--
-- > `bar`
-- > ( ~ )
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
-- 'ApiAnnotation.AnnOpen' @'('@ or @'['@ or @'[:'@,
-- 'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,,
-- 'ApiAnnotation.AnnBackquote' @'`'@,
-- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnTildehsh',
-- 'ApiAnnotation.AnnTilde',
-- For details on above see note [Api annotations] in ApiAnnotation
data RdrName data RdrName
= Unqual OccName = Unqual OccName
-- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@. -- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
......
-- (c) The University of Glasgow, 1992-2006 -- (c) The University of Glasgow, 1992-2006
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
-- Workaround for Trac #5252 crashes the bootstrap compiler without -O -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
-- When the earliest compiler we want to boostrap with is -- When the earliest compiler we want to boostrap with is
...@@ -43,7 +48,7 @@ module SrcLoc ( ...@@ -43,7 +48,7 @@ module SrcLoc (
srcSpanStart, srcSpanEnd, srcSpanStart, srcSpanEnd,
realSrcSpanStart, realSrcSpanEnd, realSrcSpanStart, realSrcSpanEnd,
srcSpanFileName_maybe, srcSpanFileName_maybe,
showUserSpan, pprUserRealSpan, pprUserRealSpan,
-- ** Unsafely deconstructing SrcSpan -- ** Unsafely deconstructing SrcSpan
-- These are dubious exports, because they crash on some inputs -- These are dubious exports, because they crash on some inputs
...@@ -77,6 +82,10 @@ import Util ...@@ -77,6 +82,10 @@ import Util
import Outputable import Outputable
import FastString import FastString
#if __GLASGOW_HASKELL__ < 709
import Data.Foldable ( Foldable )
import Data.Traversable ( Traversable )
#endif
import Data.Bits import Data.Bits
import Data.Data import Data.Data
import Data.List import Data.List
...@@ -475,9 +484,6 @@ instance Outputable SrcSpan where ...@@ -475,9 +484,6 @@ instance Outputable SrcSpan where
-- UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan" -- UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
-- RealSrcSpan s -> ppr s -- RealSrcSpan s -> ppr s
showUserSpan :: Bool -> SrcSpan -> String
showUserSpan show_path span = showSDocSimple (pprUserSpan show_path span)
pprUserSpan :: Bool -> SrcSpan -> SDoc pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan s) = ftext s pprUserSpan _ (UnhelpfulSpan s) = ftext s
pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
...@@ -515,6 +521,8 @@ pprUserRealSpan show_path (SrcSpanPoint src_path line col) ...@@ -515,6 +521,8 @@ pprUserRealSpan show_path (SrcSpanPoint src_path line col)
-- | We attach SrcSpans to lots of things, so let's have a datatype for it. -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data GenLocated l e = L l e data GenLocated l e = L l e
deriving (Eq, Ord, Typeable, Data) deriving (Eq, Ord, Typeable, Data)
deriving instance Foldable (GenLocated l)
deriving instance Traversable (GenLocated l)
type Located e = GenLocated SrcSpan e type Located e = GenLocated SrcSpan e
type RealLocated e = GenLocated RealSrcSpan e type RealLocated e = GenLocated RealSrcSpan e
......
...@@ -897,7 +897,7 @@ labelDynamic dflags this_pkg this_mod lbl = ...@@ -897,7 +897,7 @@ labelDynamic dflags this_pkg this_mod lbl =
PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m) PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m)
HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m) HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_mod /= m
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False _ -> False
......
...@@ -575,6 +575,10 @@ importName ...@@ -575,6 +575,10 @@ importName
: NAME : NAME
{ ($1, mkForeignLabel $1 Nothing ForeignLabelInExternalPackage IsFunction) } { ($1, mkForeignLabel $1 Nothing ForeignLabelInExternalPackage IsFunction) }
-- as previous 'NAME', but 'IsData'
| 'CLOSURE' NAME
{ ($2, mkForeignLabel $2 Nothing ForeignLabelInExternalPackage IsData) }
-- A label imported with an explicit packageId. -- A label imported with an explicit packageId.
| STRING NAME | STRING NAME
{ ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) } { ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) }
......
...@@ -1759,7 +1759,7 @@ withoutAnnots pass guts = do ...@@ -1759,7 +1759,7 @@ withoutAnnots pass guts = do
-- Nuke existing ticks in module. -- Nuke existing ticks in module.
-- TODO: Ticks in unfoldings. Maybe change unfolding so it removes -- TODO: Ticks in unfoldings. Maybe change unfolding so it removes
-- them in absence of @Opt_Debug@? -- them in absence of @Opt_Debug@?
let nukeTicks = snd . stripTicks (not . tickishIsCode) let nukeTicks = stripTicksE (not . tickishIsCode)
nukeAnnotsBind :: CoreBind -> CoreBind nukeAnnotsBind :: CoreBind -> CoreBind
nukeAnnotsBind bind = case bind of nukeAnnotsBind bind = case bind of
Rec bs -> Rec $ map (\(b,e) -> (b, nukeTicks e)) bs Rec bs -> Rec $ map (\(b,e) -> (b, nukeTicks e)) bs
......
...@@ -44,7 +44,8 @@ module CoreUtils ( ...@@ -44,7 +44,8 @@ module CoreUtils (
dataConRepInstPat, dataConRepFSInstPat, dataConRepInstPat, dataConRepFSInstPat,
-- * Working with ticks -- * Working with ticks
stripTicksTop, stripTicksTopE, stripTicksTopT, stripTicks, stripTicksTop, stripTicksTopE, stripTicksTopT,
stripTicksE, stripTicksT
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -77,10 +78,6 @@ import Pair ...@@ -77,10 +78,6 @@ import Pair
import Data.Function ( on ) import Data.Function ( on )
import Data.List import Data.List
import Data.Ord ( comparing ) import Data.Ord ( comparing )
import Control.Applicative
#if __GLASGOW_HASKELL__ < 709
import Data.Traversable ( traverse )
#endif
import OrdList import OrdList
{- {-
...@@ -300,10 +297,18 @@ mkTick t orig_expr = mkTick' id id orig_expr ...@@ -300,10 +297,18 @@ mkTick t orig_expr = mkTick' id id orig_expr
else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
Var x Var x
| not (isFunTy (idType x)) && tickishPlace t == PlaceCostCentre | notFunction && tickishPlace t == PlaceCostCentre
-> orig_expr -> orig_expr
| canSplit | notFunction && canSplit
-> top $ Tick (mkNoScope t) $ rest expr -> top $ Tick (mkNoScope t) $ rest expr
where
-- SCCs can be eliminated on variables provided the variable
-- is not a function. In these cases the SCC makes no difference:
-- the cost of evaluating the variable will be attributed to its
-- definition site. When the variable refers to a function, however,
-- an SCC annotation on the variable affects the cost-centre stack
-- when the function is called, so we must retain those.
notFunction = not (isFunTy (idType x))
Lit{} Lit{}
| tickishPlace t == PlaceCostCentre | tickishPlace t == PlaceCostCentre
...@@ -358,25 +363,37 @@ stripTicksTopT p = go [] ...@@ -358,25 +363,37 @@ stripTicksTopT p = go []
-- | Completely strip ticks satisfying a predicate from an -- | Completely strip ticks satisfying a predicate from an
-- expression. Note this is O(n) in the size of the expression! -- expression. Note this is O(n) in the size of the expression!
stripTicks :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b) stripTicksE :: (Tickish Id -> Bool) -> Expr b -> Expr b
stripTicks p expr = (fromOL ticks, expr') stripTicksE p expr = go expr
where (ticks, expr') = go expr where go (App e a) = App (go e) (go a)
-- Note that OrdList (Tickish Id) is a Monoid, which makes go (Lam b e) = Lam b (go e)
-- ((,) (OrdList (Tickish Id))) an Applicative. go (Let b e) = Let (go_bs b) (go e)
go (App e a) = App <$> go e <*> go a go (Case e b t as) = Case (go e) b t (map go_a as)
go (Lam b e) = Lam b <$> go e go (Cast e c) = Cast (go e) c
go (Let b e) = Let <$> go_bs b <*> go e go (Tick t e)
go (Case e b t as) = Case <$> go e <*> pure b <*> pure t | p t = go e
<*> traverse go_a as | otherwise = Tick t (go e)
go (Cast e c) = Cast <$> go e <*> pure c go other = other
go_bs (NonRec b e) = NonRec b (go e)
go_bs (Rec bs) = Rec (map go_b bs)
go_b (b, e) = (b, go e)
go_a (c,bs,e) = (c,bs, go e)
stripTicksT :: (Tickish Id -> Bool) -> Expr b -> [Tickish Id]
stripTicksT p expr = fromOL $ go expr
where go (App e a) = go e `appOL` go a
go (Lam _ e) = go e
go (Let b e) = go_bs b `appOL` go e
go (Case e _ _ as) = go e `appOL` concatOL (map go_a as)
go (Cast e _) = go e
go (Tick t e) go (Tick t e)
| p t = let (ts, e') = go e in (t `consOL` ts, e') | p t = t `consOL` go e
| otherwise = Tick t <$> go e | otherwise = go e
go other = pure other go _ = nilOL
go_bs (NonRec b e) = NonRec b <$> go e go_bs (NonRec _ e) = go e
go_bs (Rec bs) = Rec <$> traverse go_b bs go_bs (Rec bs) = concatOL (map go_b bs)
go_b (b, e) = (,) <$> pure b <*> go e go_b (_, e) = go e
go_a (c,bs,e) = (,,) <$> pure c <*> pure bs <*> go e go_a (_, _, e) = go e
{- {-
************************************************************************ ************************************************************************
...@@ -663,6 +680,7 @@ getIdFromTrivialExpr :: CoreExpr -> Id ...@@ -663,6 +680,7 @@ getIdFromTrivialExpr :: CoreExpr -> Id
getIdFromTrivialExpr e = go e getIdFromTrivialExpr e = go e
where go (Var v) = v where go (Var v) = v
go (App f t) | not (isRuntimeArg t) = go f go (App f t) | not (isRuntimeArg t) = go f
go (Tick t e) | not (tickishIsCode t) = go e
go (Cast e _) = go e go (Cast e _) = go e
go (Lam b e) | not (isRuntimeVar b) = go e go (Lam b e) | not (isRuntimeVar b) = go e
go e = pprPanic "getIdFromTrivialExpr" (ppr e) go e = pprPanic "getIdFromTrivialExpr" (ppr e)
......
...@@ -452,11 +452,11 @@ get_lit :: Pat id -> Maybe HsLit ...@@ -452,11 +452,11 @@ get_lit :: Pat id -> Maybe HsLit
-- It doesn't matter which one, because they will only be compared -- It doesn't matter which one, because they will only be compared
-- with other HsLits gotten in the same way -- with other HsLits gotten in the same way
get_lit (LitPat lit) = Just lit get_lit (LitPat lit) = Just lit
get_lit (NPat (OverLit { ol_val = HsIntegral src i}) mb _) get_lit (NPat (L _ (OverLit { ol_val = HsIntegral src i})) mb _)
= Just (HsIntPrim src (mb_neg negate mb i)) = Just (HsIntPrim src (mb_neg negate mb i))
get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) get_lit (NPat (L _ (OverLit { ol_val = HsFractional f })) mb _)
= Just (HsFloatPrim (mb_neg negateFractionalLit mb f)) = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
get_lit (NPat (OverLit { ol_val = HsIsString src s }) _ _) get_lit (NPat (L _ (OverLit { ol_val = HsIsString src s })) _ _)
= Just (HsStringPrim src (fastStringToByteString s)) = Just (HsStringPrim src (fastStringToByteString s))
get_lit _ = Nothing get_lit _ = Nothing
...@@ -727,7 +727,7 @@ tidy_pat (TuplePat ps boxity tys) ...@@ -727,7 +727,7 @@ tidy_pat (TuplePat ps boxity tys)
where where
arity = length ps arity = length ps
tidy_pat (NPat lit mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq tidy_pat (NPat (L _ lit) mb_neg eq) = tidyNPat tidy_lit_pat lit mb_neg eq
tidy_pat (LitPat lit) = tidy_lit_pat lit tidy_pat (LitPat lit) = tidy_lit_pat lit
tidy_pat (ConPatIn {}) = panic "Check.tidy_pat: ConPatIn" tidy_pat (ConPatIn {}) = panic "Check.tidy_pat: ConPatIn"
......
...@@ -567,7 +567,7 @@ addTickHsExpr (HsTick t e) = ...@@ -567,7 +567,7 @@ addTickHsExpr (HsTick t e) =
addTickHsExpr (HsBinTick t0 t1 e) = addTickHsExpr (HsBinTick t0 t1 e) =
liftM (HsBinTick t0 t1) (addTickLHsExprNever e) liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
addTickHsExpr (HsTickPragma _ (L pos e0)) = do addTickHsExpr (HsTickPragma _ _ (L pos e0)) = do
e2 <- allocTickBox (ExpBox False) False False pos $ e2 <- allocTickBox (ExpBox False) False False pos $
addTickHsExpr e0 addTickHsExpr e0
return $ unLoc e2 return $ unLoc e2
...@@ -575,12 +575,14 @@ addTickHsExpr (PArrSeq ty arith_seq) = ...@@ -575,12 +575,14 @@ addTickHsExpr (PArrSeq ty arith_seq) =
liftM2 PArrSeq liftM2 PArrSeq
(return ty) (return ty)
(addTickArithSeqInfo arith_seq) (addTickArithSeqInfo arith_seq)
addTickHsExpr (HsSCC nm e) = addTickHsExpr (HsSCC src nm e) =
liftM2 HsSCC liftM3 HsSCC
(return src)
(return nm) (return nm)
(addTickLHsExpr e) (addTickLHsExpr e)
addTickHsExpr (HsCoreAnn nm e) = addTickHsExpr (HsCoreAnn src nm e) =
liftM2 HsCoreAnn liftM3 HsCoreAnn
(return src)
(return nm) (return nm)
(addTickLHsExpr e) (addTickLHsExpr e)
addTickHsExpr e@(HsBracket {}) = return e addTickHsExpr e@(HsBracket {}) = return e
...@@ -614,10 +616,10 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = matches }) = do ...@@ -614,10 +616,10 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = matches }) = do
return $ mg { mg_alts = matches' } return $ mg { mg_alts = matches' }
addTickMatch :: Bool -> Bool -> Match Id (LHsExpr Id) -> TM (Match Id (LHsExpr Id)) addTickMatch :: Bool -> Bool -> Match Id (LHsExpr Id) -> TM (Match Id (LHsExpr Id))
addTickMatch isOneOfMany isLambda (Match pats opSig gRHSs) = addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
bindLocals (collectPatsBinders pats) $ do bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
return $ Match pats opSig gRHSs' return $ Match mf pats opSig gRHSs'
addTickGRHSs :: Bool -> Bool -> GRHSs Id (LHsExpr Id) -> TM (GRHSs Id (LHsExpr Id)) addTickGRHSs :: Bool -> Bool -> GRHSs Id (LHsExpr Id) -> TM (GRHSs Id (LHsExpr Id))
addTickGRHSs isOneOfMany isLambda (GRHSs guarded local_binds) = do addTickGRHSs isOneOfMany isLambda (GRHSs guarded local_binds) = do
...@@ -829,10 +831,10 @@ addTickCmdMatchGroup mg@(MG { mg_alts = matches }) = do ...@@ -829,10 +831,10 @@ addTickCmdMatchGroup mg@(MG { mg_alts = matches }) = do
return $ mg { mg_alts = matches' } return $ mg { mg_alts = matches' }
addTickCmdMatch :: Match Id (LHsCmd Id) -> TM (Match Id (LHsCmd Id)) addTickCmdMatch :: Match Id (LHsCmd Id) -> TM (Match Id (LHsCmd Id))
addTickCmdMatch (Match pats opSig gRHSs) = addTickCmdMatch (Match mf pats opSig gRHSs) =
bindLocals (collectPatsBinders pats) $ do bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickCmdGRHSs gRHSs gRHSs' <- addTickCmdGRHSs gRHSs
return $ Match pats opSig gRHSs' return $ Match mf pats opSig gRHSs'
addTickCmdGRHSs :: GRHSs Id (LHsCmd Id) -> TM (GRHSs Id (LHsCmd Id)) addTickCmdGRHSs :: GRHSs Id (LHsCmd Id) -> TM (GRHSs Id (LHsCmd Id))
addTickCmdGRHSs (GRHSs guarded local_binds) = do addTickCmdGRHSs (GRHSs guarded local_binds) = do
...@@ -1204,7 +1206,7 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals") ...@@ -1204,7 +1206,7 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
matchesOneOfMany :: [LMatch Id body] -> Bool matchesOneOfMany :: [LMatch Id body] -> Bool
matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
where where
matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss matchCount (L _ (Match _ _pats _ty (GRHSs grhss _binds))) = length grhss
type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
......
...@@ -24,7 +24,6 @@ import Coercion ...@@ -24,7 +24,6 @@ import Coercion
import InstEnv import InstEnv
import Class import Class
import Avail import Avail
import PatSyn
import CoreSyn import CoreSyn
import CoreSubst import CoreSubst
import PprCore import PprCore
...@@ -184,7 +183,7 @@ deSugar hsc_env ...@@ -184,7 +183,7 @@ deSugar hsc_env
mg_fam_insts = fam_insts, mg_fam_insts = fam_insts,
mg_inst_env = inst_env, mg_inst_env = inst_env,
mg_fam_inst_env = fam_inst_env, mg_fam_inst_env = fam_inst_env,
mg_patsyns = filter ((`elemNameSet` export_set) . patSynName) patsyns, mg_patsyns = patsyns,
mg_rules = ds_rules_for_imps, mg_rules = ds_rules_for_imps,
mg_binds = ds_binds, mg_binds = ds_binds,
mg_foreign = ds_fords, mg_foreign = ds_fords,
...@@ -462,12 +461,12 @@ by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS). ...@@ -462,12 +461,12 @@ by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
-} -}
dsVect :: LVectDecl Id -> DsM CoreVect dsVect :: LVectDecl Id -> DsM CoreVect
dsVect (L loc (HsVect (L _ v) rhs)) dsVect (L loc (HsVect _ (L _ v) rhs))
= putSrcSpanDs loc $ = putSrcSpanDs loc $
do { rhs' <- dsLExpr rhs do { rhs' <- dsLExpr rhs
; return $ Vect v rhs' ; return $ Vect v rhs'
} }
dsVect (L _loc (HsNoVect (L _ v))) dsVect (L _loc (HsNoVect _ (L _ v)))
= return $ NoVect v = return $ NoVect v
dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon)) dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
= return $ VectType isScalar tycon' rhs_tycon = return $ VectType isScalar tycon' rhs_tycon
...@@ -475,11 +474,11 @@ dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon)) ...@@ -475,11 +474,11 @@ dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
tycon' | Just ty <- coreView $ mkTyConTy tycon tycon' | Just ty <- coreView $ mkTyConTy tycon
, (tycon', []) <- splitTyConApp ty = tycon' , (tycon', []) <- splitTyConApp ty = tycon'
| otherwise = tycon | otherwise = tycon
dsVect vd@(L _ (HsVectTypeIn _ _ _)) dsVect vd@(L _ (HsVectTypeIn _ _ _ _))
= pprPanic "Desugar.dsVect: unexpected 'HsVectTypeIn'" (ppr vd) = pprPanic "Desugar.dsVect: unexpected 'HsVectTypeIn'" (ppr vd)
dsVect (L _loc (HsVectClassOut cls)) dsVect (L _loc (HsVectClassOut cls))
= return $ VectClass (classTyCon cls) = return $ VectClass (classTyCon cls)
dsVect vc@(L _ (HsVectClassIn _)) dsVect vc@(L _ (HsVectClassIn _ _))
= pprPanic "Desugar.dsVect: unexpected 'HsVectClassIn'" (ppr vc) = pprPanic "Desugar.dsVect: unexpected 'HsVectClassIn'" (ppr vc)
dsVect (L _loc (HsVectInstOut inst)) dsVect (L _loc (HsVectInstOut inst))
= return $ VectInst (instanceDFunId inst) = return $ VectInst (instanceDFunId inst)
......