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 (13)
  • Ben Gamari's avatar
    base: Bump to 4.15.0.0 · 7faa4509
    Ben Gamari authored
    7faa4509
  • Ben Gamari's avatar
    configure: Use grep -q instead of --quiet · 20616959
    Ben Gamari authored
    The latter is apparently not supported by busybox.
    20616959
  • Krzysztof Gogolewski's avatar
    Linear types (#15981) · 40fa237e
    Krzysztof Gogolewski authored and Ben Gamari's avatar Ben Gamari committed
    This is the first step towards implementation of the linear types proposal
    (https://github.com/ghc-proposals/ghc-proposals/pull/111).
    
    It features
    
    * A language extension -XLinearTypes
    * Syntax for linear functions in the surface language
    * Linearity checking in Core Lint, enabled with -dlinear-core-lint
    * Core-to-core passes are mostly compatible with linearity
    * Fields in a data type can be linear or unrestricted; linear fields
      have multiplicity-polymorphic constructors.
      If -XLinearTypes is disabled, the GADT syntax defaults to linear fields
    
    The following items are not yet supported:
    
    * a # m -> b syntax (only prefix FUN is supported for now)
    * Full multiplicity inference (multiplicities are really only checked)
    * Decent linearity error messages
    * Linear let, where, and case expressions in the surface language
      (each of these currently introduce the unrestricted variant)
    * Multiplicity-parametric fields
    * Syntax for annotating lambda-bound or let-bound with a multiplicity
    * Syntax for non-linear/multiple-field-multiplicity records
    * Linear projections for records with a single linear field
    * Linear pattern synonyms
    * Multiplicity coercions (test LinearPolyType)
    
    A high-level description can be found at
    https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation
    Following the link above you will find a description of the changes made to Core.
    This commit has been authored by
    
    * Richard Eisenberg
    * Krzysztof Gogolewski
    * Matthew Pickering
    * Arnaud Spiwack
    
    With contributions from:
    
    * Mark Barbone
    * Alexander Vershilov
    
    Updates haddock submodule.
    40fa237e
  • Krzysztof Gogolewski's avatar
    Various performance improvements · 6cb84c46
    Krzysztof Gogolewski authored and Ben Gamari's avatar Ben Gamari committed
    This implements several general performance improvements to GHC,
    to offset the effect of the linear types change.
    
    General optimisations:
    - Add a `coreFullView` function which iterates `coreView` on the
      head. This avoids making function recursive solely because the
      iterate `coreView` themselves. As a consequence, this functions can
      be inlined, and trigger case-of-known constructor (_e.g._
      `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`,
      `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`,
      `tyConAppTyCon_maybe`). The common pattern about all these functions
      is that they are almost always used as views, and immediately
      consumed by a case expression. This commit also mark them asx `INLINE`.
    - In `subst_ty` add a special case for nullary `TyConApp`, which avoid
      allocations altogether.
    - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This
      required quite a bit of module shuffling.
      case. `myTyConApp` enforces crucial sharing, which was lost during
      substitution. See also !2952 .
    - Make `subst_ty` stricter.
    - In `eqType` (specifically, in `nonDetCmpType`), add a special case,
      tested first, for the very common case of nullary `TyConApp`.
      `nonDetCmpType` has been made `INLINE` otherwise it is actually a
      regression. This is similar to the optimisations in !2952.
    
    Linear-type specific optimisations:
    - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in
      the definition of the pattern synonyms `One` and `Many`.
    - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`:
      `Multiplicity` now import `Type` normally, rather than from the
      `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the
      `One` and `Many` pattern synonyms.
    - Make `updateIdTypeAndMult` strict in its type and multiplicity
    - The `scaleIdBy` gets a specialised definition rather than being an
      alias to `scaleVarBy`
    - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type,
      Type)` instead of `Type -> Maybe (Scaled Type, Type)`
    - Remove the `MultMul` pattern synonym in favour of a view `isMultMul`
      because pattern synonyms appear not to inline well.
    - in `eqType`, in a `FunTy`, compare multiplicities last: they are
      almost always both `Many`, so it helps failing faster.
    - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the
      instances of `TyConApp ManyDataConTy []` are physically the same.
    
    This commit has been authored by
    * Richard Eisenberg
    * Krzysztof Gogolewski
    * Arnaud Spiwack
    
    Metric Decrease:
        haddock.base
        T12227
        T12545
        T12990
        T1969
        T3064
        T5030
        T9872b
    
    Metric Increase:
        haddock.base
        haddock.Cabal
        haddock.compiler
        T12150
        T12234
        T12425
        T12707
        T13035
        T13056
        T15164
        T16190
        T18304
        T1969
        T3064
        T3294
        T5631
        T5642
        T5837
        T6048
        T9020
        T9233
        T9675
        T9872a
        T9961
        WWRec
    6cb84c46
  • Sylvain Henry's avatar
    Remove integer-simple · 57db91d8
    Sylvain Henry authored
    integer-simple uses lists of words (`[Word]`) to represent big numbers
    instead of ByteArray#:
    
       * it is less efficient than the newer ghc-bignum native backend
    
       * it isn't compatible with the big number representation that is now
         shared by all the ghc-bignum backends (based on the one that was
         used only in integer-gmp before).
    
    As a consequence, we simply drop integer-simple
    57db91d8
  • Sylvain Henry's avatar
    ghc-bignum library · 9f96bc12
    Sylvain Henry authored
    ghc-bignum is a newer package that aims to replace the legacy
    integer-simple and integer-gmp packages.
    
    * it supports several backends. In particular GMP is still supported and
      most of the code from integer-gmp has been merged in the "gmp"
      backend.
    
    * the pure Haskell "native" backend is new and is much faster than the
      previous pure Haskell implementation provided by integer-simple
    
    * new backends are easier to write because they only have to provide a
      few well defined functions. All the other code is common to all
      backends. In particular they all share the efficient small/big number
      distinction previously used only in integer-gmp.
    
    * backends can all be tested against the "native" backend with a simple
      Cabal flag. Backends are only allowed to differ in performance, their
      results should be the same.
    
    * Add `integer-gmp` compat package: provide some pattern synonyms and
      function aliases for those in `ghc-bignum`. It is intended to avoid
      breaking packages that depend on `integer-gmp` internals.
    
    Update submodules: text, bytestring
    
    Metric Decrease:
        Conversions
        ManyAlternatives
        ManyConstructors
        Naperian
        T10359
        T10547
        T10678
        T12150
        T12227
        T12234
        T12425
        T13035
        T13719
        T14936
        T1969
        T4801
        T4830
        T5237
        T5549
        T5837
        T8766
        T9020
        parsing001
        space_leak_001
        T16190
        haddock.base
    
    On ARM and i386, T17499 regresses (+6% > 5%).
    On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%).
    
    Metric Increase:
        T17499
        T13701
    9f96bc12
  • Sylvain Henry's avatar
    Update compiler · 96aa5787
    Sylvain Henry authored
    Thanks to ghc-bignum, the compiler can be simplified:
    
    * Types and constructors of Integer and Natural can be wired-in. It
      means that we don't have to query them from interfaces. It also means
      that numeric literals don't have to carry their type with them.
    
    * The same code is used whatever ghc-bignum backend is enabled. In
      particular, conversion of bignum literals into final Core expressions
      is now much more straightforward. Bignum closure inspection too.
    
    * GHC itself doesn't depend on any integer-* package anymore
    
    * The `integerLibrary` setting is gone.
    96aa5787
  • Sylvain Henry's avatar
    Update `base` package · 0f67e344
    Sylvain Henry authored
    * GHC.Natural isn't implemented in `base` anymore. It is provided by
      ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural
      primitives in `base` without fearing issues with built-in rewrite
      rules (cf #15286)
    
    * `base` doesn't conditionally depend on an integer-* package anymore,
      it depends on ghc-bignum
    
    * Some duplicated code in integer-* can now be factored in GHC.Float
    
    * ghc-bignum tries to use a uniform naming convention so most of the
      other changes are renaming
    0f67e344
  • Sylvain Henry's avatar
    Update `make` based build system · aa9e7b71
    Sylvain Henry authored
    * replace integer-* package selection with ghc-bignum backend selection
    aa9e7b71
  • Sylvain Henry's avatar
    Update testsuite · f817d816
    Sylvain Henry authored
    * support detection of slow ghc-bignum backend (to replace the detection
      of integer-simple use). There are still some test cases that the
      native backend doesn't handle efficiently enough.
    
    * remove tests for GMP only functions that have been removed from
      ghc-bignum
    
    * fix test results showing dependent packages (e.g. integer-gmp) or
      showing suggested instances
    
    * fix test using Integer/Natural API or showing internal names
    f817d816
  • Sylvain Henry's avatar
    Update Hadrian · dceecb09
    Sylvain Henry authored
    * support ghc-bignum backend selection in flavours and command-line
    
    * support ghc-bignum "--check" flag (compare results of selected backend
      against results of the native one) in flavours and command-line (e.g.
      pass --bignum=check-gmp" to check the "gmp" backend)
    
    * remove the hack to workaround #15286
    
    * build GMP only when the gmp backend is used
    
    * remove hacks to workaround `text` package flags about integer-*. We
      fix `text` to use ghc-bignum unconditionally in another patch
    dceecb09
  • Sylvain Henry's avatar
    Bump bytestring and text submodules · fa4281d6
    Sylvain Henry authored
    fa4281d6
  • Simon Peyton Jones's avatar
    Two small teaks to Coercion.simplifyArgsWorker · e967195f
    Simon Peyton Jones authored
    These tweaks affect the inner loop of simplifyArgsWorker, which
    in turn is called from the flattener in Flatten.hs.  This is
    a key perf bottleneck to T9872{a,b,c,d}.
    
    These two small changes have a modest but useful benefit.
    No change in functionality whatsoever.
    
    Relates to #18354
    e967195f
Showing
with 781 additions and 325 deletions
......@@ -105,7 +105,7 @@
url = https://gitlab.haskell.org/ghc/libffi-tarballs.git
ignore = untracked
[submodule "gmp-tarballs"]
path = libraries/integer-gmp/gmp/gmp-tarballs
path = libraries/ghc-bignum/gmp/gmp-tarballs
url = https://gitlab.haskell.org/ghc/gmp-tarballs.git
[submodule "libraries/exceptions"]
path = libraries/exceptions
......
......@@ -1333,7 +1333,7 @@ AC_DEFUN([FP_GCC_VERSION], [
AC_MSG_ERROR([C compiler is required])
fi
if $CC --version | grep --quiet gcc; then
if $CC --version | grep -q gcc; then
AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version],
[
# Be sure only to look at the first occurrence of the "version " string;
......
......@@ -197,7 +197,7 @@ module GHC (
-- ** Data constructors
DataCon,
dataConType, dataConTyCon, dataConFieldLabels,
dataConIsInfix, isVanillaDataCon, dataConUserType,
dataConIsInfix, isVanillaDataCon, dataConWrapperType,
dataConSrcBangs,
StrictnessMark(..), isMarkedStrict,
......
......@@ -374,31 +374,57 @@ basicKnownKeyNames
printName, fstName, sndName,
dollarName,
-- Integer
integerTyConName, mkIntegerName,
integerToWord64Name, integerToInt64Name,
word64ToIntegerName, int64ToIntegerName,
plusIntegerName, timesIntegerName, smallIntegerName,
wordToIntegerName,
integerToWordName, integerToIntName, minusIntegerName,
negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
absIntegerName, signumIntegerName,
leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
compareIntegerName, quotRemIntegerName, divModIntegerName,
quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
floatFromIntegerName, doubleFromIntegerName,
encodeFloatIntegerName, encodeDoubleIntegerName,
decodeDoubleIntegerName,
gcdIntegerName, lcmIntegerName,
andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
shiftLIntegerName, shiftRIntegerName, bitIntegerName,
integerSDataConName,naturalSDataConName,
-- Natural
naturalTyConName,
naturalFromIntegerName, naturalToIntegerName,
plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName,
wordToNaturalName,
-- ghc-bignum
integerFromNaturalName,
integerToNaturalClampName,
integerToWordName,
integerToIntName,
integerToWord64Name,
integerToInt64Name,
integerFromWordName,
integerFromWord64Name,
integerFromInt64Name,
integerAddName,
integerMulName,
integerSubName,
integerNegateName,
integerEqPrimName,
integerNePrimName,
integerLePrimName,
integerGtPrimName,
integerLtPrimName,
integerGePrimName,
integerAbsName,
integerSignumName,
integerCompareName,
integerQuotName,
integerRemName,
integerDivName,
integerModName,
integerDivModName,
integerQuotRemName,
integerToFloatName,
integerToDoubleName,
integerEncodeFloatName,
integerEncodeDoubleName,
integerDecodeDoubleName,
integerGcdName,
integerLcmName,
integerAndName,
integerOrName,
integerXorName,
integerComplementName,
integerBitName,
integerShiftLName,
integerShiftRName,
naturalToWordName,
naturalAddName,
naturalSubName,
naturalMulName,
naturalQuotName,
naturalRemName,
naturalQuotRemName,
bignatFromWordListName,
-- Float/Double
rationalToFloatName,
......@@ -510,7 +536,8 @@ pRELUDE = mkBaseModule_ pRELUDE_NAME
gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL,
gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE,
gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT,
gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING,
dATA_FOLDABLE, dATA_TRAVERSABLE,
gHC_CONC, gHC_IO, gHC_IO_Exception,
......@@ -538,8 +565,9 @@ gHC_SHOW = mkBaseModule (fsLit "GHC.Show")
gHC_READ = mkBaseModule (fsLit "GHC.Read")
gHC_NUM = mkBaseModule (fsLit "GHC.Num")
gHC_MAYBE = mkBaseModule (fsLit "GHC.Maybe")
gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type")
gHC_NATURAL = mkBaseModule (fsLit "GHC.Natural")
gHC_NUM_INTEGER = mkBignumModule (fsLit "GHC.Num.Integer")
gHC_NUM_NATURAL = mkBignumModule (fsLit "GHC.Num.Natural")
gHC_NUM_BIGNAT = mkBignumModule (fsLit "GHC.Num.BigNat")
gHC_LIST = mkBaseModule (fsLit "GHC.List")
gHC_TUPLE = mkPrimModule (fsLit "GHC.Tuple")
dATA_TUPLE = mkBaseModule (fsLit "Data.Tuple")
......@@ -627,8 +655,8 @@ dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim"
mkPrimModule :: FastString -> Module
mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
mkIntegerModule :: FastString -> Module
mkIntegerModule m = mkModule integerUnit (mkModuleNameFS m)
mkBignumModule :: FastString -> Module
mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m)
mkBaseModule :: FastString -> Module
mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)
......@@ -707,10 +735,10 @@ enumFromTo_RDR = nameRdrName enumFromToName
enumFromThen_RDR = nameRdrName enumFromThenName
enumFromThenTo_RDR = nameRdrName enumFromThenToName
ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName
ratioDataCon_RDR, integerAdd_RDR, integerMul_RDR :: RdrName
ratioDataCon_RDR = nameRdrName ratioDataConName
plusInteger_RDR = nameRdrName plusIntegerName
timesInteger_RDR = nameRdrName timesIntegerName
integerAdd_RDR = nameRdrName integerAddName
integerMul_RDR = nameRdrName integerMulName
ioDataCon_RDR :: RdrName
ioDataCon_RDR = nameRdrName ioDataConName
......@@ -1118,84 +1146,125 @@ fromIntegerName = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
minusName = varQual gHC_NUM (fsLit "-") minusClassOpKey
negateName = varQual gHC_NUM (fsLit "negate") negateClassOpKey
integerTyConName, mkIntegerName, integerSDataConName,
integerToWord64Name, integerToInt64Name,
word64ToIntegerName, int64ToIntegerName,
plusIntegerName, timesIntegerName, smallIntegerName,
wordToIntegerName,
integerToWordName, integerToIntName, minusIntegerName,
negateIntegerName, eqIntegerPrimName, neqIntegerPrimName,
absIntegerName, signumIntegerName,
leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName,
compareIntegerName, quotRemIntegerName, divModIntegerName,
quotIntegerName, remIntegerName, divIntegerName, modIntegerName,
floatFromIntegerName, doubleFromIntegerName,
encodeFloatIntegerName, encodeDoubleIntegerName,
decodeDoubleIntegerName,
gcdIntegerName, lcmIntegerName,
andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name
integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey
integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit "S#") integerSDataConKey
mkIntegerName = varQual gHC_INTEGER_TYPE (fsLit "mkInteger") mkIntegerIdKey
integerToWord64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64") integerToWord64IdKey
integerToInt64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64") integerToInt64IdKey
word64ToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "word64ToInteger") word64ToIntegerIdKey
int64ToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "int64ToInteger") int64ToIntegerIdKey
plusIntegerName = varQual gHC_INTEGER_TYPE (fsLit "plusInteger") plusIntegerIdKey
timesIntegerName = varQual gHC_INTEGER_TYPE (fsLit "timesInteger") timesIntegerIdKey
smallIntegerName = varQual gHC_INTEGER_TYPE (fsLit "smallInteger") smallIntegerIdKey
wordToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger") wordToIntegerIdKey
integerToWordName = varQual gHC_INTEGER_TYPE (fsLit "integerToWord") integerToWordIdKey
integerToIntName = varQual gHC_INTEGER_TYPE (fsLit "integerToInt") integerToIntIdKey
minusIntegerName = varQual gHC_INTEGER_TYPE (fsLit "minusInteger") minusIntegerIdKey
negateIntegerName = varQual gHC_INTEGER_TYPE (fsLit "negateInteger") negateIntegerIdKey
eqIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "eqInteger#") eqIntegerPrimIdKey
neqIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "neqInteger#") neqIntegerPrimIdKey
absIntegerName = varQual gHC_INTEGER_TYPE (fsLit "absInteger") absIntegerIdKey
signumIntegerName = varQual gHC_INTEGER_TYPE (fsLit "signumInteger") signumIntegerIdKey
leIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "leInteger#") leIntegerPrimIdKey
gtIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "gtInteger#") gtIntegerPrimIdKey
ltIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "ltInteger#") ltIntegerPrimIdKey
geIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "geInteger#") geIntegerPrimIdKey
compareIntegerName = varQual gHC_INTEGER_TYPE (fsLit "compareInteger") compareIntegerIdKey
quotRemIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger") quotRemIntegerIdKey
divModIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divModInteger") divModIntegerIdKey
quotIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotInteger") quotIntegerIdKey
remIntegerName = varQual gHC_INTEGER_TYPE (fsLit "remInteger") remIntegerIdKey
divIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divInteger") divIntegerIdKey
modIntegerName = varQual gHC_INTEGER_TYPE (fsLit "modInteger") modIntegerIdKey
floatFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger") floatFromIntegerIdKey
doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger") doubleFromIntegerIdKey
encodeFloatIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger") encodeFloatIntegerIdKey
encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey
decodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "decodeDoubleInteger") decodeDoubleIntegerIdKey
gcdIntegerName = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger") gcdIntegerIdKey
lcmIntegerName = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger") lcmIntegerIdKey
andIntegerName = varQual gHC_INTEGER_TYPE (fsLit "andInteger") andIntegerIdKey
orIntegerName = varQual gHC_INTEGER_TYPE (fsLit "orInteger") orIntegerIdKey
xorIntegerName = varQual gHC_INTEGER_TYPE (fsLit "xorInteger") xorIntegerIdKey
complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey
shiftLIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger") shiftLIntegerIdKey
shiftRIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger") shiftRIntegerIdKey
bitIntegerName = varQual gHC_INTEGER_TYPE (fsLit "bitInteger") bitIntegerIdKey
-- GHC.Natural types
naturalTyConName, naturalSDataConName :: Name
naturalTyConName = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey
naturalSDataConName = dcQual gHC_NATURAL (fsLit "NatS#") naturalSDataConKey
naturalFromIntegerName :: Name
naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey
naturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName,
mkNaturalName, wordToNaturalName :: Name
naturalToIntegerName = varQual gHC_NATURAL (fsLit "naturalToInteger") naturalToIntegerIdKey
plusNaturalName = varQual gHC_NATURAL (fsLit "plusNatural") plusNaturalIdKey
minusNaturalName = varQual gHC_NATURAL (fsLit "minusNatural") minusNaturalIdKey
timesNaturalName = varQual gHC_NATURAL (fsLit "timesNatural") timesNaturalIdKey
mkNaturalName = varQual gHC_NATURAL (fsLit "mkNatural") mkNaturalIdKey
wordToNaturalName = varQual gHC_NATURAL (fsLit "wordToNatural#") wordToNaturalIdKey
---------------------------------
-- ghc-bignum
---------------------------------
integerFromNaturalName
, integerToNaturalClampName
, integerToWordName
, integerToIntName
, integerToWord64Name
, integerToInt64Name
, integerFromWordName
, integerFromWord64Name
, integerFromInt64Name
, integerAddName
, integerMulName
, integerSubName
, integerNegateName
, integerEqPrimName
, integerNePrimName
, integerLePrimName
, integerGtPrimName
, integerLtPrimName
, integerGePrimName
, integerAbsName
, integerSignumName
, integerCompareName
, integerQuotName
, integerRemName
, integerDivName
, integerModName
, integerDivModName
, integerQuotRemName
, integerToFloatName
, integerToDoubleName
, integerEncodeFloatName
, integerEncodeDoubleName
, integerDecodeDoubleName
, integerGcdName
, integerLcmName
, integerAndName
, integerOrName
, integerXorName
, integerComplementName
, integerBitName
, integerShiftLName
, integerShiftRName
, naturalToWordName
, naturalAddName
, naturalSubName
, naturalMulName
, naturalQuotName
, naturalRemName
, naturalQuotRemName
, bignatFromWordListName
:: Name
bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name
bnbVarQual str key = varQual gHC_NUM_BIGNAT (fsLit str) key
bnnVarQual str key = varQual gHC_NUM_NATURAL (fsLit str) key
bniVarQual str key = varQual gHC_NUM_INTEGER (fsLit str) key
-- Types and DataCons
bignatFromWordListName = bnbVarQual "bigNatFromWordList#" bignatFromWordListIdKey
naturalToWordName = bnnVarQual "naturalToWord#" naturalToWordIdKey
naturalAddName = bnnVarQual "naturalAdd" naturalAddIdKey
naturalSubName = bnnVarQual "naturalSubUnsafe" naturalSubIdKey
naturalMulName = bnnVarQual "naturalMul" naturalMulIdKey
naturalQuotName = bnnVarQual "naturalQuot" naturalQuotIdKey
naturalRemName = bnnVarQual "naturalRem" naturalRemIdKey
naturalQuotRemName = bnnVarQual "naturalQuotRem" naturalQuotRemIdKey
integerFromNaturalName = bniVarQual "integerFromNatural" integerFromNaturalIdKey
integerToNaturalClampName = bniVarQual "integerToNaturalClamp" integerToNaturalClampIdKey
integerToWordName = bniVarQual "integerToWord#" integerToWordIdKey
integerToIntName = bniVarQual "integerToInt#" integerToIntIdKey
integerToWord64Name = bniVarQual "integerToWord64#" integerToWord64IdKey
integerToInt64Name = bniVarQual "integerToInt64#" integerToInt64IdKey
integerFromWordName = bniVarQual "integerFromWord#" integerFromWordIdKey
integerFromWord64Name = bniVarQual "integerFromWord64#" integerFromWord64IdKey
integerFromInt64Name = bniVarQual "integerFromInt64#" integerFromInt64IdKey
integerAddName = bniVarQual "integerAdd" integerAddIdKey
integerMulName = bniVarQual "integerMul" integerMulIdKey
integerSubName = bniVarQual "integerSub" integerSubIdKey
integerNegateName = bniVarQual "integerNegate" integerNegateIdKey
integerEqPrimName = bniVarQual "integerEq#" integerEqPrimIdKey
integerNePrimName = bniVarQual "integerNe#" integerNePrimIdKey
integerLePrimName = bniVarQual "integerLe#" integerLePrimIdKey
integerGtPrimName = bniVarQual "integerGt#" integerGtPrimIdKey
integerLtPrimName = bniVarQual "integerLt#" integerLtPrimIdKey
integerGePrimName = bniVarQual "integerGe#" integerGePrimIdKey
integerAbsName = bniVarQual "integerAbs" integerAbsIdKey
integerSignumName = bniVarQual "integerSignum" integerSignumIdKey
integerCompareName = bniVarQual "integerCompare" integerCompareIdKey
integerQuotName = bniVarQual "integerQuot" integerQuotIdKey
integerRemName = bniVarQual "integerRem" integerRemIdKey
integerDivName = bniVarQual "integerDiv" integerDivIdKey
integerModName = bniVarQual "integerMod" integerModIdKey
integerDivModName = bniVarQual "integerDivMod#" integerDivModIdKey
integerQuotRemName = bniVarQual "integerQuotRem#" integerQuotRemIdKey
integerToFloatName = bniVarQual "integerToFloat#" integerToFloatIdKey
integerToDoubleName = bniVarQual "integerToDouble#" integerToDoubleIdKey
integerEncodeFloatName = bniVarQual "integerEncodeFloat#" integerEncodeFloatIdKey
integerEncodeDoubleName = bniVarQual "integerEncodeDouble#" integerEncodeDoubleIdKey
integerDecodeDoubleName = bniVarQual "integerDecodeDouble#" integerDecodeDoubleIdKey
integerGcdName = bniVarQual "integerGcd" integerGcdIdKey
integerLcmName = bniVarQual "integerLcm" integerLcmIdKey
integerAndName = bniVarQual "integerAnd" integerAndIdKey
integerOrName = bniVarQual "integerOr" integerOrIdKey
integerXorName = bniVarQual "integerXor" integerXorIdKey
integerComplementName = bniVarQual "integerComplement" integerComplementIdKey
integerBitName = bniVarQual "integerBit#" integerBitIdKey
integerShiftLName = bniVarQual "integerShiftL#" integerShiftLIdKey
integerShiftRName = bniVarQual "integerShiftR#" integerShiftRIdKey
---------------------------------
-- End of ghc-bignum
---------------------------------
-- GHC.Real types and classes
rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
......@@ -1901,6 +1970,15 @@ typeSymbolAppendFamNameKey = mkPreludeTyConUnique 190
unsafeEqualityTyConKey :: Unique
unsafeEqualityTyConKey = mkPreludeTyConUnique 191
-- Linear types
multiplicityTyConKey :: Unique
multiplicityTyConKey = mkPreludeTyConUnique 192
unrestrictedFunTyConKey :: Unique
unrestrictedFunTyConKey = mkPreludeTyConUnique 193
multMulTyConKey :: Unique
multMulTyConKey = mkPreludeTyConUnique 194
---------------- Template Haskell -------------------
-- GHC.Builtin.Names.TH: USES TyConUniques 200-299
......@@ -1921,9 +1999,9 @@ unsafeEqualityTyConKey = mkPreludeTyConUnique 191
-}
charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,
floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey,
floatDataConKey, intDataConKey, nilDataConKey,
ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey,
word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey,
word8DataConKey, ioDataConKey, heqDataConKey,
coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique
charDataConKey = mkPreludeDataConUnique 1
......@@ -1932,19 +2010,17 @@ doubleDataConKey = mkPreludeDataConUnique 3
falseDataConKey = mkPreludeDataConUnique 4
floatDataConKey = mkPreludeDataConUnique 5
intDataConKey = mkPreludeDataConUnique 6
integerSDataConKey = mkPreludeDataConUnique 7
nothingDataConKey = mkPreludeDataConUnique 8
justDataConKey = mkPreludeDataConUnique 9
eqDataConKey = mkPreludeDataConUnique 10
nilDataConKey = mkPreludeDataConUnique 11
ratioDataConKey = mkPreludeDataConUnique 12
word8DataConKey = mkPreludeDataConUnique 13
stableNameDataConKey = mkPreludeDataConUnique 14
trueDataConKey = mkPreludeDataConUnique 15
wordDataConKey = mkPreludeDataConUnique 16
ioDataConKey = mkPreludeDataConUnique 17
integerDataConKey = mkPreludeDataConUnique 18
heqDataConKey = mkPreludeDataConUnique 19
nothingDataConKey = mkPreludeDataConUnique 7
justDataConKey = mkPreludeDataConUnique 8
eqDataConKey = mkPreludeDataConUnique 9
nilDataConKey = mkPreludeDataConUnique 10
ratioDataConKey = mkPreludeDataConUnique 11
word8DataConKey = mkPreludeDataConUnique 12
stableNameDataConKey = mkPreludeDataConUnique 13
trueDataConKey = mkPreludeDataConUnique 14
wordDataConKey = mkPreludeDataConUnique 15
ioDataConKey = mkPreludeDataConUnique 16
heqDataConKey = mkPreludeDataConUnique 18
-- Generic data constructors
crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique
......@@ -2075,6 +2151,22 @@ typeLitNatDataConKey = mkPreludeDataConUnique 113
unsafeReflDataConKey :: Unique
unsafeReflDataConKey = mkPreludeDataConUnique 114
-- Multiplicity
oneDataConKey, manyDataConKey :: Unique
oneDataConKey = mkPreludeDataConUnique 115
manyDataConKey = mkPreludeDataConUnique 116
-- ghc-bignum
integerISDataConKey, integerINDataConKey, integerIPDataConKey,
naturalNSDataConKey, naturalNBDataConKey :: Unique
integerISDataConKey = mkPreludeDataConUnique 120
integerINDataConKey = mkPreludeDataConUnique 121
integerIPDataConKey = mkPreludeDataConUnique 122
naturalNSDataConKey = mkPreludeDataConUnique 123
naturalNBDataConKey = mkPreludeDataConUnique 124
---------------- Template Haskell -------------------
-- GHC.Builtin.Names.TH: USES DataUniques 200-250
-----------------------------------------------------
......@@ -2148,63 +2240,6 @@ sndIdKey = mkPreludeMiscIdUnique 42
otherwiseIdKey = mkPreludeMiscIdUnique 43
assertIdKey = mkPreludeMiscIdUnique 44
mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey,
integerToWordIdKey, integerToIntIdKey,
integerToWord64IdKey, integerToInt64IdKey,
word64ToIntegerIdKey, int64ToIntegerIdKey,
plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey,
negateIntegerIdKey,
eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey,
leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey,
compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey,
quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey,
floatFromIntegerIdKey, doubleFromIntegerIdKey,
encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey,
decodeDoubleIntegerIdKey,
gcdIntegerIdKey, lcmIntegerIdKey,
andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey,
shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique
mkIntegerIdKey = mkPreludeMiscIdUnique 60
smallIntegerIdKey = mkPreludeMiscIdUnique 61
integerToWordIdKey = mkPreludeMiscIdUnique 62
integerToIntIdKey = mkPreludeMiscIdUnique 63
integerToWord64IdKey = mkPreludeMiscIdUnique 64
integerToInt64IdKey = mkPreludeMiscIdUnique 65
plusIntegerIdKey = mkPreludeMiscIdUnique 66
timesIntegerIdKey = mkPreludeMiscIdUnique 67
minusIntegerIdKey = mkPreludeMiscIdUnique 68
negateIntegerIdKey = mkPreludeMiscIdUnique 69
eqIntegerPrimIdKey = mkPreludeMiscIdUnique 70
neqIntegerPrimIdKey = mkPreludeMiscIdUnique 71
absIntegerIdKey = mkPreludeMiscIdUnique 72
signumIntegerIdKey = mkPreludeMiscIdUnique 73
leIntegerPrimIdKey = mkPreludeMiscIdUnique 74
gtIntegerPrimIdKey = mkPreludeMiscIdUnique 75
ltIntegerPrimIdKey = mkPreludeMiscIdUnique 76
geIntegerPrimIdKey = mkPreludeMiscIdUnique 77
compareIntegerIdKey = mkPreludeMiscIdUnique 78
quotIntegerIdKey = mkPreludeMiscIdUnique 79
remIntegerIdKey = mkPreludeMiscIdUnique 80
divIntegerIdKey = mkPreludeMiscIdUnique 81
modIntegerIdKey = mkPreludeMiscIdUnique 82
divModIntegerIdKey = mkPreludeMiscIdUnique 83
quotRemIntegerIdKey = mkPreludeMiscIdUnique 84
floatFromIntegerIdKey = mkPreludeMiscIdUnique 85
doubleFromIntegerIdKey = mkPreludeMiscIdUnique 86
encodeFloatIntegerIdKey = mkPreludeMiscIdUnique 87
encodeDoubleIntegerIdKey = mkPreludeMiscIdUnique 88
gcdIntegerIdKey = mkPreludeMiscIdUnique 89
lcmIntegerIdKey = mkPreludeMiscIdUnique 90
andIntegerIdKey = mkPreludeMiscIdUnique 91
orIntegerIdKey = mkPreludeMiscIdUnique 92
xorIntegerIdKey = mkPreludeMiscIdUnique 93
complementIntegerIdKey = mkPreludeMiscIdUnique 94
shiftLIntegerIdKey = mkPreludeMiscIdUnique 95
shiftRIntegerIdKey = mkPreludeMiscIdUnique 96
wordToIntegerIdKey = mkPreludeMiscIdUnique 97
word64ToIntegerIdKey = mkPreludeMiscIdUnique 98
int64ToIntegerIdKey = mkPreludeMiscIdUnique 99
decodeDoubleIntegerIdKey = mkPreludeMiscIdUnique 100
rootMainKey, runMainKey :: Unique
rootMainKey = mkPreludeMiscIdUnique 101
......@@ -2401,24 +2436,121 @@ fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560
makeStaticKey :: Unique
makeStaticKey = mkPreludeMiscIdUnique 561
-- Natural
naturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey,
minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey,
naturalSDataConKey, wordToNaturalIdKey :: Unique
naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562
naturalToIntegerIdKey = mkPreludeMiscIdUnique 563
plusNaturalIdKey = mkPreludeMiscIdUnique 564
minusNaturalIdKey = mkPreludeMiscIdUnique 565
timesNaturalIdKey = mkPreludeMiscIdUnique 566
mkNaturalIdKey = mkPreludeMiscIdUnique 567
naturalSDataConKey = mkPreludeMiscIdUnique 568
wordToNaturalIdKey = mkPreludeMiscIdUnique 569
-- Unsafe coercion proofs
unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
unsafeCoercePrimIdKey = mkPreludeMiscIdUnique 571
------------------------------------------------------
-- ghc-bignum uses 600-699 uniques
------------------------------------------------------
integerFromNaturalIdKey
, integerToNaturalClampIdKey
, integerToWordIdKey
, integerToIntIdKey
, integerToWord64IdKey
, integerToInt64IdKey
, integerAddIdKey
, integerMulIdKey
, integerSubIdKey
, integerNegateIdKey
, integerEqPrimIdKey
, integerNePrimIdKey
, integerLePrimIdKey
, integerGtPrimIdKey
, integerLtPrimIdKey
, integerGePrimIdKey
, integerAbsIdKey
, integerSignumIdKey
, integerCompareIdKey
, integerQuotIdKey
, integerRemIdKey
, integerDivIdKey
, integerModIdKey
, integerDivModIdKey
, integerQuotRemIdKey
, integerToFloatIdKey
, integerToDoubleIdKey
, integerEncodeFloatIdKey
, integerEncodeDoubleIdKey
, integerGcdIdKey
, integerLcmIdKey
, integerAndIdKey
, integerOrIdKey
, integerXorIdKey
, integerComplementIdKey
, integerBitIdKey
, integerShiftLIdKey
, integerShiftRIdKey
, integerFromWordIdKey
, integerFromWord64IdKey
, integerFromInt64IdKey
, integerDecodeDoubleIdKey
, naturalToWordIdKey
, naturalAddIdKey
, naturalSubIdKey
, naturalMulIdKey
, naturalQuotIdKey
, naturalRemIdKey
, naturalQuotRemIdKey
, bignatFromWordListIdKey
:: Unique
integerFromNaturalIdKey = mkPreludeMiscIdUnique 600
integerToNaturalClampIdKey = mkPreludeMiscIdUnique 601
integerToWordIdKey = mkPreludeMiscIdUnique 602
integerToIntIdKey = mkPreludeMiscIdUnique 603
integerToWord64IdKey = mkPreludeMiscIdUnique 604
integerToInt64IdKey = mkPreludeMiscIdUnique 605
integerAddIdKey = mkPreludeMiscIdUnique 606
integerMulIdKey = mkPreludeMiscIdUnique 607
integerSubIdKey = mkPreludeMiscIdUnique 608
integerNegateIdKey = mkPreludeMiscIdUnique 609
integerEqPrimIdKey = mkPreludeMiscIdUnique 610
integerNePrimIdKey = mkPreludeMiscIdUnique 611
integerLePrimIdKey = mkPreludeMiscIdUnique 612
integerGtPrimIdKey = mkPreludeMiscIdUnique 613
integerLtPrimIdKey = mkPreludeMiscIdUnique 614
integerGePrimIdKey = mkPreludeMiscIdUnique 615
integerAbsIdKey = mkPreludeMiscIdUnique 616
integerSignumIdKey = mkPreludeMiscIdUnique 617
integerCompareIdKey = mkPreludeMiscIdUnique 618
integerQuotIdKey = mkPreludeMiscIdUnique 619
integerRemIdKey = mkPreludeMiscIdUnique 620
integerDivIdKey = mkPreludeMiscIdUnique 621
integerModIdKey = mkPreludeMiscIdUnique 622
integerDivModIdKey = mkPreludeMiscIdUnique 623
integerQuotRemIdKey = mkPreludeMiscIdUnique 624
integerToFloatIdKey = mkPreludeMiscIdUnique 625
integerToDoubleIdKey = mkPreludeMiscIdUnique 626
integerEncodeFloatIdKey = mkPreludeMiscIdUnique 627
integerEncodeDoubleIdKey = mkPreludeMiscIdUnique 628
integerGcdIdKey = mkPreludeMiscIdUnique 629
integerLcmIdKey = mkPreludeMiscIdUnique 630
integerAndIdKey = mkPreludeMiscIdUnique 631
integerOrIdKey = mkPreludeMiscIdUnique 632
integerXorIdKey = mkPreludeMiscIdUnique 633
integerComplementIdKey = mkPreludeMiscIdUnique 634
integerBitIdKey = mkPreludeMiscIdUnique 635
integerShiftLIdKey = mkPreludeMiscIdUnique 636
integerShiftRIdKey = mkPreludeMiscIdUnique 637
integerFromWordIdKey = mkPreludeMiscIdUnique 638
integerFromWord64IdKey = mkPreludeMiscIdUnique 639
integerFromInt64IdKey = mkPreludeMiscIdUnique 640
integerDecodeDoubleIdKey = mkPreludeMiscIdUnique 641
naturalToWordIdKey = mkPreludeMiscIdUnique 650
naturalAddIdKey = mkPreludeMiscIdUnique 651
naturalSubIdKey = mkPreludeMiscIdUnique 652
naturalMulIdKey = mkPreludeMiscIdUnique 653
naturalQuotIdKey = mkPreludeMiscIdUnique 654
naturalRemIdKey = mkPreludeMiscIdUnique 655
naturalQuotRemIdKey = mkPreludeMiscIdUnique 656
bignatFromWordListIdKey = mkPreludeMiscIdUnique 670
{-
************************************************************************
* *
......
......@@ -98,7 +98,7 @@ templateHaskellNames = [
-- Type
forallTName, forallVisTName, varTName, conTName, infixTName, appTName,
appKindTName, equalityTName, tupleTName, unboxedTupleTName,
unboxedSumTName, arrowTName, listTName, sigTName, litTName,
unboxedSumTName, arrowTName, mulArrowTName, listTName, sigTName, litTName,
promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
wildCardTName, implicitParamTName,
-- TyLit
......@@ -438,8 +438,8 @@ recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
-- data Type = ...
forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
unboxedTupleTName, unboxedSumTName, arrowTName, listTName, appTName,
appKindTName, sigTName, equalityTName, litTName, promotedTName,
unboxedTupleTName, unboxedSumTName, arrowTName, mulArrowTName, listTName,
appTName, appKindTName, sigTName, equalityTName, litTName, promotedTName,
promotedTupleTName, promotedNilTName, promotedConsTName,
wildCardTName, implicitParamTName :: Name
forallTName = libFun (fsLit "forallT") forallTIdKey
......@@ -450,6 +450,7 @@ tupleTName = libFun (fsLit "tupleT") tupleTIdKey
unboxedTupleTName = libFun (fsLit "unboxedTupleT") unboxedTupleTIdKey
unboxedSumTName = libFun (fsLit "unboxedSumT") unboxedSumTIdKey
arrowTName = libFun (fsLit "arrowT") arrowTIdKey
mulArrowTName = libFun (fsLit "mulArrowT") mulArrowTIdKey
listTName = libFun (fsLit "listT") listTIdKey
appTName = libFun (fsLit "appT") appTIdKey
appKindTName = libFun (fsLit "appKindT") appKindTIdKey
......@@ -1046,6 +1047,10 @@ interruptibleIdKey = mkPreludeMiscIdUnique 442
funDepIdKey :: Unique
funDepIdKey = mkPreludeMiscIdUnique 445
-- mulArrow
mulArrowTIdKey :: Unique
mulArrowTIdKey = mkPreludeMiscIdUnique 446
-- data TySynEqn = ...
tySynEqnIdKey :: Unique
tySynEqnIdKey = mkPreludeMiscIdUnique 460
......
......@@ -453,7 +453,7 @@ Duplicate YES NO
just look at Control.Monad.ST.Lazy.Imp.strictToLazy! We get
something like this
p = case readMutVar# s v of
(# s', r #) -> (S# s', r)
(# s', r #) -> (State# s', r)
s' = case p of (s', r) -> s'
r = case p of (s', r) -> r
......@@ -579,7 +579,7 @@ primOpType op
Compare _occ ty -> compare_fun_ty ty
GenPrimOp _occ tyvars arg_tys res_ty ->
mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)
mkSpecForAllTys tyvars (mkVisFunTysMany arg_tys res_ty)
primOpOcc :: PrimOp -> OccName
primOpOcc op = case primOpInfo op of
......@@ -739,9 +739,9 @@ commutableOp :: PrimOp -> Bool
-- Utils:
dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
dyadic_fun_ty ty = mkVisFunTys [ty, ty] ty
monadic_fun_ty ty = mkVisFunTy ty ty
compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy
dyadic_fun_ty ty = mkVisFunTysMany [ty, ty] ty
monadic_fun_ty ty = mkVisFunTyMany ty ty
compare_fun_ty ty = mkVisFunTysMany [ty, ty] intPrimTy
-- Output stuff:
......
......@@ -125,7 +125,26 @@ module GHC.Builtin.Types (
int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
doubleElemRepDataConTy
doubleElemRepDataConTy,
-- * Multiplicity and friends
multiplicityTyConName, oneDataConName, manyDataConName, multiplicityTy,
multiplicityTyCon, oneDataCon, manyDataCon, oneDataConTy, manyDataConTy,
oneDataConTyCon, manyDataConTyCon,
multMulTyCon,
unrestrictedFunTyCon, unrestrictedFunTyConName,
-- * Bignum
integerTy, integerTyCon, integerTyConName,
integerISDataCon, integerISDataConName,
integerIPDataCon, integerIPDataConName,
integerINDataCon, integerINDataConName,
naturalTy, naturalTyCon, naturalTyConName,
naturalNSDataCon, naturalNSDataConName,
naturalNBDataCon, naturalNBDataConName
) where
#include "HsVersions.h"
......@@ -142,6 +161,7 @@ import {-# SOURCE #-} GHC.Builtin.Uniques
-- others:
import GHC.Core.Coercion.Axiom
import GHC.Types.Id
import GHC.Types.Var (VarBndr (Bndr))
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
import GHC.Unit.Module ( Module )
import GHC.Core.Type
......@@ -240,6 +260,9 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, vecElemTyCon
, constraintKindTyCon
, liftedTypeKindTyCon
, multiplicityTyCon
, naturalTyCon
, integerTyCon
]
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
......@@ -461,6 +484,20 @@ constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constr
liftedTypeKindTyConName :: Name
liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
multiplicityTyConName :: Name
multiplicityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Multiplicity")
multiplicityTyConKey multiplicityTyCon
oneDataConName, manyDataConName :: Name
oneDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "One") oneDataConKey oneDataCon
manyDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "Many") manyDataConKey manyDataCon
-- It feels wrong to have One and Many be BuiltInSyntax. But otherwise,
-- `Many`, in particular, is considered out of scope unless an appropriate
-- file is open. The problem with this is that `Many` appears implicitly in
-- types every time there is an `(->)`, hence out-of-scope errors get
-- reported. Making them built-in make it so that they are always considered in
-- scope.
runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name
runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
......@@ -544,16 +581,20 @@ pcTyCon name cType tyvars cons
False -- Not in GADT syntax
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
pcDataCon n univs = pcDataConWithFixity False n univs
pcDataCon n univs tys = pcDataConW n univs (map linear tys)
pcDataConW :: Name -> [TyVar] -> [Scaled Type] -> TyCon -> DataCon
pcDataConW n univs tys = pcDataConWithFixity False n univs
[] -- no ex_tvs
univs -- the univs are precisely the user-written tyvars
tys
pcDataConWithFixity :: Bool -- ^ declared infix?
-> Name -- ^ datacon name
-> [TyVar] -- ^ univ tyvars
-> [TyCoVar] -- ^ ex tycovars
-> [TyCoVar] -- ^ user-written tycovars
-> [Type] -- ^ args
-> [Scaled Type] -- ^ args
-> TyCon
-> DataCon
pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n))
......@@ -567,7 +608,7 @@ pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (n
pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
-> [TyVar] -> [TyCoVar] -> [TyCoVar]
-> [Type] -> TyCon -> DataCon
-> [Scaled Type] -> TyCon -> DataCon
-- The Name should be in the DataName name space; it's the name
-- of the DataCon itself.
--
......@@ -625,7 +666,7 @@ mkDataConWorkerName data_con wrk_key =
pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
pcSpecialDataCon dc_name arg_tys tycon rri
= pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri
[] [] [] arg_tys tycon
[] [] [] (map linear arg_tys) tycon
{-
************************************************************************
......@@ -651,7 +692,7 @@ constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
liftedTypeKind, typeToTypeKind, constraintKind :: Kind
liftedTypeKind = tYPE liftedRepTy
typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind
typeToTypeKind = liftedTypeKind `mkVisFunTyMany` liftedTypeKind
constraintKind = mkTyConApp constraintKindTyCon []
{-
......@@ -791,7 +832,8 @@ isBuiltInOcc_maybe occ =
"~" -> Just eqTyConName
-- function tycon
"->" -> Just funTyConName
"FUN" -> Just funTyConName
"->" -> Just unrestrictedFunTyConName
-- boxed tuple data/tycon
-- We deliberately exclude Solo (the boxed 1-tuple).
......@@ -1149,7 +1191,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
rhs klass
(mkPrelTyConRepName eqTyConName)
klass = mk_class tycon sc_pred sc_sel_id
datacon = pcDataCon eqDataConName tvs [sc_pred] tycon
datacon = pcDataConW eqDataConName tvs [unrestricted sc_pred] tycon
-- Kind: forall k. k -> k -> Constraint
binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
......@@ -1167,7 +1209,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
rhs klass
(mkPrelTyConRepName heqTyConName)
klass = mk_class tycon sc_pred sc_sel_id
datacon = pcDataCon heqDataConName tvs [sc_pred] tycon
datacon = pcDataConW heqDataConName tvs [unrestricted sc_pred] tycon
-- Kind: forall k1 k2. k1 -> k2 -> Constraint
binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id
......@@ -1185,7 +1227,7 @@ eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
rhs klass
(mkPrelTyConRepName coercibleTyConName)
klass = mk_class tycon sc_pred sc_sel_id
datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon
datacon = pcDataConW coercibleDataConName tvs [unrestricted sc_pred] tycon
-- Kind: forall k. k -> k -> Constraint
binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
......@@ -1203,6 +1245,67 @@ mk_class tycon sc_pred sc_sel_id
{- *********************************************************************
* *
Multiplicity Polymorphism
* *
********************************************************************* -}
{- Multiplicity polymorphism is implemented very similarly to levity
polymorphism. We write in the multiplicity kind and the One and Many
types which can appear in user programs. These are defined properly in GHC.Types.
data Multiplicity = One | Many
-}
multiplicityTy :: Type
multiplicityTy = mkTyConTy multiplicityTyCon
multiplicityTyCon :: TyCon
multiplicityTyCon = pcTyCon multiplicityTyConName Nothing []
[oneDataCon, manyDataCon]
oneDataCon, manyDataCon :: DataCon
oneDataCon = pcDataCon oneDataConName [] [] multiplicityTyCon
manyDataCon = pcDataCon manyDataConName [] [] multiplicityTyCon
oneDataConTy, manyDataConTy :: Type
oneDataConTy = mkTyConTy oneDataConTyCon
manyDataConTy = mkTyConTy manyDataConTyCon
oneDataConTyCon, manyDataConTyCon :: TyCon
oneDataConTyCon = promoteDataCon oneDataCon
manyDataConTyCon = promoteDataCon manyDataCon
multMulTyConName :: Name
multMulTyConName =
mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "MultMul") multMulTyConKey multMulTyCon
multMulTyCon :: TyCon
multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing
(BuiltInSynFamTyCon trivialBuiltInFamily)
Nothing
NotInjective
where
binders = mkTemplateAnonTyConBinders [multiplicityTy, multiplicityTy]
unrestrictedFunTy :: Type
unrestrictedFunTy = functionWithMultiplicity manyDataConTy
unrestrictedFunTyCon :: TyCon
unrestrictedFunTyCon = buildSynTyCon unrestrictedFunTyConName [] arrowKind [] unrestrictedFunTy
where arrowKind = mkTyConKind binders liftedTypeKind
-- See also funTyCon
binders = [ Bndr runtimeRep1TyVar (NamedTCB Inferred)
, Bndr runtimeRep2TyVar (NamedTCB Inferred)
]
++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
, tYPE runtimeRep2Ty
]
unrestrictedFunTyConName :: Name
unrestrictedFunTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "->") unrestrictedFunTyConKey unrestrictedFunTyCon
{- *********************************************************************
* *
Kinds and RuntimeRep
......@@ -1576,7 +1679,7 @@ consDataCon :: DataCon
consDataCon = pcDataConWithFixity True {- Declared infix -}
consDataConName
alpha_tyvar [] alpha_tyvar
[alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
(map linear [alphaTy, mkTyConApp listTyCon alpha_ty]) listTyCon
-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)
......@@ -1735,3 +1838,98 @@ extractPromotedList tys = go tys
| otherwise
= pprPanic "extractPromotedList" (ppr tys)
---------------------------------------
-- ghc-bignum
---------------------------------------
integerTyConName
, integerISDataConName
, integerIPDataConName
, integerINDataConName
:: Name
integerTyConName
= mkWiredInTyConName
UserSyntax
gHC_NUM_INTEGER
(fsLit "Integer")
integerTyConKey
integerTyCon
integerISDataConName
= mkWiredInDataConName
UserSyntax
gHC_NUM_INTEGER
(fsLit "IS")
integerISDataConKey
integerISDataCon
integerIPDataConName
= mkWiredInDataConName
UserSyntax
gHC_NUM_INTEGER
(fsLit "IP")
integerIPDataConKey
integerIPDataCon
integerINDataConName
= mkWiredInDataConName
UserSyntax
gHC_NUM_INTEGER
(fsLit "IN")
integerINDataConKey
integerINDataCon
integerTy :: Type
integerTy = mkTyConTy integerTyCon
integerTyCon :: TyCon
integerTyCon = pcTyCon integerTyConName Nothing []
[integerISDataCon, integerIPDataCon, integerINDataCon]
integerISDataCon :: DataCon
integerISDataCon = pcDataCon integerISDataConName [] [intPrimTy] integerTyCon
integerIPDataCon :: DataCon
integerIPDataCon = pcDataCon integerIPDataConName [] [byteArrayPrimTy] integerTyCon
integerINDataCon :: DataCon
integerINDataCon = pcDataCon integerINDataConName [] [byteArrayPrimTy] integerTyCon
naturalTyConName
, naturalNSDataConName
, naturalNBDataConName
:: Name
naturalTyConName
= mkWiredInTyConName
UserSyntax
gHC_NUM_NATURAL
(fsLit "Natural")
naturalTyConKey
naturalTyCon
naturalNSDataConName
= mkWiredInDataConName
UserSyntax
gHC_NUM_NATURAL
(fsLit "NS")
naturalNSDataConKey
naturalNSDataCon
naturalNBDataConName
= mkWiredInDataConName
UserSyntax
gHC_NUM_NATURAL
(fsLit "NB")
naturalNBDataConKey
naturalNBDataCon
naturalTy :: Type
naturalTy = mkTyConTy naturalTyCon
naturalTyCon :: TyCon
naturalTyCon = pcTyCon naturalTyConName Nothing []
[naturalNSDataCon, naturalNBDataCon]
naturalNSDataCon :: DataCon
naturalNSDataCon = pcDataCon naturalNSDataConName [] [wordPrimTy] naturalTyCon
naturalNBDataCon :: DataCon
naturalNBDataCon = pcDataCon naturalNBDataConName [] [byteArrayPrimTy] naturalTyCon
......@@ -44,4 +44,15 @@ anyTypeOfKind :: Kind -> Type
unboxedTupleKind :: [Type] -> Type
mkPromotedListTy :: Type -> [Type] -> Type
multiplicityTyCon :: TyCon
multiplicityTy :: Type
oneDataConTy :: Type
oneDataConTyCon :: TyCon
manyDataConTy :: Type
manyDataConTyCon :: TyCon
unrestrictedFunTyCon :: TyCon
multMulTyCon :: TyCon
tupleTyConName :: TupleSort -> Arity -> Name
integerTy, naturalTy :: Type
......@@ -26,12 +26,16 @@ module GHC.Builtin.Types.Prim(
runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
multiplicityTyVar,
multiplicityTyVarList,
-- Kind constructors...
tYPETyCon, tYPETyConName,
-- Kinds
tYPE, primRepToRuntimeRep,
functionWithMultiplicity,
funTyCon, funTyConName,
unexposedPrimTyCons, exposedPrimTyCons, primTyCons,
......@@ -108,7 +112,7 @@ import {-# SOURCE #-} GHC.Builtin.Types
, int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
, word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
, doubleElemRepDataConTy
, mkPromotedListTy )
, mkPromotedListTy, multiplicityTy )
import GHC.Types.Var ( TyVar, mkTyVar )
import GHC.Types.Name
......@@ -228,7 +232,7 @@ eqPhantPrimTyConName = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKe
realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
smallArrayPrimTyConName = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
......@@ -385,6 +389,14 @@ openAlphaTy, openBetaTy :: Type
openAlphaTy = mkTyVarTy openAlphaTyVar
openBetaTy = mkTyVarTy openBetaTyVar
multiplicityTyVar :: TyVar
multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13 -- selects 'n'
-- Create 'count' multiplicity TyVars
multiplicityTyVarList :: Int -> [TyVar]
multiplicityTyVarList count = take count $
drop 13 $ -- selects 'n', 'o'...
mkTemplateTyVars (repeat multiplicityTy)
{-
************************************************************************
* *
......@@ -394,13 +406,13 @@ openBetaTy = mkTyVarTy openBetaTyVar
-}
funTyConName :: Name
funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon
-- | The @(->)@ type constructor.
-- | The @FUN@ type constructor.
--
-- @
-- (->) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
-- TYPE rep1 -> TYPE rep2 -> Type
-- FUN :: forall {m :: Multiplicity} {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
-- TYPE rep1 -> TYPE rep2 -> *
-- @
--
-- The runtime representations quantification is left inferred. This
......@@ -413,13 +425,15 @@ funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
-- @
-- type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
-- TYPE rep1 -> TYPE rep2 -> Type
-- type Arr = (->)
-- type Arr = FUN
-- @
--
funTyCon :: TyCon
funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
where
tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar
-- See also unrestrictedFunTyCon
tc_bndrs = [ mkNamedTyConBinder Required multiplicityTyVar
, mkNamedTyConBinder Inferred runtimeRep1TyVar
, mkNamedTyConBinder Inferred runtimeRep2TyVar ]
++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
, tYPE runtimeRep2Ty
......@@ -543,6 +557,10 @@ mkPrimTcName built_in_syntax occ key tycon
tYPE :: Type -> Type
tYPE rr = TyConApp tYPETyCon [rr]
-- Given a Multiplicity, applies FUN to it.
functionWithMultiplicity :: Type -> Type
functionWithMultiplicity mul = TyConApp funTyCon [mul]
{-
************************************************************************
* *
......
......@@ -194,17 +194,15 @@ section "The word size story."
-- This type won't be exported directly (since there is no concrete
-- syntax for this sort of export) so we'll have to manually patch
-- export lists in both GHC and Haddock.
primtype (->) a b
{The builtin function type, written in infix form as {\tt a -> b} and
in prefix form as {\tt (->) a b}. Values of this type are functions
taking inputs of type {\tt a} and producing outputs of type {\tt b}.
primtype FUN m a b
{The builtin function type, written in infix form as {\tt a # m -> b}.
Values of this type are functions taking inputs of type {\tt a} and
producing outputs of type {\tt b}. The multiplicity of the input is
{\tt m}.
Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and
Note that {\tt FUN m a b} permits levity-polymorphism in both {\tt a} and
{\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded.
}
with fixity = infixr -1
-- This fixity is only the one picked up by Haddock. If you
-- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'.
------------------------------------------------------------------------
section "Char#"
......
......@@ -453,7 +453,7 @@ assembleI platform i = case i of
literal (LitChar c) = int (ord c)
literal (LitString bs) = lit [BCONPtrStr bs]
-- LitString requires a zero-terminator when emitted
literal (LitNumber nt i _) = case nt of
literal (LitNumber nt i) = case nt of
LitNumInt -> int (fromIntegral i)
LitNumWord -> int (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
......
......@@ -19,6 +19,7 @@ import GHC.Types.Name ( Name, getName )
import GHC.Types.Name.Env
import GHC.Core.DataCon ( DataCon, dataConRepArgTys, dataConIdentity )
import GHC.Core.TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
import GHC.Core.Multiplicity ( scaledThing )
import GHC.Types.RepType
import GHC.StgToCmm.Layout ( mkVirtConstrSizes )
import GHC.StgToCmm.Closure ( tagForCon, NonVoid (..) )
......@@ -58,7 +59,7 @@ make_constr_itbls hsc_env cons =
mk_itbl dcon conNo = do
let rep_args = [ NonVoid prim_rep
| arg <- dataConRepArgTys dcon
, prim_rep <- typePrimRep arg ]
, prim_rep <- typePrimRep (scaledThing arg) ]
(tot_wds, ptr_wds) =
mkVirtConstrSizes dflags rep_args
......
......@@ -345,9 +345,10 @@ We have one literal, a literal Integer, that is lifted, and we don't
allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
(see #5603) if you say
case 3 of
S# x -> ...
J# _ _ -> ...
(where S#, J# are the constructors for Integer) we don't want the
IS x -> ...
IP _ -> ...
IN _ -> ...
(where IS, IP, IN are the constructors for Integer) we don't want the
simplifier calling findAlt with argument (LitAlt 3). No no. Integer
literals are an opaque encoding of an algebraic data type, not of
an unlifted literal, like all the others.
......@@ -518,6 +519,10 @@ checked by Core Lint.
7. The type of the scrutinee must be the same as the type
of the case binder, obviously. Checked in lintCaseExpr.
8. The multiplicity of the binders in constructor patterns must be the
multiplicity of the corresponding field /scaled by the multiplicity of the
case binder/. Checked in lintCoreAlt.
Note [Core type and coercion invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We allow a /non-recursive/, /non-top-level/ let to bind type and
......
......@@ -112,6 +112,8 @@ module GHC.Core.Coercion (
-- * Other
promoteCoercion, buildCoercion,
multToCo,
simplifyArgsWorker,
badCoercionHole, badCoercionHoleCo
......@@ -132,6 +134,7 @@ import GHC.Core.TyCo.Tidy
import GHC.Core.Type
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import {-# SOURCE #-} GHC.Core.Utils ( mkFunctionType )
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
......@@ -298,9 +301,9 @@ whose `RuntimeRep' arguments are intentionally marked inferred to
avoid type application.
Hence
FunCo r co1 co2 :: (s1->t1) ~r (s2->t2)
FunCo r mult co1 co2 :: (s1->t1) ~r (s2->t2)
is short for
TyConAppCo (->) co_rep1 co_rep2 co1 co2
TyConAppCo (->) mult co_rep1 co_rep2 co1 co2
where co_rep1, co_rep2 are the coercions on the representations.
-}
......@@ -321,12 +324,12 @@ decomposeCo arity co rs
decomposeFunCo :: HasDebugCallStack
=> Role -- Role of the input coercion
-> Coercion -- Input coercion
-> (Coercion, Coercion)
-> (CoercionN, Coercion, Coercion)
-- Expects co :: (s1 -> t1) ~ (s2 -> t2)
-- Returns (co1 :: s1~s2, co2 :: t1~t2)
-- See Note [Function coercions] for the "2" and "3"
-- See Note [Function coercions] for the "3" and "4"
decomposeFunCo r co = ASSERT2( all_ok, ppr co )
(mkNthCo r 2 co, mkNthCo r 3 co)
(mkNthCo Nominal 0 co, mkNthCo r 3 co, mkNthCo r 4 co)
where
Pair s1t1 s2t2 = coercionKind co
all_ok = isFunTy s1t1 && isFunTy s2t2
......@@ -394,14 +397,16 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args
in
go (arg_co : acc_arg_cos) (subst1', t1) res_co (subst2', t2) tys
| Just (_s1, t1) <- splitFunTy_maybe k1
, Just (_s2, t2) <- splitFunTy_maybe k2
| Just (_w1, _s1, t1) <- splitFunTy_maybe k1
, Just (_w1, _s2, t2) <- splitFunTy_maybe k2
-- know co :: (s1 -> t1) ~ (s2 -> t2)
-- function :: s1 -> t1
-- ty :: s2
-- need arg_co :: s2 ~ s1
-- res_co :: t1 ~ t2
= let (sym_arg_co, res_co) = decomposeFunCo Nominal co
= let (_, sym_arg_co, res_co) = decomposeFunCo Nominal co
-- It should be fine to ignore the multiplicity bit of the coercion
-- for a Nominal coercion.
arg_co = mkSymCo sym_arg_co
in
go (arg_co : acc_arg_cos) (subst1,t1) res_co (subst2,t2) tys
......@@ -430,10 +435,13 @@ splitTyConAppCo_maybe co
; let args = zipWith mkReflCo (tyConRolesX r tc) tys
; return (tc, args) }
splitTyConAppCo_maybe (TyConAppCo _ tc cos) = Just (tc, cos)
splitTyConAppCo_maybe (FunCo _ arg res) = Just (funTyCon, cos)
where cos = [mkRuntimeRepCo arg, mkRuntimeRepCo res, arg, res]
splitTyConAppCo_maybe (FunCo _ w arg res) = Just (funTyCon, cos)
where cos = [w, mkRuntimeRepCo arg, mkRuntimeRepCo res, arg, res]
splitTyConAppCo_maybe _ = Nothing
multToCo :: Mult -> Coercion
multToCo r = mkNomReflCo r
-- first result has role equal to input; third result is Nominal
splitAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion)
-- ^ Attempt to take a coercion application apart.
......@@ -457,8 +465,9 @@ splitAppCo_maybe co
= Just (mkReflCo r ty1, mkNomReflCo ty2)
splitAppCo_maybe _ = Nothing
-- Only used in specialise/Rules
splitFunCo_maybe :: Coercion -> Maybe (Coercion, Coercion)
splitFunCo_maybe (FunCo _ arg res) = Just (arg, res)
splitFunCo_maybe (FunCo _ _ arg res) = Just (arg, res)
splitFunCo_maybe _ = Nothing
splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion)
......@@ -682,12 +691,12 @@ mkNomReflCo = Refl
-- caller's responsibility to get the roles correct on argument coercions.
mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
mkTyConAppCo r tc cos
| tc `hasKey` funTyConKey
, [_rep1, _rep2, co1, co2] <- cos -- See Note [Function coercions]
| [w, _rep1, _rep2, co1, co2] <- cos -- See Note [Function coercions]
, isFunTyCon tc
= -- (a :: TYPE ra) -> (b :: TYPE rb) ~ (c :: TYPE rc) -> (d :: TYPE rd)
-- rep1 :: ra ~ rc rep2 :: rb ~ rd
-- co1 :: a ~ c co2 :: b ~ d
mkFunCo r co1 co2
mkFunCo r w co1 co2
-- Expand type synonyms
| Just (tv_co_prs, rhs_ty, leftover_cos) <- expandSynTyCon_maybe tc cos
......@@ -701,13 +710,14 @@ mkTyConAppCo r tc cos
-- | Build a function 'Coercion' from two other 'Coercion's. That is,
-- given @co1 :: a ~ b@ and @co2 :: x ~ y@ produce @co :: (a -> x) ~ (b -> y)@.
mkFunCo :: Role -> Coercion -> Coercion -> Coercion
mkFunCo r co1 co2
mkFunCo :: Role -> CoercionN -> Coercion -> Coercion -> Coercion
mkFunCo r w co1 co2
-- See Note [Refl invariant]
| Just (ty1, _) <- isReflCo_maybe co1
, Just (ty2, _) <- isReflCo_maybe co2
= mkReflCo r (mkVisFunTy ty1 ty2)
| otherwise = FunCo r co1 co2
, Just (w, _) <- isReflCo_maybe w
= mkReflCo r (mkVisFunTy w ty1 ty2)
| otherwise = FunCo r w co1 co2
-- | Apply a 'Coercion' to another 'Coercion'.
-- The second coercion must be Nominal, unless the first is Phantom.
......@@ -810,7 +820,8 @@ mkForAllCo_NoRefl v kind_co co
, ASSERT( not (isReflCo co)) True
, isCoVar v
, not (v `elemVarSet` tyCoVarsOfCo co)
= FunCo (coercionRole co) kind_co co
= FunCo (coercionRole co) (multToCo Many) kind_co co
-- Functions from coercions are always unrestricted
| otherwise
= ForAllCo v kind_co co
......@@ -1024,21 +1035,22 @@ mkNthCo r n co
-- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2)
-- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4))
go r n co@(FunCo r0 arg res)
go r n co@(FunCo r0 w arg res)
-- See Note [Function coercions]
-- If FunCo _ arg_co res_co :: (s1:TYPE sk1 -> s2:TYPE sk2)
-- ~ (t1:TYPE tk1 -> t2:TYPE tk2)
-- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2)
-- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2)
-- Then we want to behave as if co was
-- TyConAppCo argk_co resk_co arg_co res_co
-- TyConAppCo mult argk_co resk_co arg_co res_co
-- where
-- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co)
-- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co)
-- i.e. mkRuntimeRepCo
= case n of
0 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg
1 -> ASSERT( r == Nominal ) mkRuntimeRepCo res
2 -> ASSERT( r == r0 ) arg
3 -> ASSERT( r == r0 ) res
0 -> ASSERT( r == Nominal ) w
1 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg
2 -> ASSERT( r == Nominal ) mkRuntimeRepCo res
3 -> ASSERT( r == r0 ) arg
4 -> ASSERT( r == r0 ) res
_ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr co)
go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n
......@@ -1186,8 +1198,8 @@ mkSubCo (Refl ty) = GRefl Representational ty MRefl
mkSubCo (GRefl Nominal ty co) = GRefl Representational ty co
mkSubCo (TyConAppCo Nominal tc cos)
= TyConAppCo Representational tc (applyRoles tc cos)
mkSubCo (FunCo Nominal arg res)
= FunCo Representational
mkSubCo (FunCo Nominal w arg res)
= FunCo Representational w
(downgradeRole Representational Nominal arg)
(downgradeRole Representational Nominal res)
mkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) )
......@@ -1259,10 +1271,10 @@ setNominalRole_maybe r co
setNominalRole_maybe_helper (TyConAppCo Representational tc cos)
= do { cos' <- zipWithM setNominalRole_maybe (tyConRolesX Representational tc) cos
; return $ TyConAppCo Nominal tc cos' }
setNominalRole_maybe_helper (FunCo Representational co1 co2)
setNominalRole_maybe_helper (FunCo Representational w co1 co2)
= do { co1' <- setNominalRole_maybe Representational co1
; co2' <- setNominalRole_maybe Representational co2
; return $ FunCo Nominal co1' co2'
; return $ FunCo Nominal w co1' co2'
}
setNominalRole_maybe_helper (SymCo co)
= SymCo <$> setNominalRole_maybe_helper co
......@@ -1376,7 +1388,7 @@ promoteCoercion co = case co of
mkNomReflCo liftedTypeKind
-- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep
FunCo _ _ _
FunCo _ _ _ _
-> ASSERT( False )
mkNomReflCo liftedTypeKind
......@@ -1508,8 +1520,8 @@ mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co
-- want it to be r. It is only called in 'mkPiCos', which is
-- only used in GHC.Core.Opt.Simplify.Utils, where we are sure for
-- now (Aug 2018) v won't occur in co.
mkFunCo r (mkReflCo r (varType v)) co
| otherwise = mkFunCo r (mkReflCo r (varType v)) co
mkFunCo r (multToCo (varMult v)) (mkReflCo r (varType v)) co
| otherwise = mkFunCo r (multToCo (varMult v)) (mkReflCo r (varType v)) co
-- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2
-- The first coercion might be lifted or unlifted; thus the ~? above
......@@ -1782,6 +1794,8 @@ liftCoSubstWith r tvs cos ty
-- @lc_left@ is a substitution mapping type variables to the left-hand
-- types of the mapped coercions in @lc@, and similar for @lc_right@.
liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
{-# INLINE liftCoSubst #-}
-- Inlining this function is worth 2% of allocation in T9872d,
liftCoSubst r lc@(LC subst env) ty
| isEmptyVarEnv env = mkReflCo r (substTy subst ty)
| otherwise = ty_co_subst lc r ty
......@@ -1888,7 +1902,7 @@ ty_co_subst lc role ty
liftCoSubstTyVar lc r tv
go r (AppTy ty1 ty2) = mkAppCo (go r ty1) (go Nominal ty2)
go r (TyConApp tc tys) = mkTyConAppCo r tc (zipWith go (tyConRolesX r tc) tys)
go r (FunTy _ ty1 ty2) = mkFunCo r (go r ty1) (go r ty2)
go r (FunTy _ w ty1 ty2) = mkFunCo r (go Nominal w) (go r ty1) (go r ty2)
go r t@(ForAllTy (Bndr v _) ty)
= let (lc', v', h) = liftCoSubstVarBndr lc v
body_co = ty_co_subst lc' r ty in
......@@ -2125,7 +2139,7 @@ seqCo (TyConAppCo r tc cos) = r `seq` tc `seq` seqCos cos
seqCo (AppCo co1 co2) = seqCo co1 `seq` seqCo co2
seqCo (ForAllCo tv k co) = seqType (varType tv) `seq` seqCo k
`seq` seqCo co
seqCo (FunCo r co1 co2) = r `seq` seqCo co1 `seq` seqCo co2
seqCo (FunCo r w co1 co2) = r `seq` seqCo w `seq` seqCo co1 `seq` seqCo co2
seqCo (CoVarCo cv) = cv `seq` ()
seqCo (HoleCo h) = coHoleCoVar h `seq` ()
seqCo (AxiomInstCo con ind cos) = con `seq` ind `seq` seqCos cos
......@@ -2188,7 +2202,7 @@ coercionLKind co
go (TyConAppCo _ tc cos) = mkTyConApp tc (map go cos)
go (AppCo co1 co2) = mkAppTy (go co1) (go co2)
go (ForAllCo tv1 _ co1) = mkTyCoInvForAllTy tv1 (go co1)
go (FunCo _ co1 co2) = mkFunctionType (go co1) (go co2)
go (FunCo _ w co1 co2) = mkFunctionType (go w) (go co1) (go co2)
go (CoVarCo cv) = coVarLType cv
go (HoleCo h) = coVarLType (coHoleCoVar h)
go (UnivCo _ _ ty1 _) = ty1
......@@ -2245,7 +2259,7 @@ coercionRKind co
go (AppCo co1 co2) = mkAppTy (go co1) (go co2)
go (CoVarCo cv) = coVarRType cv
go (HoleCo h) = coVarRType (coHoleCoVar h)
go (FunCo _ co1 co2) = mkFunctionType (go co1) (go co2)
go (FunCo _ w co1 co2) = mkFunctionType (go w) (go co1) (go co2)
go (UnivCo _ _ _ ty2) = ty2
go (SymCo co) = coercionLKind co
go (TransCo _ co2) = go co2
......@@ -2348,7 +2362,7 @@ coercionRole = go
go (TyConAppCo r _ _) = r
go (AppCo co1 _) = go co1
go (ForAllCo _ _ co) = go co
go (FunCo r _ _) = r
go (FunCo r _ _ _) = r
go (CoVarCo cv) = coVarRole cv
go (HoleCo h) = coVarRole (coHoleCoVar h)
go (AxiomInstCo ax _ _) = coAxiomRole ax
......@@ -2454,9 +2468,9 @@ buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2
; _ -> False } )
mkNomReflCo ty1
go (FunTy { ft_arg = arg1, ft_res = res1 })
(FunTy { ft_arg = arg2, ft_res = res2 })
= mkFunCo Nominal (go arg1 arg2) (go res1 res2)
go (FunTy { ft_mult = w1, ft_arg = arg1, ft_res = res1 })
(FunTy { ft_mult = w2, ft_arg = arg2, ft_res = res2 })
= mkFunCo Nominal (go w1 w2) (go arg1 arg2) (go res1 res2)
go (TyConApp tc1 args1) (TyConApp tc2 args2)
= ASSERT( tc1 == tc2 )
......@@ -2834,7 +2848,9 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs
-> [Role] -- Roles at which to flatten these ...
-> [(Type, Coercion)] -- flattened arguments, with their flattening coercions
-> ([Type], [Coercion], CoercionN)
go acc_xis acc_cos lc binders inner_ki _ []
go acc_xis acc_cos !lc binders inner_ki _ []
-- The !lc makes the function strict in the lifting context
-- which means GHC can unbox that pair. A modest win.
= (reverse acc_xis, reverse acc_cos, kind_co)
where
final_kind = mkPiTys binders inner_ki
......
......@@ -17,7 +17,7 @@ mkReflCo :: Role -> Type -> Coercion
mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
mkAppCo :: Coercion -> Coercion -> Coercion
mkForAllCo :: TyCoVar -> Coercion -> Coercion -> Coercion
mkFunCo :: Role -> Coercion -> Coercion -> Coercion
mkFunCo :: Role -> CoercionN -> Coercion -> Coercion -> Coercion
mkCoVarCo :: CoVar -> Coercion
mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion
mkPhantomCo :: Coercion -> Type -> Type -> Coercion
......
......@@ -26,7 +26,7 @@ module GHC.Core.Coercion.Axiom (
Role(..), fsFromRole,
CoAxiomRule(..), TypeEqn,
BuiltInSynFamily(..)
BuiltInSynFamily(..), trivialBuiltInFamily
) where
import GHC.Prelude
......@@ -579,3 +579,11 @@ data BuiltInSynFamily = BuiltInSynFamily
, sfInteractInert :: [Type] -> Type ->
[Type] -> Type -> [TypeEqn]
}
-- Provides default implementations that do nothing.
trivialBuiltInFamily :: BuiltInSynFamily
trivialBuiltInFamily = BuiltInSynFamily
{ sfMatchFam = \_ -> Nothing
, sfInteractTop = \_ _ -> []
, sfInteractInert = \_ _ _ _ -> []
}
......@@ -251,14 +251,15 @@ opt_co4 env sym rep r (ForAllCo tv k_co co)
opt_co4_wrap env' sym rep r co
-- Use the "mk" functions to check for nested Refls
opt_co4 env sym rep r (FunCo _r co1 co2)
opt_co4 env sym rep r (FunCo _r cow co1 co2)
= ASSERT( r == _r )
if rep
then mkFunCo Representational co1' co2'
else mkFunCo r co1' co2'
then mkFunCo Representational cow' co1' co2'
else mkFunCo r cow' co1' co2'
where
co1' = opt_co4_wrap env sym rep r co1
co2' = opt_co4_wrap env sym rep r co2
cow' = opt_co1 env sym cow
opt_co4 env sym rep r (CoVarCo cv)
| Just co <- lookupCoVar (lcTCvSubst env) cv
......@@ -648,10 +649,10 @@ opt_trans_rule is in_co1@(TyConAppCo r1 tc1 cos1) in_co2@(TyConAppCo r2 tc2 cos2
fireTransRule "PushTyConApp" in_co1 in_co2 $
mkTyConAppCo r1 tc1 (opt_transList is cos1 cos2)
opt_trans_rule is in_co1@(FunCo r1 co1a co1b) in_co2@(FunCo r2 co2a co2b)
= ASSERT( r1 == r2 ) -- Just like the TyConAppCo/TyConAppCo case
opt_trans_rule is in_co1@(FunCo r1 w1 co1a co1b) in_co2@(FunCo r2 w2 co2a co2b)
= ASSERT( r1 == r2) -- Just like the TyConAppCo/TyConAppCo case
fireTransRule "PushFun" in_co1 in_co2 $
mkFunCo r1 (opt_trans is co1a co2a) (opt_trans is co1b co2b)
mkFunCo r1 (opt_trans is w1 w2) (opt_trans is co1a co2a) (opt_trans is co1b co2b)
opt_trans_rule is in_co1@(AppCo co1a co1b) in_co2@(AppCo co2a co2b)
-- Must call opt_trans_rule_app; see Note [EtaAppCo]
......
......@@ -39,6 +39,7 @@ import GHC.Types.Basic
import GHC.Core.TyCo.Rep (Type, ThetaType)
import GHC.Types.Var
import GHC.Core.Type(mkTyConApp)
import GHC.Core.Multiplicity
import qualified Data.Data as Data
......@@ -108,11 +109,11 @@ conLikeFieldLabels (PatSynCon pat_syn) = patSynFieldLabels pat_syn
-- | Returns just the instantiated /value/ argument types of a 'ConLike',
-- (excluding dictionary args)
conLikeInstOrigArgTys :: ConLike -> [Type] -> [Type]
conLikeInstOrigArgTys :: ConLike -> [Type] -> [Scaled Type]
conLikeInstOrigArgTys (RealDataCon data_con) tys =
dataConInstOrigArgTys data_con tys
conLikeInstOrigArgTys (PatSynCon pat_syn) tys =
patSynInstArgTys pat_syn tys
map unrestricted $ patSynInstArgTys pat_syn tys
-- | 'TyVarBinder's for the type variables of the 'ConLike'. For pattern
-- synonyms, this will always consist of the universally quantified variables
......@@ -181,7 +182,7 @@ conLikeFullSig :: ConLike
-> ([TyVar], [TyCoVar], [EqSpec]
-- Why tyvars for universal but tycovars for existential?
-- See Note [Existential coercion variables] in GHC.Core.DataCon
, ThetaType, ThetaType, [Type], Type)
, ThetaType, ThetaType, [Scaled Type], Type)
conLikeFullSig (RealDataCon con) =
let (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) = dataConFullSig con
-- Required theta is empty as normal data cons require no additional
......
......@@ -30,11 +30,14 @@ module GHC.Core.DataCon (
dataConRepType, dataConInstSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTagZ,
dataConTyCon, dataConOrigTyCon,
dataConUserType,
dataConWrapperType,
dataConNonlinearType,
dataConDisplayType,
dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,
dataConUserTyVars, dataConUserTyVarBinders,
dataConEqSpec, dataConTheta,
dataConStupidTheta,
dataConOtherTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
......@@ -68,6 +71,7 @@ import GHC.Core.Type as Type
import GHC.Core.Coercion
import GHC.Core.Unify
import GHC.Core.TyCon
import GHC.Core.Multiplicity
import GHC.Types.FieldLabel
import GHC.Core.Class
import GHC.Types.Name
......@@ -83,6 +87,9 @@ import GHC.Utils.Binary
import GHC.Types.Unique.Set
import GHC.Types.Unique( mkAlphaTyVarUnique )
import GHC.Driver.Session
import GHC.LanguageExtensions as LangExt
import Data.ByteString (ByteString)
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS
......@@ -188,7 +195,7 @@ Note [Data constructor workers and wrappers]
* Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
* The wrapper (if it exists) takes dcOrigArgTys as its arguments
* The wrapper (if it exists) takes dcOrigArgTys as its arguments.
The worker takes dataConRepArgTys as its arguments
If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys
......@@ -412,7 +419,7 @@ data DataCon
-- the wrapper Id, because that makes it harder to use the wrap-id
-- to rebuild values after record selection or in generics.
dcOrigArgTys :: [Type], -- Original argument types
dcOrigArgTys :: [Scaled Type], -- Original argument types
-- (before unboxing and flattening of strict fields)
dcOrigResTy :: Type, -- Original result type, as seen by the user
-- NB: for a data instance, the original user result type may
......@@ -595,7 +602,7 @@ sometimes refer to this as "the dcUserTyVarBinders invariant".
dcUserTyVarBinders, as the name suggests, is the one that users will see most of
the time. It's used when computing the type signature of a data constructor (see
dataConUserType), and as a result, it's what matters from a TypeApplications
dataConWrapperType), and as a result, it's what matters from a TypeApplications
perspective.
Note [The dcEqSpec domain invariant]
......@@ -640,9 +647,9 @@ data DataConRep
, dcr_boxer :: DataConBoxer
, dcr_arg_tys :: [Type] -- Final, representation argument types,
-- after unboxing and flattening,
-- and *including* all evidence args
, dcr_arg_tys :: [Scaled Type] -- Final, representation argument types,
-- after unboxing and flattening,
-- and *including* all evidence args
, dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys
-- See also Note [Data-con worker strictness]
......@@ -944,7 +951,7 @@ mkDataCon :: Name
-- See @Note [TyVarBinders in DataCons]@
-> [EqSpec] -- ^ GADT equalities
-> KnotTied ThetaType -- ^ Theta-type occurring before the arguments proper
-> [KnotTied Type] -- ^ Original argument types
-> [KnotTied (Scaled Type)] -- ^ Original argument types
-> KnotTied Type -- ^ Original result type
-> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
-> KnotTied TyCon -- ^ Representation type constructor
......@@ -1002,8 +1009,8 @@ mkDataCon name declared_infix prom_info
rep_ty =
case rep of
-- If the DataCon has no wrapper, then the worker's type *is* the
-- user-facing type, so we can simply use dataConUserType.
NoDataConRep -> dataConUserType con
-- user-facing type, so we can simply use dataConWrapperType.
NoDataConRep -> dataConWrapperType con
-- If the DataCon has a wrapper, then the worker's type is never seen
-- by the user. The visibilities we pick do not matter here.
DCR{} -> mkInfForAllTys univ_tvs $ mkTyCoInvForAllTys ex_tvs $
......@@ -1021,7 +1028,7 @@ mkDataCon name declared_infix prom_info
prom_theta_bndrs = [ mkAnonTyConBinder InvisArg (mkTyVar n t)
{- Invisible -} | (n,t) <- fresh_names `zip` theta ]
prom_arg_bndrs = [ mkAnonTyConBinder VisArg (mkTyVar n t)
{- Visible -} | (n,t) <- dropList theta fresh_names `zip` orig_arg_tys ]
{- Visible -} | (n,t) <- dropList theta fresh_names `zip` map scaledThing orig_arg_tys ]
prom_bndrs = prom_tv_bndrs ++ prom_theta_bndrs ++ prom_arg_bndrs
prom_res_kind = orig_res_ty
promoted = mkPromotedDataCon con name prom_info prom_bndrs
......@@ -1029,7 +1036,7 @@ mkDataCon name declared_infix prom_info
roles = map (\tv -> if isTyVar tv then Nominal else Phantom)
(univ_tvs ++ ex_tvs)
++ map (const Representational) (theta ++ orig_arg_tys)
++ map (const Representational) (theta ++ map scaledThing orig_arg_tys)
freshNames :: [Name] -> [Name]
-- Make an infinite list of Names whose Uniques and OccNames
......@@ -1206,7 +1213,7 @@ dataConFieldType con label = case dataConFieldType_maybe con label of
dataConFieldType_maybe :: DataCon -> FieldLabelString
-> Maybe (FieldLabel, Type)
dataConFieldType_maybe con label
= find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con)
= find ((== label) . flLabel . fst) (dcFields con `zip` (scaledThing <$> dcOrigArgTys con))
-- | Strictness/unpack annotations, from user; or, for imported
-- DataCons, from the interface file
......@@ -1270,7 +1277,7 @@ dataConInstSig con@(MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs
univ_tys
= ( ex_tvs'
, substTheta subst (dataConTheta con)
, substTys subst arg_tys)
, substTys subst (map scaledThing arg_tys))
where
univ_subst = zipTvSubst univ_tvs univ_tys
(subst, ex_tvs') = Type.substVarBndrs univ_subst ex_tvs
......@@ -1290,11 +1297,12 @@ dataConInstSig con@(MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs
-- equalities
--
-- 5) The original argument types to the 'DataCon' (i.e. before
-- any change of the representation of the type)
-- any change of the representation of the type) with linearity
-- annotations
--
-- 6) The original result type of the 'DataCon'
dataConFullSig :: DataCon
-> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)
-> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type)
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs,
dcEqSpec = eq_spec, dcOtherTheta = theta,
dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
......@@ -1309,7 +1317,41 @@ dataConOrigResTy dc = dcOrigResTy dc
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc
dataConUserType :: DataCon -> Type
{-
Note [Displaying linear fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A constructor with a linear field can be written either as
MkT :: a #-> T a (with -XLinearTypes)
or
MkT :: a -> T a (with -XNoLinearTypes)
There are two different methods to retrieve a type of a datacon.
They differ in how linear fields are handled.
1. dataConWrapperType:
The type of the wrapper in Core.
For example, dataConWrapperType for Maybe is a #-> Just a.
2. dataConNonlinearType:
The type of the constructor, with linear arrows replaced by unrestricted ones.
Used when we don't want to introduce linear types to user (in holes
and in types in hie used by haddock).
3. dataConDisplayType (depends on DynFlags):
The type we'd like to show in error messages, :info and -ddump-types.
Ideally, it should reflect the type written by the user;
the function returns a type with arrows that would be required
to write this constructor under the current setting of -XLinearTypes.
In principle, this type can be different from the user's source code
when the value of -XLinearTypes has changed, but we don't
expect this to cause much trouble.
Due to internal plumbing in checkValidDataCon, we can't just return a Doc.
The multiplicity of arrows returned by dataConDisplayType and
dataConDisplayType is used only for pretty-printing.
-}
dataConWrapperType :: DataCon -> Type
-- ^ The user-declared type of the data constructor
-- in the nice-to-read form:
--
......@@ -1324,14 +1366,30 @@ dataConUserType :: DataCon -> Type
--
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
dataConUserType (MkData { dcUserTyVarBinders = user_tvbs,
dcOtherTheta = theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
dataConWrapperType (MkData { dcUserTyVarBinders = user_tvbs,
dcOtherTheta = theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
= mkInvisForAllTys user_tvbs $
mkInvisFunTys theta $
mkInvisFunTysMany theta $
mkVisFunTys arg_tys $
res_ty
dataConNonlinearType :: DataCon -> Type
dataConNonlinearType (MkData { dcUserTyVarBinders = user_tvbs,
dcOtherTheta = theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
= let arg_tys' = map (\(Scaled w t) -> Scaled (case w of One -> Many; _ -> w) t) arg_tys
in mkInvisForAllTys user_tvbs $
mkInvisFunTysMany theta $
mkVisFunTys arg_tys' $
res_ty
dataConDisplayType :: DynFlags -> DataCon -> Type
dataConDisplayType dflags dc
= if xopt LangExt.LinearTypes dflags
then dataConWrapperType dc
else dataConNonlinearType dc
-- | Finds the instantiated types of the arguments required to construct a
-- 'DataCon' representation
-- NB: these INCLUDE any dictionary args
......@@ -1341,13 +1399,13 @@ dataConInstArgTys :: DataCon -- ^ A datacon with no existentials or equality
-- However, it can have a dcTheta (notably it can be a
-- class dictionary, with superclasses)
-> [Type] -- ^ Instantiated at these types
-> [Type]
-> [Scaled Type]
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
dcExTyCoVars = ex_tvs}) inst_tys
= ASSERT2( univ_tvs `equalLength` inst_tys
, text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
ASSERT2( null ex_tvs, ppr dc )
map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
map (mapScaledType (substTyWith univ_tvs inst_tys)) (dataConRepArgTys dc)
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
-- (excluding dictionary args)
......@@ -1355,7 +1413,7 @@ dataConInstOrigArgTys
:: DataCon -- Works for any DataCon
-> [Type] -- Includes existential tyvar args, but NOT
-- equality constraints or dicts
-> [Type]
-> [Scaled Type]
-- For vanilla datacons, it's all quite straightforward
-- But for the call in GHC.HsToCore.Match.Constructor, we really do want just
-- the value args
......@@ -1364,26 +1422,30 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
dcExTyCoVars = ex_tvs}) inst_tys
= ASSERT2( tyvars `equalLength` inst_tys
, text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
map (substTy subst) arg_tys
substScaledTys subst arg_tys
where
tyvars = univ_tvs ++ ex_tvs
subst = zipTCvSubst tyvars inst_tys
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
-- and without substituting for any type variables
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys :: DataCon -> [Scaled Type]
dataConOrigArgTys dc = dcOrigArgTys dc
-- | Returns constraints in the wrapper type, other than those in the dataConEqSpec
dataConOtherTheta :: DataCon -> ThetaType
dataConOtherTheta dc = dcOtherTheta dc
-- | Returns the arg types of the worker, including *all* non-dependent
-- evidence, after any flattening has been done and without substituting for
-- any type variables
dataConRepArgTys :: DataCon -> [Type]
dataConRepArgTys :: DataCon -> [Scaled Type]
dataConRepArgTys (MkData { dcRep = rep
, dcEqSpec = eq_spec
, dcOtherTheta = theta
, dcOrigArgTys = orig_arg_tys })
= case rep of
NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
NoDataConRep -> ASSERT( null eq_spec ) (map unrestricted theta) ++ orig_arg_tys
DCR { dcr_arg_tys = arg_tys } -> arg_tys
-- | The string @package:module.name@ identifying a constructor, which is attached
......@@ -1502,7 +1564,7 @@ splitDataProductType_maybe
-> Maybe (TyCon, -- The type constructor
[Type], -- Type args of the tycon
DataCon, -- The data constructor
[Type]) -- Its /representation/ arg types
[Scaled Type]) -- Its /representation/ arg types
-- Rejecting existentials is conservative. Maybe some things
-- could be made to work with them, but I'm not going to sweat
......
......@@ -8,7 +8,7 @@ import GHC.Types.FieldLabel ( FieldLabel )
import GHC.Types.Unique ( Uniquable )
import GHC.Utils.Outputable ( Outputable, OutputableBndr )
import GHC.Types.Basic (Arity)
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType )
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType, Scaled )
data DataCon
data DataConRep
......@@ -21,10 +21,10 @@ dataConUserTyVars :: DataCon -> [TyVar]
dataConUserTyVarBinders :: DataCon -> [InvisTVBinder]
dataConSourceArity :: DataCon -> Arity
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type]
dataConStupidTheta :: DataCon -> ThetaType
dataConFullSig :: DataCon
-> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)
-> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type)
isUnboxedSumCon :: DataCon -> Bool
instance Eq DataCon
......