...
 
Commits (72)
  • Ömer Sinan Ağacan's avatar
    Fix LLVM version check yet again · 061f7f9b
    Ömer Sinan Ağacan authored
    There were two problems with LLVM version checking:
    
    - The parser would only parse x and x.y formatted versions. E.g. 1.2.3
      would be rejected.
    
    - The version check was too strict and would reject x.y formatted
      versions. E.g. when we support version 7 it'd reject 7.0 ("LLVM
      version 7.0") and only accept 7 ("LLVM version 7").
    
    We now parse versions with arbitrarily deep minor numbering (x.y.z.t...)
    and accept versions as long as the major version matches the supported
    version (e.g. 7.1, 7.1.2, 7.1.2.3 ...).
    
    (cherry picked from commit bf9dfe1c)
    061f7f9b
  • Ben Gamari's avatar
    base: Clamp IO operation size to 2GB on Darwin · 176367f8
    Ben Gamari authored
    As reported in #17414, Darwin throws EINVAL in response to large
    writes.
    
    (cherry picked from commit 08810f123eb3b49bcfb3dd1d46284ec9d53d2612)
    176367f8
  • Ben Gamari's avatar
    testsuite: Add test for #17414 · d04492c0
    Ben Gamari authored
    (cherry picked from commit 1ce3d98213902ccb483d5c5f426484e0d7be0245)
    d04492c0
  • Roland Senn's avatar
    Fix #14690 - :steplocal panics after break-on-error · 4c376e30
    Roland Senn authored
    `:steplocal` enables only breakpoints in the current top-level binding.
    
    When a normal breakpoint is hit, then the module name and the break id from the `BRK_FUN` byte code
    allow us to access the corresponding entry in a ModBreak table. From this entry we then get the SrcSpan
    (see compiler/main/InteractiveEval.hs:bindLocalsAtBreakpoint).
    With this source-span we can then determine the current top-level binding, needed for the steplocal command.
    
    However, if we break at an exception or at an error, we don't have an BRK_FUN byte-code, so we don't have any source information.
    The function `bindLocalsAtBreakpoint` creates an `UnhelpfulSpan`, which doesn't allow us to determine the current top-level binding.
    To avoid a `panic`, we have to check for `UnhelpfulSpan` in the function `ghc/GHCi/UI.hs:stepLocalCmd`.
    Hence a :steplocal command after a break-on-exception or a break-on-error is not possible.
    
    (cherry picked from commit 1be9c35c)
    4c376e30
  • Ben Gamari's avatar
    base: Add @since on GHC.IO.Handle.Lock.hUnlock · 68dc5b0a
    Ben Gamari authored
    Unfortunately this was introduced in base-4.11.0 (GHC 8.4.1)
    whereas the other locking primitives were added in base-4.10.0 (GHC
    8.2.1).
    
    (cherry picked from commit 3ad35f766e6869087c97a5c8129ab06ddf1856d4)
    68dc5b0a
  • Ben Gamari's avatar
    Drop duplicate -optl's from GHC invocations · 9c7dde7f
    Ben Gamari authored
    Previously the make build system would pass things like
    `-optl-optl-Wl,-x -optl-optl-Wl,noexecstack` to GHC. This would
    naturally result in mass confusion as GHC would pass `-optl-Wl,-x` to
    GCC. GCC would in turn interpret this as `-o ptl-Wl,-x`, setting the
    output pass of the invocation.
    
    The problem that `-optl` was added to the command-line in two places in
    the build system. Fix this.
    
    Fixes #17385.
    
    (cherry picked from commit 2d12d59e)
    9c7dde7f
  • ryates@cs.rochester.edu's avatar
    Full abort on validate failure merging `orElse`. · 432a270e
    ryates@cs.rochester.edu authored
    Previously partial roll back of a branch of an `orElse` was attempted
    if validation failure was observed.  Validation here, however, does
    not account for what part of the transaction observed inconsistent
    state.  This commit fixes this by fully aborting and restarting the
    transaction.
    
    (cherry picked from commit 998f2e18)
    432a270e
  • Ben Gamari's avatar
    Bump stm submodule · e8175bed
    Ben Gamari authored
    (cherry picked from commit 8b578e72)
    e8175bed
  • Ryan Scott's avatar
    Don't skip validity checks for built-in classes (#17355) · 51036008
    Ryan Scott authored
    Issue #17355 occurred because the control flow for
    `TcValidity.check_valid_inst_head` was structured in such a way that
    whenever it checked a special, built-in class (like `Generic` or
    `HasField`), it would skip the most important check of all:
    `checkValidTypePats`, which rejects nonsense like this:
    
    ```hs
    instance Generic (forall a. a)
    ```
    
    This fixes the issue by carving out `checkValidTypePats` from
    `check_valid_inst_head` so that `checkValidTypePats` is always
    invoked. `check_valid_inst_head` has also been renamed to
    `check_special_inst_head` to reflect its new purpose of _only_
    checking for instances headed by special classes.
    
    Fixes #17355.
    
    (cherry picked from commit f375e3fb)
    51036008
  • Roland Senn's avatar
    New fix for #11647. Avoid side effects like #17171 · 2fe94000
    Roland Senn authored
    If a main module doesn't contain a header, we omit the check whether the main module is exported.
    With this patch GHC, GHCi and runghc use the same code.
    
    (cherry picked from commit 93f02b62)
    2fe94000
  • Ben Gamari's avatar
    configure: Determine library versions of template-haskell, et al. · 2c0df863
    Ben Gamari authored
    These are needed by the user guide documentation. Fixes #17260.
    
    (cherry picked from commit 0c53d0aa)
    2c0df863
  • Stefan Schulze Frielinghaus's avatar
    Extend argument of createIOThread to word size · 822a7f4d
    Stefan Schulze Frielinghaus authored
    Function createIOThread expects its second argument to be of size word.
    The natural size of the second parameter is 32bits. Thus for some 64bit
    architectures, where a write of the lower half of a register does not
    clear the upper half, the value must be zero extended.
    
    (cherry picked from commit d0924b15)
    822a7f4d
  • Ben Gamari's avatar
    rts: Fix CNF dirtying logic · 900fce4e
    Ben Gamari authored
    Previously due to a silly implementation bug CNFs would never have their
    dirty flag set, resulting in their being added again and again to the
    `mut_list`. Fix this.
    
    Fixes #17297.
    
    (cherry picked from commit ba27fe74)
    900fce4e
  • Ben Gamari's avatar
    rules/haddock: Ensure that RTS stats directory exists · c3fd844c
    Ben Gamari authored
    It may not exist if the source tarball was extracted yet not the
    testsuite tarball.
    
    (cherry picked from commit 624eb0fc)
    c3fd844c
  • Ben Gamari's avatar
    Exclude rts.cabal from source distributions · 1c33f5d6
    Ben Gamari authored
    This modifies both the Hadrian and make build systems to avoid included
    the rts.cabal generated by autoconf in the source distribution.
    
    Fixes #17265.
    
    (cherry picked from commit e81d4bc7)
    1c33f5d6
  • Ömer Sinan Ağacan's avatar
    Fix new compact block allocation in allocateForCompact · c4cfb707
    Ömer Sinan Ağacan authored
    allocateForCompact() is called when nursery of a compact region is
    full, to add new blocks to the compact. New blocks added to an existing
    region needs a StgCompactNFDataBlock header, not a StgCompactNFData.
    
    This fixes allocateForCompact() so that it now correctly allocates space
    for StgCompactNFDataBlock instead of StgCompactNFData as before.
    
    Fixes #17044.
    
    A regression test T17044 added.
    
    (cherry picked from commit 981d3b9e)
    c4cfb707
  • Ben Gamari's avatar
    configure: Don't depend upon alex in source dist build · 996f281c
    Ben Gamari authored
    This fixes #16860 by verifying that the generated sources don't already
    exist before asserting that the `alex` executable was found. This
    replicates the logic already used for `happy` in the case of `alex`.
    
    (cherry picked from commit 68dc96a0)
    996f281c
  • Andreas Klebinger's avatar
    Fix bounds check in ocResolve_PEi386 for relocation values. · ab65b997
    Andreas Klebinger authored
    The old test was wrong at least for gcc and the value -2287728808L.
    
    It also relied on implementation defined behaviour (right shift
    on a negative value), which might or might not be ok.
    Either way it's now a simple comparison which will always work.
    
    (cherry picked from commit abfbdff2)
    ab65b997
  • Sam Halliday's avatar
    expose ModuleInfo.minf_rdr_env for tooling authors · 854ce0e5
    Sam Halliday authored
    (cherry picked from commit 993804bf)
    854ce0e5
  • Ben Gamari's avatar
    testsuite: Add tests for #16943 · d9e01a96
    Ben Gamari authored
    (cherry picked from commit f1d0e49f)
    d9e01a96
  • Ben Gamari's avatar
    configure: Search for LLVM executables with two-number versions · 140f0a74
    Ben Gamari authored
    Fedora uses the naming llc-7.0 while Debian uses llc-7. Ensure that both
    are found.
    
    Fixes #16990.
    
    (cherry picked from commit 90bf11c6)
    140f0a74
  • Ryan Scott's avatar
    Fix #14579 by defining tyConAppNeedsKindSig, and using it · 963ed692
    Ryan Scott authored
    (cherry picked from commit e88e083d)
    963ed692
  • Ryan Scott's avatar
    Reify oversaturated data family instances correctly (#17296) · 9ecf4bb1
    Ryan Scott authored
    `TcSplice` was not properly handling oversaturated data family
    instances, such as the example in #17296, as it dropped arguments due
    to carelessly zipping data family instance arguments with
    `tyConTyVars`. For data families, the number of `tyConTyVars` can
    sometimes be less than the number of arguments it can accept in a
    data family instance due to the fact that data family instances can
    be oversaturated.
    
    To account for this, `TcSplice.mkIsPolyTvs` has now been renamed to
    `tyConArgsPolyKinded` and now factors in `tyConResKind` in addition
    to `tyConTyVars`. I've also added
    `Note [Reified instances and explicit kind signatures]` which
    explains the various subtleties in play here.
    
    Fixes #17296.
    
    (cherry picked from commit e3636a68)
    9ecf4bb1
  • Ryan Scott's avatar
    Parenthesize GADT return types in pprIfaceConDecl (#17384) · efe714d6
    Ryan Scott authored
    We were using `pprIfaceAppArgs` instead of `pprParendIfaceAppArgs`
    in `pprIfaceConDecl`. Oops.
    
    Fixes #17384.
    efe714d6
  • Simon Peyton Jones's avatar
    Don't do binder-swap for GlobalIds · dc9aa75e
    Simon Peyton Jones authored
    This patch disables the binder-swap transformation in the
    (relatively rare) case when the scrutinee is a GlobalId.
    Reason: we are getting Lint errors so that GHC doesn't
    even validate.  Trac #16346.
    
    This is NOT the final solution -- it's just a stop-gap
    to get us running again.
    
    The final solution is in Trac #16296
    
    (cherry picked from commit 0eb7cf03)
    dc9aa75e
  • Sebastian Graf's avatar
    Fix #17112 · bf5c4c19
    Sebastian Graf authored
    The `mkOneConFull` function of the pattern match checker used to try to
    guess the type arguments of the data type's type constructor by looking
    at the ambient type of the match. This doesn't work well for Pattern
    Synonyms, where the result type isn't even necessarily a TyCon
    application, and it shows in #11336 and #17112.
    
    Also the effort seems futile; why try to try hard when the type checker
    has already done the hard lifting? After this patch, we instead supply
    the type constructors arguments as an argument to the function and
    lean on the type-annotated AST.
    
    (cherry picked from commit a308b435)
    bf5c4c19
  • Simon Peyton Jones's avatar
    Improve error recovery in the typechecker · cf05e689
    Simon Peyton Jones authored
    Issue #16418 showed that we were carrying on too eagerly after a bogus
    type signature was identified (a bad telescope in fact), leading to a
    subsequent crash.
    
    This led me in to a maze of twisty little passages in the typechecker's
    error recovery, and I ended up doing some refactoring in TcRnMonad.
    Some specfifics
    
    * TcRnMonad.try_m is now called attemptM.
    
    * I switched the order of the result pair in tryTc,
      to make it consistent with other similar functions.
    
    * The actual exception used in the Tc monad is irrelevant so,
      to avoid polluting type signatures, I made tcTryM, a simple
      wrapper around tryM, and used it.
    
    The more important changes are in
    
    * TcSimplify.captureTopConstraints, where we should have been calling
      simplifyTop rather than reportUnsolved, so that levity defaulting
      takes place properly.
    
    * TcUnify.emitResidualTvConstraint, where we need to set the correct
      status for a new implication constraint.  (Previously we ended up
      with an Insoluble constraint wrapped in an Unsolved implication,
      which meant that insolubleWC gave the wrong answer.
    
    (cherry picked from commit 4927117c)
    cf05e689
  • vdukhovni's avatar
    On FreeBSD 12 sys/sysctl.h requires sys/types.h · dde5c06a
    vdukhovni authored
    Else build fails with:
    
        In file included from ExecutablePath.hsc:42:
        /usr/include/sys/sysctl.h:1062:25: error: unknown type name 'u_int'; did you mean 'int'?
         int sysctl(const int *, u_int, void *, size_t *, const void *, size_t);
    			     ^~~~~
    			     int
        compiling libraries/base/dist-install/build/System/Environment/ExecutablePath_hsc_make.c failed (exit code 1)
    
    Perhaps also also other FreeBSD releases, but additional include
    will no harm even if not needed.
    dde5c06a
  • Andreas Klebinger's avatar
    ec962cb9
  • Ben Gamari's avatar
    testsuite: Introduce concurrent_ways set · f0bf1de9
    Ben Gamari authored
    Previously we just tested for the threaded2 when determining whether to
    skip tests which are fragile under concurrent execution. However, this
    isn't the only way which is concurrent.
    f0bf1de9
  • Ben Gamari's avatar
    Bump process · f0f27217
    Ben Gamari authored
    This avoids #17480 via https://github.com/haskell/process/pull/160.
    f0f27217
  • vdukhovni's avatar
    Enable USE_PTHREAD_FOR_ITIMER also on FreeBSD · 7390e101
    vdukhovni authored
    If using a pthread instead of a timer signal is more reliable, and
    has no known drawbacks, then FreeBSD is also capable of supporting
    this mode of operation (tested on FreeBSD 12 with GHC 8.8.1, but
    no reason why it would not also work on FreeBSD 11 or GHC 8.6).
    
    Proposed by Kevin Zhang in:
    
        https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=241849
    
    (cherry picked from commit 7385674c)
    7390e101
  • Ben Gamari's avatar
    Bump process submodule to 1.6.7.0 · 28aec5ff
    Ben Gamari authored
    28aec5ff
  • Ben Gamari's avatar
    rts: Don't use MAP_32BIT on Darwin · c6fca740
    Ben Gamari authored
    As noted in #17353, Catalina added support for MAP_32BIT but disallows
    W|X mappings when it's enabled. Since we still use W|X mappins we can't
    use MAP_32BIT.
    c6fca740
  • Ben Gamari's avatar
    Bump directory submodule · 45923e1f
    Ben Gamari authored
    45923e1f
  • Ben Gamari's avatar
    Bump array submodule to 0.5.4.0 tag · e6f22498
    Ben Gamari authored
    e6f22498
  • Oleg Grenrus's avatar
    Advance Cabal to 3.0.1.0-rc1 tag · 2037e286
    Oleg Grenrus authored
    2037e286
  • Ben Gamari's avatar
    gitlab-ci: Move changelog linting logic to shell script · 9ed95740
    Ben Gamari authored
    Allowing it to be easily used locally.
    9ed95740
  • Ben Gamari's avatar
    Colorize changelog check · 07de674a
    Ben Gamari authored
    07de674a
  • Ben Gamari's avatar
    Add 8.8.2 release notes · 8effe99b
    Ben Gamari authored
    8effe99b
  • Gabor Greif's avatar
    Implement pointer tagging for big families (#14373) · 14cb6472
    Gabor Greif authored
    Formerly we punted on these and evaluated constructors always got a tag
    of 1.
    
    We now cascade switches because we have to check the tag first and when
    it is MAX_PTR_TAG then get the precise tag from the info table and
    switch on that. The only technically tricky part is that the default
    case needs (logical) duplication. To do this we emit an extra label for
    it and branch to that from the second switch. This avoids duplicated
    codegen.
    
    Here's a simple example of the new code gen:
    
        data D = D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8
    
    On a 64-bit system previously all constructors would be tagged 1. With
    the new code gen D7 and D8 are tagged 7:
    
        [Lib.D7_con_entry() {
             ...
             {offset
               c1eu: // global
                   R1 = R1 + 7;
                   call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
             }
         }]
    
        [Lib.D8_con_entry() {
             ...
             {offset
               c1ez: // global
                   R1 = R1 + 7;
                   call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
             }
         }]
    
    When switching we now look at the info table only when the tag is 7. For
    example, if we derive Enum for the type above, the Cmm looks like this:
    
        c2Le:
            _s2Js::P64 = R1;
            _c2Lq::P64 = _s2Js::P64 & 7;
            switch [1 .. 7] _c2Lq::P64 {
                case 1 : goto c2Lk;
                case 2 : goto c2Ll;
                case 3 : goto c2Lm;
                case 4 : goto c2Ln;
                case 5 : goto c2Lo;
                case 6 : goto c2Lp;
                case 7 : goto c2Lj;
            }
    
        // Read info table for tag
        c2Lj:
            _c2Lv::I64 = %MO_UU_Conv_W32_W64(I32[I64[_s2Js::P64 & (-8)] - 4]);
            if (_c2Lv::I64 != 6) goto c2Lu; else goto c2Lt;
    
    Generated Cmm sizes do not change too much, but binaries are very
    slightly larger, due to the fact that the new instructions are longer in
    encoded form. E.g. previously entry code for D8 above would be
    
        00000000000001c0 <Lib_D8_con_info>:
         1c0:	48 ff c3             	inc    %rbx
         1c3:	ff 65 00             	jmpq   *0x0(%rbp)
    
    With this patch
    
        00000000000001d0 <Lib_D8_con_info>:
         1d0:	48 83 c3 07          	add    $0x7,%rbx
         1d4:	ff 65 00             	jmpq   *0x0(%rbp)
    
    This is one byte longer.
    
    Secondly, reading info table directly and then switching is shorter
    
        _c1co:
                movq -1(%rbx),%rax
                movl -4(%rax),%eax
                // Switch on info table tag
                jmp *_n1d5(,%rax,8)
    
    than doing the same switch, and then for the tag 7 doing another switch:
    
        // When tag is 7
        _c1ct:
                andq $-8,%rbx
                movq (%rbx),%rax
                movl -4(%rax),%eax
                // Switch on info table tag
                ...
    
    Some changes of binary sizes in actual programs:
    
    - In NoFib the worst case is 0.1% increase in benchmark "parser" (see
      NoFib results below). All programs get slightly larger.
    
    - Stage 2 compiler size does not change.
    
    - In "containers" (the library) size of all object files increases
      0.0005%. Size of the test program "bitqueue-properties" increases
      0.03%.
    
    nofib benchmarks kindly provided by Ömer (@osa1):
    
    NoFib Results
    =============
    
    --------------------------------------------------------------------------------
            Program           Size    Allocs    Instrs     Reads    Writes
    --------------------------------------------------------------------------------
                 CS          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
                CSD          +0.0%      0.0%      0.0%     +0.0%     +0.0%
                 FS          +0.0%      0.0%      0.0%     +0.0%      0.0%
                  S          +0.0%      0.0%     -0.0%      0.0%      0.0%
                 VS          +0.0%      0.0%     -0.0%     +0.0%     +0.0%
                VSD          +0.0%      0.0%     -0.0%     +0.0%     -0.0%
                VSM          +0.0%      0.0%      0.0%      0.0%      0.0%
               anna          +0.0%      0.0%     +0.1%     -0.9%     -0.0%
               ansi          +0.0%      0.0%     -0.0%     +0.0%     +0.0%
               atom          +0.0%      0.0%      0.0%      0.0%      0.0%
             awards          +0.0%      0.0%     -0.0%     +0.0%      0.0%
             banner          +0.0%      0.0%     -0.0%     +0.0%      0.0%
         bernouilli          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
       binary-trees          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
              boyer          +0.0%      0.0%     +0.0%      0.0%     -0.0%
             boyer2          +0.0%      0.0%     +0.0%      0.0%     -0.0%
               bspt          +0.0%      0.0%     +0.0%     +0.0%      0.0%
          cacheprof          +0.0%      0.0%     +0.1%     -0.8%      0.0%
           calendar          +0.0%      0.0%     -0.0%     +0.0%     -0.0%
           cichelli          +0.0%      0.0%     +0.0%      0.0%      0.0%
            circsim          +0.0%      0.0%     -0.0%     -0.1%     -0.0%
           clausify          +0.0%      0.0%     +0.0%     +0.0%      0.0%
      comp_lab_zift          +0.0%      0.0%     +0.0%      0.0%     -0.0%
           compress          +0.0%      0.0%     +0.0%     +0.0%      0.0%
          compress2          +0.0%      0.0%      0.0%      0.0%      0.0%
        constraints          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
       cryptarithm1          +0.0%      0.0%     +0.0%      0.0%      0.0%
       cryptarithm2          +0.0%      0.0%     +0.0%     -0.0%      0.0%
                cse          +0.0%      0.0%     +0.0%     +0.0%      0.0%
       digits-of-e1          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
       digits-of-e2          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
             dom-lt          +0.0%      0.0%     +0.0%     +0.0%      0.0%
              eliza          +0.0%      0.0%     -0.0%     +0.0%      0.0%
              event          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
        exact-reals          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             exp3_8          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
             expert          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
     fannkuch-redux          +0.0%      0.0%     +0.0%      0.0%      0.0%
              fasta          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
                fem          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
                fft          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
               fft2          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
           fibheaps          +0.0%      0.0%     +0.0%     +0.0%      0.0%
               fish          +0.0%      0.0%     +0.0%     +0.0%      0.0%
              fluid          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             fulsom          +0.0%      0.0%     +0.0%     -0.0%     +0.0%
             gamteb          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
                gcd          +0.0%      0.0%     +0.0%     +0.0%      0.0%
        gen_regexps          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
             genfft          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
                 gg          +0.0%      0.0%      0.0%     -0.0%      0.0%
               grep          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             hidden          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
                hpg          +0.0%      0.0%     +0.0%     -0.1%     -0.0%
                ida          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
              infer          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
            integer          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
          integrate          +0.0%      0.0%      0.0%     +0.0%      0.0%
       k-nucleotide          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
              kahan          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
            knights          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
             lambda          +0.0%      0.0%     +1.2%     -6.1%     -0.0%
         last-piece          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
               lcss          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
               life          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
               lift          +0.0%      0.0%     +0.0%     +0.0%      0.0%
             linear          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
          listcompr          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
           listcopy          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
           maillist          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
             mandel          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
            mandel2          +0.0%      0.0%     +0.0%     +0.0%     -0.0%
               mate          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
            minimax          +0.0%      0.0%     -0.0%     +0.0%     -0.0%
            mkhprog          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
         multiplier          +0.0%      0.0%      0.0%     +0.0%     -0.0%
             n-body          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
           nucleic2          +0.0%      0.0%     +0.0%     +0.0%     -0.0%
               para          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
          paraffins          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             parser          +0.1%      0.0%     +0.4%     -1.7%     -0.0%
            parstof          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
                pic          +0.0%      0.0%     +0.0%      0.0%     -0.0%
           pidigits          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
              power          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
             pretty          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             primes          +0.0%      0.0%     +0.0%      0.0%      0.0%
          primetest          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             prolog          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             puzzle          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
             queens          +0.0%      0.0%      0.0%     +0.0%     +0.0%
            reptile          +0.0%      0.0%     +0.0%     +0.0%      0.0%
    reverse-complem          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
            rewrite          +0.0%      0.0%     +0.0%      0.0%     -0.0%
               rfib          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
                rsa          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
                scc          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
              sched          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
                scs          +0.0%      0.0%     +0.0%     +0.0%      0.0%
             simple          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
              solid          +0.0%      0.0%     +0.0%     +0.0%      0.0%
            sorting          +0.0%      0.0%     +0.0%     -0.0%      0.0%
      spectral-norm          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
             sphere          +0.0%      0.0%     +0.0%     -1.0%      0.0%
             symalg          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
                tak          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
          transform          +0.0%      0.0%     +0.4%     -1.3%     +0.0%
           treejoin          +0.0%      0.0%     +0.0%     -0.0%      0.0%
          typecheck          +0.0%      0.0%     -0.0%     +0.0%      0.0%
            veritas          +0.0%      0.0%     +0.0%     -0.1%     +0.0%
               wang          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
          wave4main          +0.0%      0.0%     +0.0%      0.0%     -0.0%
       wheel-sieve1          +0.0%      0.0%     +0.0%     +0.0%     +0.0%
       wheel-sieve2          +0.0%      0.0%     +0.0%     +0.0%      0.0%
               x2n1          +0.0%      0.0%     +0.0%     +0.0%      0.0%
    --------------------------------------------------------------------------------
                Min          +0.0%      0.0%     -0.0%     -6.1%     -0.0%
                Max          +0.1%      0.0%     +1.2%     +0.0%     +0.0%
     Geometric Mean          +0.0%     -0.0%     +0.0%     -0.1%     -0.0%
    
    NoFib GC Results
    ================
    
    --------------------------------------------------------------------------------
            Program           Size    Allocs    Instrs     Reads    Writes
    --------------------------------------------------------------------------------
            circsim          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
        constraints          +0.0%      0.0%     -0.0%      0.0%     -0.0%
           fibheaps          +0.0%      0.0%      0.0%     -0.0%     -0.0%
             fulsom          +0.0%      0.0%      0.0%     -0.6%     -0.0%
           gc_bench          +0.0%      0.0%      0.0%      0.0%     -0.0%
               hash          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
               lcss          +0.0%      0.0%      0.0%     -0.0%      0.0%
          mutstore1          +0.0%      0.0%      0.0%     -0.0%     -0.0%
          mutstore2          +0.0%      0.0%     +0.0%     -0.0%     -0.0%
              power          +0.0%      0.0%     -0.0%      0.0%     -0.0%
         spellcheck          +0.0%      0.0%     -0.0%     -0.0%     -0.0%
    --------------------------------------------------------------------------------
                Min          +0.0%      0.0%     -0.0%     -0.6%     -0.0%
                Max          +0.0%      0.0%     +0.0%      0.0%      0.0%
     Geometric Mean          +0.0%     +0.0%     +0.0%     -0.1%     +0.0%
    
    Fixes #14373
    
    These performance regressions appear to be a fluke in CI. See the
    discussion in !1742 for details.
    
    Metric Increase:
        T6048
        T12234
        T12425
        Naperian
        T12150
        T5837
        T13035
    14cb6472
  • Ömer Sinan Ağacan's avatar
    Refactor Compact.c: · 9b0348cf
    Ömer Sinan Ağacan authored
    - Remove forward declarations
    - Introduce UNTAG_PTR and GET_PTR_TAG for dealing with pointer tags
      without having to cast arguments to StgClosure*
    - Remove dead code
    - Use W_ instead of StgWord
    - Use P_ instead of StgPtr
    
    (cherry picked from commit b521e8b6)
    9b0348cf
  • Ömer Sinan Ağacan's avatar
    Fix compacting GC bug when chaining tagged and non-tagged fields together · 815ee4bc
    Ömer Sinan Ağacan authored
    Currently compacting GC has the invariant that in a chain all fields are tagged
    the same. However this does not really hold: root pointers are not tagged, so
    when we thread a root we initialize a chain without a tag. When the pointed
    objects is evaluated and we have more pointers to it from the heap, we then add
    *tagged* fields to the chain (because pointers to it from the heap are tagged),
    ending up chaining fields with different tags (pointers from roots are NOT
    tagged, pointers from heap are). This breaks the invariant and as a result
    compacting GC turns tagged pointers into non-tagged.
    
    This later causes problem in the generated code where we do reads assuming that
    the pointer is aligned, e.g.
    
        0x7(%rax) -- assumes that pointer is tagged 1
    
    which causes misaligned reads. This caused #17088.
    
    We fix this using the "pointer tagging for large families" patch (#14373,
    !1742):
    
    - With the pointer tagging patch the GC can know what the tagged pointer to a
      CONSTR should be (previously we'd need to know the family size -- large
      families are always tagged 1, small families are tagged depending on the
      constructor).
    
    - Since we now know what the tags should be we no longer need to store the
      pointer tag in the info table pointers when forming chains in the compacting
      GC.
    
    As a result we no longer need to tag pointers in chains with 1/2 depending on
    whether the field points to an info table pointer, or to another field: an info
    table pointer is always tagged 0, everything else in the chain is tagged 1. The
    lost tags in pointers can be retrieved by looking at the info table.
    
    Finally, instead of using tag 1 for fields and tag 0 for info table pointers, we
    use two different tags for fields:
    
    - 1 for fields that have untagged pointers
    - 2 for fields that have tagged pointers
    
    When unchaining we then look at the pointer to a field, and depending on its tag
    we either leave a tagged pointer or an untagged pointer in the field.
    
    This allows chaining untagged and tagged fields together in compacting GC.
    
    Fixes #17088
    815ee4bc
  • Ben Gamari's avatar
    base: Fix incorrect @since in GHC.Natural · 7e7e5a8e
    Ben Gamari authored
    Fixes #17547.
    7e7e5a8e
  • Ben Gamari's avatar
    Set RELEASE=NO · 23056422
    Ben Gamari authored
    23056422
  • Oleg Grenrus's avatar
    Add --show-unit-ids flag to ghc-pkg · 81b0d788
    Oleg Grenrus authored
    I only added it into --simple-output and ghc-pkg check output;
    there are probably other places where it can be adopted.
    81b0d788
  • Ben Gamari's avatar
    rel-notes: More fixes · 66b5fcd0
    Ben Gamari authored
    66b5fcd0
  • Ben Gamari's avatar
    02f97bc2
  • Oleg Grenrus's avatar
    Advance Cabal to 3.0.1.0-rc2 tag · d2bf5f48
    Oleg Grenrus authored
    d2bf5f48
  • Oleg Grenrus's avatar
    32059360
  • Ben Gamari's avatar
    relnotes: Fix typo · 92449b42
    Ben Gamari authored
    92449b42
  • Ben Gamari's avatar
    relnotes: More fixes · 28bfe664
    Ben Gamari authored
    28bfe664
  • Ben Gamari's avatar
    gitlab-ci: Explicitly set bindist tarball name · 80a5a6cd
    Ben Gamari authored
    This finishes the backport of 6764da43
    started in 7ccdb7de.
    
    (cherry picked from commit 6764da43)
    80a5a6cd
  • Daniel Gröber (dxld)'s avatar
    rts: Fix -hT option with profiling rts · ba8c86ed
    Daniel Gröber (dxld) authored
    In dumpCensus we switch/case on doHeapProfile twice. The second switch
    tries to barf on unknown doHeapProfile modes but HEAP_BY_CLOSURE_TYPE is
    checked by the first switch and not included in the second.
    
    So when trying to pass -hT to the profiling rts it barfs.
    
    This commit simply merges the two switches into one which fixes this
    problem.
    
    (cherry picked from commit ed662901)
    (cherry picked from commit bd46fbee)
    ba8c86ed
  • Szymon Nowicki-Korgol's avatar
  • Ben Gamari's avatar
    SysTools: Only apply Windows-specific workaround on Windows · b325d070
    Ben Gamari authored
    Issue #1110 was apparently due to a bug in Vista which prevented GCC
    from finding its binaries unless we explicitly added it to PATH.
    However, this workaround was incorrectly applied on non-Windows
    platforms as well, resulting in ill-formed PATHs (#17266).
    
    Fixes #17266.
    
    (cherry picked from commit 5fe49c6a)
    b325d070
  • Sergei Trofimovich's avatar
    configure.ac: fix '--disable-dwarf-debug' · dfc80021
    Sergei Trofimovich authored
    Before the change
        ./configure --disable-dwarf-debug
    enabled DWARF debugging unconditionally.
    
    This happened due to use of 5-argument form of `AC_ARG_ENABLE`
    without actually checking the passed  `$enableval` parameter:
    
    ```
    AC_ARG_ENABLE(dwarf-unwind,
        [AC_HELP_STRING([--enable-dwarf-unwind],
            [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])],
        [AC_CHECK_LIB(dw, dwfl_attach_state,
          [UseLibdw=YES],
          [AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)])])]
        [UseLibdw=NO]
    )
    ```
    
    Note:
    
    - `[UseLibdw=NO]` is called when `--{enable,disable}-dwarf-unwind`
      is not passed at all as a parameter (ok).
    - `[AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES],` is called
      for both:
    
      * `--enable-dwarf-unwind` being passed: `$enableval = "yes"` (ok).
      *  --disable-dwarf-unwind` being passed: `$enableval = "no"` (bad).
    
    The change is to use 3-argument `AC_ARG_ENABLE` and check for passed
    value as `"$enable_dwarf_unwind" = "yes"`.
    Signed-off-by: default avatarSergei Trofimovich <slyfox@gentoo.org>
    (cherry picked from commit cff44d86)
    dfc80021
  • Ben Gamari's avatar
    Bump version to 8.8.2 · 86f4a56c
    Ben Gamari authored
    86f4a56c
  • Abigail's avatar
    Make CorePrep.tryEtaReducePrep and CoreUtils.tryEtaReduce line up · 4d59e883
    Abigail authored
    Simon PJ says he prefers this fix to #17429 over banning eta-reduction
    for jumps entirely. Sure enough, this also works.
    
    Test case: simplCore/should_compile/T17429.hs
    
    (cherry picked from commit 61fe6c68)
    (cherry picked from commit 474a119c)
    4d59e883
  • Tamar Christina's avatar
    Fix overflow. · 8b193877
    Tamar Christina authored
    (cherry picked from commit 205d9065)
    8b193877
  • Ben Gamari's avatar
    TcIface: Fix inverted logic in typechecking of source ticks · 707ac619
    Ben Gamari authored
    Previously we would throw away source ticks when the debug level was
    non-zero. This is precisely the opposite of what was intended.
    
    Fixes #17616.
    
    Metric Decrease:
        T13056
        T9020
        T9961
        T12425
    
    (cherry picked from commit b55dfa3f)
    707ac619
  • Ben Gamari's avatar
    Remove GHC_STAGE guards from MachDeps · 0c81de31
    Ben Gamari authored
    This allows the stage1 compiler (which needs to run on the build
    platform and produce code for the host) to depend upon properties of the
    target. This is wrong. However, it's no more wrong than it was
    previously and @Erichson2314 is working on fixing this so I'm going to
    remove the guard so we can finally bootstrap HEAD with ghc-8.8 (see
    issue #17146).
    
    (cherry picked from commit 5f2c49d8)
    0c81de31
  • Ben Gamari's avatar
    Set RELEASE=NO · 77f1d11a
    Ben Gamari authored
    77f1d11a
  • cgibbard's avatar
    Refactor the MatchResult type in the desugarer so that it does a better job of... · 9f373a1e
    cgibbard authored
    Refactor the MatchResult type in the desugarer so that it does a better job of proving whether or not the fail operator is used.
    
    (cherry picked from commit 2e6155e1)
    (cherry picked from commit 51eb739f)
    9f373a1e
  • John Ericson's avatar
    Deduplicate copied monad failure handler code · 6ae3069b
    John Ericson authored
    (cherry picked from commit 63053481)
    (cherry picked from commit 301bdd23)
    6ae3069b
  • John Ericson's avatar
    Get rid of failure · 29161a16
    John Ericson authored
    (cherry picked from commit 333a855f)
    (cherry picked from commit f6f03d94)
    29161a16
  • cgibbard's avatar
    Change the fail operator argument of BindStmt to be a Maybe · 81f19b05
    cgibbard authored
    Don't use noSyntaxExpr for it. There is no good way to defensively case
    on that, nor is it clear one ought to do so.
    
    (cherry picked from commit 5db93f50)
    (cherry picked from commit c2f76b5f)
    81f19b05
  • John Ericson's avatar
    Use trees that grow for rebindable operators for `<-` binds · 45a9da74
    John Ericson authored
    Also add more documentation.
    
    (cherry picked from commit 6191c6b1)
    (cherry picked from commit 6fce273c)
    45a9da74
  • John Ericson's avatar
    Merge branch 'cg-je-match-result-refactor' into HEAD · 12156d67
    John Ericson authored
    (cherry picked from commit e396f67f)
    (cherry picked from commit 34c71c24)
    12156d67
  • cgibbard's avatar
    Add a new default language extension FallibleDo which when disabled allows the... · c186dc9e
    cgibbard authored
    Add a new default language extension FallibleDo which when disabled allows the syntax translation in terms of MonadFail to be disabled altogether, handling failed patterns with calls to error instead.
    
    (cherry picked from commit ebf6b7b6)
    (cherry picked from commit da4305c3)
    c186dc9e
  • cgibbard's avatar
    Add FallibleDo to list of extensions expected in GHC and not Cabal (for now). · 94aecf71
    cgibbard authored
    (cherry picked from commit 4662f99f)
    (cherry picked from commit 715fb88c)
    94aecf71
  • Jonathan DK Gibbons's avatar
......@@ -100,11 +100,7 @@ lint-submods-mr:
tags:
- lint
script:
- |
grep TBA libraries/*/changelog.md && (
echo "Error: Found \"TBA\"s in changelogs."
exit 1
)
- bash .gitlab/linters/check-changelogs.sh
lint-changelogs:
extends: .lint-changelogs
......
#!/usr/bin/env bash
set -e
COLOR_RED="\e[31m"
COLOR_GREEN="\e[32m"
COLOR_NONE="\e[0m"
grep TBA libraries/*/changelog.md && (
echo -e "${COLOR_RED}Error: Found \"TBA\"s in changelogs.${COLOR_NONE}"
exit 1
)
echo -e "${COLOR_GREEN}changelogs look okay.${COLOR_NONE}"
......@@ -985,8 +985,11 @@ else
fi;
changequote([, ])dnl
])
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[3.1.7],
[AC_MSG_ERROR([Alex version 3.1.7 or later is required to compile GHC.])])[]
if test ! -f compiler/parser/Lexer.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[3.1.7],
[AC_MSG_ERROR([Alex version 3.1.7 or later is required to compile GHC.])])[]
fi
AlexVersion=$fptools_cv_alex_version;
AC_SUBST(AlexVersion)
])
......@@ -2129,7 +2132,8 @@ AC_DEFUN([XCODE_VERSION],[
# FIND_LLVM_PROG()
# --------------------------------
# Find where the llvm tools are. We have a special function to handle when they
# are installed with a version suffix (e.g., llc-3.1).
# are installed with a version suffix (e.g., llc-7, llc-7.0) and without (e.g.
# llc).
#
# $1 = the variable to set
# $2 = the command to look for
......@@ -2137,7 +2141,7 @@ AC_DEFUN([XCODE_VERSION],[
#
AC_DEFUN([FIND_LLVM_PROG],[
# Test for program with and without version name.
AC_CHECK_TOOLS([$1], [$2-$3 $2], [:])
AC_CHECK_TOOLS([$1], [$2-$3 $2-$3.0 $2], [:])
if test "$$1" != ":"; then
AC_MSG_CHECKING([$$1 is version $3])
if test `$$1 --version | grep -c "version $3"` -gt 0 ; then
......
......@@ -151,7 +151,7 @@ flattenCmmAGraph id (stmts_t, tscope) =
catAGraphs :: [CmmAGraph] -> CmmAGraph
catAGraphs = concatOL
-- | created a sequence "goto id; id:" as an AGraph
-- | creates a sequence "goto id; id:" as an AGraph
mkLabel :: BlockId -> CmmTickScope -> CmmAGraph
mkLabel bid scp = unitOL (CgLabel bid scp)
......@@ -159,7 +159,7 @@ mkLabel bid scp = unitOL (CgLabel bid scp)
mkMiddle :: CmmNode O O -> CmmAGraph
mkMiddle middle = unitOL (CgStmt middle)
-- | created a closed AGraph from a given node
-- | creates a closed AGraph from a given node
mkLast :: CmmNode O C -> CmmAGraph
mkLast last = unitOL (CgLast last)
......
......@@ -355,20 +355,19 @@ type DynTag = Int -- The tag on a *pointer*
-- * big, otherwise.
--
-- Small families can have the constructor tag in the tag bits.
-- Big families only use the tag value 1 to represent evaluatedness.
-- Big families always use the tag values 1..mAX_PTR_TAG to represent
-- evaluatedness, the last one lumping together all overflowing ones.
-- We don't have very many tag bits: for example, we have 2 bits on
-- x86-32 and 3 bits on x86-64.
--
-- Also see Note [Tagging big families] in GHC.StgToCmm.Expr
isSmallFamily :: DynFlags -> Int -> Bool
isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
tagForCon :: DynFlags -> DataCon -> DynTag
tagForCon dflags con
| isSmallFamily dflags fam_size = con_tag
| otherwise = 1
where
con_tag = dataConTag con -- NB: 1-indexed
fam_size = tyConFamilySize (dataConTyCon con)
tagForCon dflags con = min (dataConTag con) (mAX_PTR_TAG dflags)
-- NB: 1-indexed
tagForArity :: DynFlags -> RepArity -> DynTag
tagForArity dflags arity
......
This diff is collapsed.
......@@ -1141,6 +1141,7 @@ and now we do NOT want eta expansion to give
Instead CoreArity.etaExpand gives
f = /\a -> \y -> let s = h 3 in g s y
-}
cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs
......@@ -1161,6 +1162,8 @@ get to a partial application:
==> case x of { p -> map f }
-}
-- When updating this function, make sure it lines up with
-- CoreUtils.tryEtaReduce!
tryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr
tryEtaReducePrep bndrs expr@(App _ _)
| ok_to_eta_reduce f
......@@ -1180,25 +1183,14 @@ tryEtaReducePrep bndrs expr@(App _ _)
ok bndr (Var arg) = bndr == arg
ok _ _ = False
-- We can't eta reduce something which must be saturated.
-- We can't eta reduce something which must be saturated.
ok_to_eta_reduce (Var f) = not (hasNoBinding f)
ok_to_eta_reduce _ = False -- Safe. ToDo: generalise
tryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)
| not (any (`elemVarSet` fvs) bndrs)
= case tryEtaReducePrep bndrs body of
Just e -> Just (Let bind e)
Nothing -> Nothing
where
fvs = exprFreeVars r
-- NB: do not attempt to eta-reduce across ticks
-- Otherwise we risk reducing
-- \x. (Tick (Breakpoint {x}) f x)
-- ==> Tick (breakpoint {x}) f
-- which is bogus (Trac #17228)
-- tryEtaReducePrep bndrs (Tick tickish e)
-- = fmap (mkTick tickish) $ tryEtaReducePrep bndrs e
tryEtaReducePrep bndrs (Tick tickish e)
| tickishFloatable tickish
= fmap (mkTick tickish) $ tryEtaReducePrep bndrs e
tryEtaReducePrep _ _ = Nothing
......
......@@ -2338,6 +2338,8 @@ But the simplifier pushes those casts outwards, so we don't
need to address that here.
-}
-- When updating this function, make sure to update
-- CorePrep.tryEtaReducePrep as well!
tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr
tryEtaReduce bndrs body
= go (reverse bndrs) body (mkRepReflCo (exprType body))
......
......@@ -5,6 +5,7 @@ Pattern Matching Coverage Checking.
-}
{-# LANGUAGE CPP, GADTs, DataKinds, KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
......@@ -51,8 +52,9 @@ import TyCoRep
import Type
import UniqSupply
import DsUtils (isTrueLHsExpr)
import Maybes (expectJust)
import qualified GHC.LanguageExtensions as LangExt
import EnumSet (EnumSet)
import qualified EnumSet as EnumSet
import Data.List (find)
import Data.Maybe (catMaybes, isJust, fromMaybe)
......@@ -834,7 +836,7 @@ inhabitationCandidates ty_cs ty = do
alts_to_check :: Type -> Type -> [DataCon]
-> PmM (Either Type (TyCon, [InhabitationCandidate]))
alts_to_check src_ty core_ty dcs = case splitTyConApp_maybe core_ty of
Just (tc, _)
Just (tc, tc_args)
| tc `elem` trivially_inhabited
-> case dcs of
[] -> return (Left src_ty)
......@@ -850,7 +852,7 @@ inhabitationCandidates ty_cs ty = do
-- them extremely misleading.
-> liftD $ do
var <- mkPmId core_ty -- it would be wrong to unify x
alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc)
alts <- mapM (mkOneConFull var tc_args . RealDataCon) (tyConDataCons tc)
return $ Right
(tc, [ alt{ic_val_abs = build_tm (ic_val_abs alt) dcs}
| alt <- alts ])
......@@ -1302,7 +1304,7 @@ translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM PatVec
translateGuard fam_insts guard = case guard of
BodyStmt _ e _ _ -> translateBoolGuard e
LetStmt _ binds -> translateLet (unLoc binds)
BindStmt _ p e _ _ -> translateBind fam_insts p e
BindStmt _ p e -> translateBind fam_insts p e
LastStmt {} -> panic "translateGuard LastStmt"
ParStmt {} -> panic "translateGuard ParStmt"
TransStmt {} -> panic "translateGuard TransStmt"
......@@ -1610,37 +1612,31 @@ instance Outputable InhabitationCandidate where
-- | Generate an 'InhabitationCandidate' for a given conlike (generate
-- fresh variables of the appropriate type for arguments)
mkOneConFull :: Id -> ConLike -> DsM InhabitationCandidate
-- * x :: T tys, where T is an algebraic data type
-- NB: in the case of a data family, T is the *representation* TyCon
-- e.g. data instance T (a,b) = T1 a b
-- leads to
-- data TPair a b = T1 a b -- The "representation" type
-- It is TPair, not T, that is given to mkOneConFull
mkOneConFull :: Id -> [Type] -> ConLike -> DsM InhabitationCandidate
-- * 'con' K is a conlike of algebraic data type 'T tys'
-- * 'tc_args' are the type arguments of the 'con's TyCon T
--
-- * 'con' K is a conlike of data type T
-- * 'x' is the variable for which we encode an equality constraint
-- in the term oracle
--
-- After instantiating the universal tyvars of K we get
-- K tys :: forall bs. Q => s1 .. sn -> T tys
-- After instantiating the universal tyvars of K to tc_args we get
-- K @tys :: forall bs. Q => s1 .. sn -> T tys
--
-- Suppose y1 is a strict field. Then we get
-- Results: ic_val_abs: K (y1::s1) .. (yn::sn)
-- ic_tm_ct: x ~ K y1..yn
-- ic_ty_cs: Q
-- ic_strict_arg_tys: [s1]
mkOneConFull x con = do
let res_ty = idType x
(univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, con_res_ty)
mkOneConFull x tc_args con = do
let (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, _con_res_ty)
= conLikeFullSig con
arg_is_banged = map isBanged $ conLikeImplBangs con
tc_args = tyConAppArgs res_ty
subst1 = case con of
RealDataCon {} -> zipTvSubst univ_tvs tc_args
PatSynCon {} -> expectJust "mkOneConFull" (tcMatchTy con_res_ty res_ty)
-- See Note [Pattern synonym result type] in PatSyn
subst1 = zipTvSubst univ_tvs tc_args
(subst, ex_tvs') <- cloneTyVarBndrs subst1 ex_tvs <$> getUniqueSupplyM
-- Field types
let arg_tys' = substTys subst arg_tys
-- Fresh term variables (VAs) as arguments to the constructor
arguments <- mapM mkPmVar arg_tys'
......@@ -2068,7 +2064,7 @@ pmcheckHd (p@(PmCon { pm_con_con = con, pm_con_arg_tys = tys }))
(PmVar x) (ValVec vva delta) = do
(prov, complete_match) <- select =<< liftD (allCompleteMatches con tys)
cons_cs <- mapM (liftD . mkOneConFull x) complete_match
cons_cs <- mapM (liftD . mkOneConFull x tys) complete_match
inst_vsa <- flip mapMaybeM cons_cs $
\InhabitationCandidate{ ic_val_abs = va, ic_tm_ct = tm_ct
......@@ -2165,11 +2161,11 @@ Where:
u_1, ..., u_p are the universally quantified type variables.
In the ConVar case, the coverage algorithm will have in hand the constructor
K as well as a pattern variable (pv :: T PV_1 ... PV_p), where PV_1, ..., PV_p
are some types that instantiate u_1, ... u_p. The idea is that we should
substitute PV_1 for u_1, ..., and PV_p for u_p when forming a PmCon (the
mkOneConFull function accomplishes this) and then hand this PmCon off to the
ConCon case.
K as well as a list of type arguments [t_1, ..., t_n] to substitute T's
universally quantified type variables u_1, ..., u_n for. It's crucial to take
these in as arguments, as it is non-trivial to derive them just from the result
type of a pattern synonym and the ambient type of the match (#11336, #17112).
The type checker already did the hard work, so we should just make use of it.
The presence of existentially quantified type variables adds a significant
wrinkle. We always grab e_1, ..., e_m from the definition of K to begin with,
......@@ -2488,7 +2484,7 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
flag_i = wopt Opt_WarnOverlappingPatterns dflags
flag_u = exhaustive dflags kind
flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind)
flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag (extensionFlags dflags) kind)
is_rec_upd = case kind of { RecUpd -> True; _ -> False }
-- See Note [Inaccessible warnings for record updates]
......@@ -2561,27 +2557,33 @@ dots maxPatterns qs
-- | Check whether the exhaustiveness checker should run (exhaustiveness only)
exhaustive :: DynFlags -> HsMatchContext id -> Bool
exhaustive dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag
exhaustive dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag (extensionFlags dflags)
-- | Denotes whether an exhaustiveness check is supported, and if so,
-- via which 'WarningFlag' it's controlled.
-- Returns 'Nothing' if check is not supported.
exhaustiveWarningFlag :: HsMatchContext id -> Maybe WarningFlag
exhaustiveWarningFlag (FunRhs {}) = Just Opt_WarnIncompletePatterns
exhaustiveWarningFlag CaseAlt = Just Opt_WarnIncompletePatterns
exhaustiveWarningFlag IfAlt = Just Opt_WarnIncompletePatterns
exhaustiveWarningFlag LambdaExpr = Just Opt_WarnIncompleteUniPatterns
exhaustiveWarningFlag PatBindRhs = Just Opt_WarnIncompleteUniPatterns
exhaustiveWarningFlag PatBindGuards = Just Opt_WarnIncompletePatterns
exhaustiveWarningFlag ProcExpr = Just Opt_WarnIncompleteUniPatterns
exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd
exhaustiveWarningFlag ThPatSplice = Nothing
exhaustiveWarningFlag PatSyn = Nothing
exhaustiveWarningFlag ThPatQuote = Nothing
exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete patterns
-- in list comprehensions, pattern guards
-- etc. They are often *supposed* to be
-- incomplete
exhaustiveWarningFlag :: EnumSet LangExt.Extension -> HsMatchContext id -> Maybe WarningFlag
exhaustiveWarningFlag exts = \case
(FunRhs {}) -> Just Opt_WarnIncompletePatterns
CaseAlt -> Just Opt_WarnIncompletePatterns
IfAlt -> Just Opt_WarnIncompletePatterns
LambdaExpr -> Just Opt_WarnIncompleteUniPatterns
PatBindRhs -> Just Opt_WarnIncompleteUniPatterns
PatBindGuards -> Just Opt_WarnIncompletePatterns
ProcExpr -> Just Opt_WarnIncompleteUniPatterns
RecUpd -> Just Opt_WarnIncompletePatternsRecUpd
ThPatSplice -> Nothing
PatSyn -> Nothing
ThPatQuote -> Nothing
(StmtCtxt DoExpr) | not (EnumSet.member LangExt.FallibleDo exts) ->
Just Opt_WarnIncompleteUniPatterns
(StmtCtxt MDoExpr) | not (EnumSet.member LangExt.FallibleDo exts) ->
Just Opt_WarnIncompleteUniPatterns
(StmtCtxt {}) -> Nothing
-- Don't warn about incomplete patterns
-- in list comprehensions, pattern guards
-- etc. They are often *supposed* to be
-- incomplete
-- True <==> singular
pp_context :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc
......
......@@ -711,12 +711,12 @@ addTickStmt _isGuard (LastStmt x e noret ret) = do
(addTickLHsExpr e)
(pure noret)
(addTickSyntaxExpr hpcSrcSpan ret)
addTickStmt _isGuard (BindStmt x pat e bind fail) = do
liftM4 (BindStmt x)
addTickStmt _isGuard (BindStmt (bind, ty, fail) pat e) = do
liftM4 (\b f -> BindStmt (b, ty, f))
(addTickSyntaxExpr hpcSrcSpan bind)
(mapM (addTickSyntaxExpr hpcSrcSpan) fail)
(addTickLPat pat)
(addTickLHsExprRHS e)
(addTickSyntaxExpr hpcSrcSpan bind)
(addTickSyntaxExpr hpcSrcSpan fail)
addTickStmt isGuard (BodyStmt x e bind' guard') = do
liftM3 (BodyStmt x)
(addTick isGuard e)
......@@ -950,12 +950,10 @@ addTickLCmdStmts' lstmts res
binders = collectLStmtsBinders lstmts
addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
addTickCmdStmt (BindStmt x pat c bind fail) = do
liftM4 (BindStmt x)
addTickCmdStmt (BindStmt x pat c) = do
liftM2 (BindStmt x)
(addTickLPat pat)
(addTickLHsCmd c)
(return bind)
(return fail)
addTickCmdStmt (LastStmt x c noret ret) = do
liftM3 (LastStmt x)
(addTickLHsCmd c)
......
......@@ -868,7 +868,7 @@ dsCmdStmt ids local_vars out_ids (BodyStmt c_ty cmd _ _) env_ids = do
-- It would be simpler and more consistent to do this using second,
-- but that's likely to be defined in terms of first.
dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd _ _) env_ids = do
dsCmdStmt ids local_vars out_ids (BindStmt _ pat cmd) env_ids = do
let pat_ty = hsLPatType pat
(core_cmd, fv_cmd, env_ids1) <- dsfixCmd ids local_vars unitTy pat_ty cmd
let pat_vars = mkVarSet (collectPatBinders pat)
......
......@@ -11,7 +11,8 @@ Desugaring expressions.
{-# LANGUAGE ViewPatterns #-}
module DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds
, dsValBinds, dsLit, dsSyntaxExpr ) where
, dsValBinds, dsLit, dsSyntaxExpr
, dsHandleMonadicFailure ) where
#include "HsVersions.h"
......@@ -60,7 +61,7 @@ import Util
import Bag
import Outputable
import PatSyn
import qualified GHC.LanguageExtensions.Type as LangExt
import Control.Monad
{-
......@@ -915,13 +916,13 @@ dsDo stmts
= do { rest <- goL stmts
; dsLocalBinds binds rest }
go _ (BindStmt res1_ty pat rhs bind_op fail_op) stmts
go loc (BindStmt (bind_op, res1_ty, fail_op) pat rhs) stmts
= do { body <- goL stmts
; rhs' <- dsLExpr rhs
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
res1_ty (cantFailMatchResult body)
; match_code <- handle_failure pat match fail_op
; match_code <- dsHandleMonadicFailure res1_ty (L loc pat) match fail_op
; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
go _ (ApplicativeStmt body_ty args mb_join) stmts
......@@ -963,9 +964,13 @@ dsDo stmts
, recS_ret_ty = body_ty} }) stmts
= goL (new_bind_stmt : stmts) -- rec_ids can be empty; eg rec { print 'x' }
where
new_bind_stmt = cL loc $ BindStmt bind_ty (mkBigLHsPatTupId later_pats)
mfix_app bind_op
noSyntaxExpr -- Tuple cannot fail
new_bind_stmt = cL loc $ BindStmt
( bind_op
, bind_ty
, Nothing -- Tuple cannot fail
)
(mkBigLHsPatTupId later_pats)
mfix_app
tup_ids = rec_ids ++ filterOut (`elem` rec_ids) later_ids
tup_ty = mkBigCoreTupTy (map idType tup_ids) -- Deals with singleton case
......@@ -992,19 +997,29 @@ dsDo stmts
go _ (TransStmt {}) _ = panic "dsDo TransStmt"
go _ (XStmtLR {}) _ = panic "dsDo XStmtLR"
handle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr
dsHandleMonadicFailure :: Type -> Located (LPat GhcTc) -> MatchResult -> Maybe (SyntaxExpr GhcTc) -> DsM CoreExpr
-- In a do expression, pattern-match failure just calls
-- the monadic 'fail' rather than throwing an exception
handle_failure pat match fail_op
| matchCanFail match
= do { dflags <- getDynFlags
; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)
; fail_expr <- dsSyntaxExpr fail_op [fail_msg]
; extractMatchResult match fail_expr }
| otherwise
= extractMatchResult match (error "It can't fail")
mk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String
dsHandleMonadicFailure ty pat match m_fail_op =
case shareFailureHandler match of
MatchResult_Unfailable body -> body
MatchResult_Failable body -> do
dflags <- getDynFlags
fail_expr <- case m_fail_op of
-- Note that (non-monadic) list comprehension, pattern guards, etc could
-- have fallible bindings without either an explicit failure or
-- `-XNoFallibleDo`, but this is handled elsewhere. See Note [Failing
-- pattern matches in Stmts] the breakdown of regular and special binds.
Nothing -> do
let xNoFallibleDo = not $ xopt LangExt.FallibleDo dflags
MASSERT2(xNoFallibleDo, text "Pattern match:" <+> ppr pat <+> text "is failable, and fail_expr was left unset")
mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString (StmtCtxt (DoExpr :: HsStmtContext Name)))
Just fail_op -> do
fail_msg <- mkStringExpr (mk_fail_msg dflags pat)
dsSyntaxExpr fail_op [fail_msg]
body fail_expr
mk_fail_msg :: DynFlags -> Located e -> String
mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++
showPpr dflags (getLoc pat)
......
module DsExpr where
import HsSyn ( HsExpr, LHsExpr, LHsLocalBinds, SyntaxExpr )
import DsMonad ( DsM )
import GhcPrelude ( Maybe )
import HsSyn ( HsExpr, LHsExpr, LHsLocalBinds, LPat, SyntaxExpr )
import TcType ( Type )
import DsMonad ( DsM, MatchResult )
import CoreSyn ( CoreExpr )
import HsExtension ( GhcTc)
import SrcLoc (Located)
dsExpr :: HsExpr GhcTc -> DsM CoreExpr
dsLExpr, dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
dsLocalBinds :: LHsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
dsHandleMonadicFailure :: Type -> Located (LPat GhcTc) -> MatchResult -> Maybe (SyntaxExpr GhcTc) -> DsM CoreExpr
......@@ -118,7 +118,7 @@ matchGuards (LetStmt _ binds : stmts) ctx rhs rhs_ty = do
-- so we can't desugar the bindings without the
-- body expression in hand
matchGuards (BindStmt _ pat bind_rhs _ _ : stmts) ctx rhs rhs_ty = do
matchGuards (BindStmt _ pat bind_rhs : stmts) ctx rhs rhs_ty = do
let upat = unLoc pat
dicts = collectEvVarsPat upat
match_var <- selectMatchVar upat
......
......@@ -16,7 +16,7 @@ module DsListComp ( dsListComp, dsMonadComp ) where
import GhcPrelude
import {-# SOURCE #-} DsExpr ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds, dsSyntaxExpr )
import {-# SOURCE #-} DsExpr ( dsHandleMonadicFailure, dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds, dsSyntaxExpr )
import HsSyn
import TcHsSyn
......@@ -242,7 +242,7 @@ deListComp (stmt@(TransStmt {}) : quals) list = do
(inner_list_expr, pat) <- dsTransStmt stmt
deBindComp pat inner_list_expr quals list
deListComp (BindStmt _ pat list1 _ _ : quals) core_list2 = do -- rule A' above
deListComp (BindStmt _ pat list1 : quals) core_list2 = do -- rule A' above
core_list1 <- dsLExprNoLP list1
deBindComp pat core_list1 quals core_list2
......@@ -353,7 +353,7 @@ dfListComp c_id n_id (stmt@(TransStmt {}) : quals) = do
-- Anyway, we bind the newly grouped list via the generic binding function
dfBindComp c_id n_id (pat, inner_list_expr) quals
dfListComp c_id n_id (BindStmt _ pat list1 _ _ : quals) = do
dfListComp c_id n_id (BindStmt _ pat list1 : quals) = do
-- evaluate the two lists
core_list1 <- dsLExpr list1
......@@ -485,31 +485,31 @@ dsMonadComp stmts = dsMcStmts stmts
dsMcStmts :: [ExprLStmt GhcTc] -> DsM CoreExpr
dsMcStmts [] = panic "dsMcStmts"
dsMcStmts ((dL->L loc stmt) : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts)
dsMcStmts ((dL->L loc stmt) : lstmts) = putSrcSpanDs loc (dsMcStmt stmt lstmts loc)
---------------
dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> DsM CoreExpr
dsMcStmt :: ExprStmt GhcTc -> [ExprLStmt GhcTc] -> SrcSpan -> DsM CoreExpr
dsMcStmt (LastStmt _ body _ ret_op) stmts
dsMcStmt (LastStmt _ body _ ret_op) stmts _
= ASSERT( null stmts )
do { body' <- dsLExpr body
; dsSyntaxExpr ret_op [body'] }
-- [ .. | let binds, stmts ]
dsMcStmt (LetStmt _ binds) stmts
dsMcStmt (LetStmt _ binds) stmts _
= do { rest <- dsMcStmts stmts
; dsLocalBinds binds rest }
-- [ .. | a <- m, stmts ]
dsMcStmt (BindStmt bind_ty pat rhs bind_op fail_op) stmts
dsMcStmt (BindStmt (bind_op, bind_ty, fail_op) pat rhs) stmts span
= do { rhs' <- dsLExpr rhs
; dsMcBindStmt pat rhs' bind_op fail_op bind_ty stmts }
; dsMcBindStmt pat rhs' bind_op fail_op bind_ty stmts span }
-- Apply `guard` to the `exp` expression
--
-- [ .. | exp, stmts ]
--
dsMcStmt (BodyStmt _ exp then_exp guard_exp) stmts
dsMcStmt (BodyStmt _ exp then_exp guard_exp) stmts _
= do { exp' <- dsLExpr exp
; rest <- dsMcStmts stmts
; guard_exp' <- dsSyntaxExpr guard_exp [exp']
......@@ -533,7 +533,7 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs
, trS_by = by, trS_using = using
, trS_ret = return_op, trS_bind = bind_op
, trS_ext = n_tup_ty' -- n (a,b,c)
, trS_fmap = fmap_op, trS_form = form }) stmts_rest
, trS_fmap = fmap_op, trS_form = form }) stmts_rest _
= do { let (from_bndrs, to_bndrs) = unzip bndrs
; let from_bndr_tys = map idType from_bndrs -- Types ty
......@@ -577,7 +577,7 @@ dsMcStmt (TransStmt { trS_stmts = stmts, trS_bndrs = bndrs
-- mzip :: forall a b. m a -> m b -> m (a,b)
-- NB: we need a polymorphic mzip because we call it several times
dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest span
= do { exps_w_tys <- mapM ds_inner blocks -- Pairs (exp :: m ty, ty)
; mzip_op' <- dsExpr mzip_op
......@@ -591,14 +591,14 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
mkBoxedTupleTy [t1,t2]))
exps_w_tys
; dsMcBindStmt pat rhs bind_op noSyntaxExpr bind_ty stmts_rest }
; dsMcBindStmt pat rhs bind_op Nothing bind_ty stmts_rest span }
where
ds_inner (ParStmtBlock _ stmts bndrs return_op)
= do { exp <- dsInnerMonadComp stmts bndrs return_op
; return (exp, mkBigCoreVarTupTy bndrs) }
ds_inner (XParStmtBlock{}) = panic "dsMcStmt"
dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
dsMcStmt stmt _ _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr
......@@ -615,35 +615,19 @@ matchTuple ids body
dsMcBindStmt :: LPat GhcTc
-> CoreExpr -- ^ the desugared rhs of the bind statement
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Maybe (SyntaxExpr GhcTc)
-> Type -- ^ S in (>>=) :: Q -> (R -> S) -> T
-> [ExprLStmt GhcTc]
-> SrcSpan
-> DsM CoreExpr
dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts span
= do { body <- dsMcStmts stmts
; var <- selectSimpleMatchVarL pat
; match <- matchSinglePatVar var (StmtCtxt DoExpr) pat
res1_ty (cantFailMatchResult body)
; match_code <- handle_failure pat match fail_op
; match_code <- dsHandleMonadicFailure res1_ty (L span pat) match fail_op
; dsSyntaxExpr bind_op [rhs', Lam var match_code] }
where
-- In a monad comprehension expression, pattern-match failure just calls
-- the monadic `fail` rather than throwing an exception
handle_failure pat match fail_op
| matchCanFail match
= do { dflags <- getDynFlags
; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)
; fail_expr <- dsSyntaxExpr fail_op [fail_msg]
; extractMatchResult match fail_expr }
| otherwise
= extractMatchResult match (error "It can't fail")
mk_fail_msg :: HasSrcSpan e => DynFlags -> e -> String
mk_fail_msg dflags pat
= "Pattern match failure in monad comprehension at " ++
showPpr dflags (getLoc pat)
-- Desugar nested monad comprehensions, for example in `then..` constructs
-- dsInnerMonadComp quals [a,b,c] ret_op
-- returns the desugaring of
......
......@@ -1519,7 +1519,7 @@ repLSts :: [LStmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
repLSts stmts = repSts (map unLoc stmts)
repSts :: [Stmt GhcRn (LHsExpr GhcRn)] -> DsM ([GenSymBind], [Core TH.StmtQ])
repSts (BindStmt _ p e _ _ : ss) =
repSts (BindStmt _ p e : ss) =
do { e2 <- repLE e
; ss1 <- mkGenSyms (collectPatBinders p)
; addBinds ss1 $ do {
......
......@@ -6,10 +6,14 @@
@DsMonad@: monadery used in desugaring
-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan
module DsMonad (
DsM, mapM, mapAndUnzipM,
initDs, initDsTc, initTcDsForSolver, initDsWithModGuts, fixDs,
......@@ -42,8 +46,7 @@ module DsMonad (
-- Data types
DsMatchContext(..),
EquationInfo(..), MatchResult(..), DsWrapper, idDsWrapper,
CanItFail(..), orFail,
EquationInfo(..), MatchResult'(..), MatchResult, runMatchResult, DsWrapper, idDsWrapper,
-- Levity polymorphism
dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,
......@@ -135,21 +138,28 @@ idDsWrapper e = e
-- \fail. wrap (case vs of { pats -> rhs fail })
-- where vs are not bound by wrap
-- A MatchResult is an expression with a hole in it
data MatchResult
= MatchResult
CanItFail -- Tells whether the failure expression is used
(CoreExpr -> DsM CoreExpr)
-- Takes a expression to plug in at the
-- failure point(s). The expression should
-- be duplicatable!
data CanItFail = CanFail | CantFail
orFail :: CanItFail -> CanItFail -> CanItFail
orFail CantFail CantFail = CantFail
orFail _ _ = CanFail
-- This is a value of type a with potentially a CoreExpr-shaped hole in it. We explicitly represent
-- the case where there is no hole. This is used to deal with cases where we are potentially handling
-- pattern match failure, and want to later specify how failure is handled.
data MatchResult' a
= MatchResult_Unfailable (DsM a)
| MatchResult_Failable (CoreExpr -> DsM a)
deriving (Functor)
instance Applicative MatchResult' where
pure v = MatchResult_Unfailable (pure v)
MatchResult_Unfailable f <*> MatchResult_Unfailable x = MatchResult_Unfailable (f <*> x)
f <*> x = MatchResult_Failable $ \fail -> runMatchResult fail f <*> runMatchResult fail x
-- This is a CoreExpr with potentially a CoreExpr hole in it, which is the most common case.
type MatchResult = MatchResult' CoreExpr
-- Given a fail expression to use, and a MatchResult, compute the filled CoreExpr whether
-- the MatchResult was failable or not.
runMatchResult :: CoreExpr -> MatchResult' a -> DsM a
runMatchResult fail = \case
MatchResult_Unfailable body -> body
MatchResult_Failable body_fn -> body_fn fail
{-
************************************************************************
......
This diff is collapsed.
......@@ -234,7 +234,7 @@ match vars@(v:_) ty eqns -- Eqns *can* be empty
matchEmpty :: MatchId -> Type -> DsM [MatchResult]
-- See Note [Empty case expressions]
matchEmpty var res_ty
= return [MatchResult CanFail mk_seq]
= return [MatchResult_Failable mk_seq]
where
mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
[(DEFAULT, [], fail)]
......
......@@ -765,7 +765,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
then parens (text "already monomorphic: " <> ppr my_ty)
else Ppr.empty)
Right dcname <- liftIO $ constrClosToName hsc_env clos
(_,mb_dc) <- tryTc (tcLookupDataCon dcname)
(mb_dc, _) <- tryTc (tcLookupDataCon dcname)
case mb_dc of
Nothing -> do -- This can happen for private constructors compiled -O0
-- where the .hi descriptor does not export them
......@@ -981,7 +981,7 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
ConstrClosure{ptrArgs=pArgs} -> do
Right dcname <- liftIO $ constrClosToName hsc_env clos
traceTR (text "Constr1" <+> ppr dcname)
(_,mb_dc) <- tryTc (tcLookupDataCon dcname)
(mb_dc, _) <- tryTc (tcLookupDataCon dcname)
case mb_dc of
Nothing-> do
forM pArgs $ \x -> do
......
......@@ -913,7 +913,7 @@ instance ( a ~ GhcPass p
LastStmt _ body _ _ ->
[ toHie body
]
BindStmt _ pat body _ _ ->
BindStmt _ pat body ->
[ toHie $ PS (getRealSpan $ getLoc body) scope NoScope pat
, toHie body
]
......
......@@ -1106,7 +1106,7 @@ cvtStmts = mapM cvtStmt
cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
cvtStmt (NoBindS e) = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkPsBindStmt p' e' }
cvtStmt (TH.LetS ds) = do { ds' <- cvtLocalDecs (text "a let binding") ds
; returnL $ LetStmt noExt (noLoc ds') }
cvtStmt (TH.ParS dss) = do { dss' <- mapM cvt_one dss
......
......@@ -1870,15 +1870,14 @@ data StmtLR idL idR body -- body should always be (LHs**** idR)
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow'
-- For details on above see note [Api annotations] in ApiAnnotation
| BindStmt (XBindStmt idL idR body) -- Post typechecking,
-- result type of the function passed to bind;
-- that is, S in (>>=) :: Q -> (R -> S) -> T
| BindStmt (XBindStmt idL idR body)
-- ^ Post renaming has optional fail and bind / (>>=) operator.
-- Post typechecking, also has result type of the
-- function passed to bind; that is, S in (>>=)
-- :: Q -> (R -> S) -> T
-- See Note [The type of bind in Stmts]
(LPat idL)
body
(SyntaxExpr idR) -- The (>>=) operator; see Note [The type of bind in Stmts]
(SyntaxExpr idR) -- The fail operator
-- The fail operator is noSyntaxExpr
-- if the pattern match can't fail
-- | 'ApplicativeStmt' represents an applicative expression built with
-- '<$>' and '<*>'. It is generated by the renamer, and is desugared into the
......@@ -1991,8 +1990,8 @@ data RecStmtTc =
type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExt
type instance XBindStmt (GhcPass _) GhcPs b = NoExt
type instance XBindStmt (GhcPass _) GhcRn b = NoExt
type instance XBindStmt (GhcPass _) GhcTc b = Type
type instance XBindStmt (GhcPass _) GhcRn b = (SyntaxExpr GhcRn, FailOperator GhcRn)
type instance XBindStmt (GhcPass _) GhcTc b = (SyntaxExpr GhcTc, Type, FailOperator GhcTc)
type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt
type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt
......@@ -2035,6 +2034,22 @@ data ParStmtBlock idL idR
type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
-- | The fail operator
--
-- This is used for `.. <-` "bind statments" in do notation, including
-- non-monadic "binds" in applicative.
--
-- The fail operator is 'Just expr' if it potentially fail monadically. if the
-- pattern match cannot fail, or shouldn't fail monadically (regular incomplete
-- pattern exception), it is 'Nothing'.
--
-- See Note [Monad fail : Rebindable syntax, overloaded strings] for the type of
-- expression in the 'Just' case, and why it is so.
--
-- See Note [Failing pattern matches in Stmts] for which contexts for
-- '@BindStmt@'s should use the monadic fail and which shouldn't.
type FailOperator id = Maybe (SyntaxExpr id)
-- | Applicative Argument
data ApplicativeArg idL
= ApplicativeArgOne -- A single statement (BindStmt or BodyStmt)
......@@ -2241,7 +2256,7 @@ pprStmt (LastStmt _ expr ret_stripped _)
= whenPprDebug (text "[last]") <+>
(if ret_stripped then text "return" else empty) <+>
ppr expr
pprStmt (BindStmt _ pat expr _ _) = hsep [ppr pat, larrow, ppr expr]
pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr]
pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds]
pprStmt (BodyStmt _ expr _ _) = ppr expr
pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss))
......@@ -2281,8 +2296,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
[ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
:: ExprStmt (GhcPass idL))]
| otherwise =
[ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
:: ExprStmt (GhcPass idL))]
[ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))]
flattenArg (_, ApplicativeArgMany _ stmts _ _) =
concatMap flattenStmt stmts
flattenArg (_, XApplicativeArg _) = panic "flattenArg"
......@@ -2301,8 +2315,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr
:: ExprStmt (GhcPass idL))
| otherwise =
ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr
:: ExprStmt (GhcPass idL))
ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))
pp_arg (_, ApplicativeArgMany _ stmts return pat) =
ppr pat <+>
text "<-" <+>
......
......@@ -57,10 +57,11 @@ module HsUtils(
-- Types
mkHsAppTy, mkHsAppKindTy, userHsTyVarBndrs, userHsLTyVarBndrs,
mkLHsSigType, mkLHsSigWcType, mkClassOpSigs, mkHsSigEnv,
nlHsAppTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,
nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,
-- Stmts
mkTransformStmt, mkTransformByStmt, mkBodyStmt, mkBindStmt, mkTcBindStmt,
-- * Stmts
mkTransformStmt, mkTransformByStmt, mkBodyStmt,
mkPsBindStmt, mkRnBindStmt, mkTcBindStmt,
mkLastStmt,
emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,
emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
......@@ -105,14 +106,14 @@ import TcEvidence
import RdrName
import Var
import TyCoRep
import Type ( filterOutInvisibleTypes )
import Type ( tyConArgFlags )
import TysWiredIn ( unitTy )
import TcType
import DataCon
import ConLike
import Id
import Name
import NameSet
import NameSet hiding ( unitFV )
import NameEnv
import BasicTypes
import SrcLoc
......@@ -121,7 +122,6 @@ import Util
import Bag
import Outputable
import Constants
import TyCon
import Data.Either
import Data.Function
......@@ -249,10 +249,10 @@ mkLastStmt :: Located (bodyR (GhcPass idR))
-> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkBodyStmt :: Located (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
(Located (bodyR (GhcPass idR))) ~ NoExt)
=> LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
-> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkPsBindStmt :: LPat GhcPs -> Located (bodyR GhcPs)
-> StmtLR GhcPs GhcPs (Located (bodyR GhcPs))
mkRnBindStmt :: LPat GhcRn -> Located (bodyR GhcRn)
-> StmtLR GhcRn GhcRn (Located (bodyR GhcRn))
mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
-> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
......@@ -305,9 +305,9 @@ mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = s
mkLastStmt body = LastStmt noExt body False noSyntaxExpr
mkBodyStmt body
= BodyStmt noExt body noSyntaxExpr noSyntaxExpr
mkBindStmt pat body
= BindStmt noExt pat body noSyntaxExpr noSyntaxExpr
mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr
mkPsBindStmt pat body = BindStmt noExt pat body
mkRnBindStmt pat body = BindStmt (noSyntaxExpr, Nothing) pat body
mkTcBindStmt pat body = BindStmt (noSyntaxExpr, unitTy, Nothing) pat body
-- don't use placeHolderTypeTc above, because that panics during zonking
emptyRecStmt' :: forall idL idR body.
......@@ -510,6 +510,10 @@ nlHsParTy t = noLoc (HsParTy noExt t)
nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys
nlHsAppKindTy ::
LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy f k = noLoc (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))
{-
Tuples. All these functions are *pre-typechecker* because they lack
types on the tuple.
......@@ -669,14 +673,24 @@ typeToLHsType ty
go (LitTy (StrTyLit s))
= noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)
go ty@(TyConApp tc args)
| any isInvisibleTyConBinder (tyConBinders tc)
| tyConAppNeedsKindSig True tc (length args)
-- We must produce an explicit kind signature here to make certain
-- programs kind-check. See Note [Kind signatures in typeToLHsType].
= nlHsParTy $ noLoc $ HsKindSig NoExt lhs_ty (go (typeKind ty))
| otherwise = lhs_ty
where
lhs_ty = nlHsTyConApp (getRdrName tc) (map go args')
args' = filterOutInvisibleTypes tc args
arg_flags :: [ArgFlag]
arg_flags = tyConArgFlags tc args
lhs_ty :: LHsType GhcPs
lhs_ty = foldl' (\f (arg, flag) ->
let arg' = go arg in
case flag of
Inferred -> f
Specified -> f `nlHsAppKindTy` arg'
Required -> f `nlHsAppTy` arg')
(nlHsTyVar (getRdrName tc))
(zip args arg_flags)
go (CastTy ty _) = go ty
go (CoercionTy co) = pprPanic "toLHsSigWcType" (ppr co)
......@@ -693,48 +707,40 @@ Note [Kind signatures in typeToLHsType]
There are types that typeToLHsType can produce which require explicit kind
signatures in order to kind-check. Here is an example from Trac #14579:
newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) deriving Eq
newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) deriving Eq
-- type P :: forall {k} {t :: k}. Proxy t
type P = 'Proxy
-- type Wat :: forall a. Proxy a -> *
newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a)
deriving Eq
-- type Wat2 :: forall {a}. Proxy a -> *
type Wat2 = Wat
-- type Glurp :: * -> *
newtype Glurp a = MkGlurp (Wat2 (P :: Proxy a))
deriving Eq
The derived Eq instance for Glurp (without any kind signatures) would be:
instance Eq a => Eq (Glurp a) where
(==) = coerce @(Wat 'Proxy -> Wat 'Proxy -> Bool)
@(Glurp a -> Glurp a -> Bool)
(==) = coerce @(Wat2 P -> Wat2 P -> Bool)
@(Glurp a -> Glurp a -> Bool)
(==) :: Glurp a -> Glurp a -> Bool
(Where the visible type applications use types produced by typeToLHsType.)
The type 'Proxy has an underspecified kind, so we must ensure that
typeToLHsType ascribes it with its kind: ('Proxy :: Proxy a).