Skip to content
Snippets Groups Projects
  1. Mar 12, 2020
    • Ryan Scott's avatar
      Make DeriveFunctor-generated code require fewer beta reductions · cb93a1a4
      Ryan Scott authored and Marge Bot's avatar Marge Bot committed
      Issue #17880 demonstrates that `DeriveFunctor`-generated code is
      surprisingly fragile when rank-_n_ types are involved. The culprit is
      that `$fmap` (the algorithm used to generate `fmap` implementations)
      was too keen on applying arguments with rank-_n_ types to lambdas,
      which fail to typecheck more often than not.
      
      In this patch, I change `$fmap` (both the specification and the
      implementation) to produce code that avoids creating as many lambdas,
      avoiding problems when rank-_n_ field types arise.
      See the comments titled "Functor instances" in `TcGenFunctor` for a
      more detailed description. Not only does this fix #17880, but it also
      ensures that the code that `DeriveFunctor` generates will continue
      to work after simplified subsumption is implemented (see #17775).
      
      What is truly amazing is that #17880 is actually a regression
      (introduced in GHC 7.6.3) caused by commit
      49ca2a37, the fix #7436. Prior to
      that commit, the version of `$fmap` that was used was almost
      identical to the one used in this patch! Why did that commit change
      `$fmap` then? It was to avoid severe performance issues that would
      arise for recursive `fmap` implementations, such as in the example
      below:
      
      ```hs
      data List a = Nil | Cons a (List a) deriving Functor
      
      -- ===>
      
      instance Functor List where
        fmap f Nil = Nil
        fmap f (Cons x xs) = Cons (f x) (fmap (\y -> f y) xs)
      ```
      
      The fact that `\y -> f y` was eta expanded caused significant
      performance overheads. Commit
      49ca2a37 fixed this performance
      issue, but it went too far. As a result, this patch partially
      reverts 49ca2a37.
      
      To ensure that the performance issues pre-#7436 do not resurface,
      I have taken some precautionary measures:
      
      * I have added a special case to `$fmap` for situations where the
        last type variable in an application of some type occurs directly.
        If this special case fires, we avoid creating a lambda expression.
        This ensures that we generate
        `fmap f (Cons x xs) = Cons (f x) (fmap f xs)` in the derived
        `Functor List` instance above. For more details, see
        `Note [Avoid unnecessary eta expansion in derived fmap implementations]`
        in `TcGenFunctor`.
      * I have added a `T7436b` test case to ensure that the performance
        of this derived `Functor List`-style code does not regress.
      
      When implementing this, I discovered that `$replace`, the algorithm
      which generates implementations of `(<$)`, has a special case that is
      very similar to the `$fmap` special case described above. `$replace`
      marked this special case with a custom `Replacer` data type, which
      was a bit overkill. In order to use the same machinery for both
      `Functor` methods, I ripped out `Replacer` and instead implemented
      a simple way to detect the special case. See the updated commentary
      in `Note [Deriving <$]` for more details.
      cb93a1a4
    • Sylvain Henry's avatar
      Use a Set to represent Ways · a6989971
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      Should make `member` queries faster and avoid messing up with missing
      `nubSort`.
      
      Metric Increase:
          hie002
      a6989971
    • Sylvain Henry's avatar
      Refactor interpreterDynamic and interpreterProfiled · bc41e471
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      * `interpreterDynamic` and `interpreterProfiled` now take `Interp`
        parameters instead of DynFlags
      
      * slight refactoring of `ExternalInterp` so that we can read the iserv
        configuration (which is pure) without reading an MVar.
      bc41e471
    • Sylvain Henry's avatar
      Refactor GHC.Driver.Session (Ways and Flags) · 8e6febce
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      * extract flags and ways into their own modules (with some renaming)
      
      * remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases
      
      * when GHC uses dynamic linking (WayDyn), `interpWays` was only
        reporting WayDyn even if the host was profiled (WayProf).  Now it
        returns both as expected (might fix #16803).
      
      * `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for
        differently ordered lists. Now we sort and nub the list to fix this.
      8e6febce
  2. Mar 11, 2020
    • Ömer Sinan Ağacan's avatar
      Zero any slop after compaction in compacting GC · 3aa9b35f
      Ömer Sinan Ağacan authored and Marge Bot's avatar Marge Bot committed
      In copying GC, with the relevant debug flags enabled, we release the old
      blocks after a GC, and the block allocator zeroes the space before
      releasing a block. This effectively zeros the old heap.
      
      In compacting GC we reuse the blocks and previously we didn't zero the
      unused space in a compacting generation after compaction. With this
      patch we zero the slop between the free pointer and the end of the block
      when we're done with compaction and when switching to a new block
      (because the current block doesn't have enough space for the next object
      we're shifting).
      3aa9b35f
    • Simon Peyton Jones's avatar
      Deepen call stack for isIn · c61b9b02
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      I see quite a few warnings like:
      
        WARNING: file compiler/utils/Util.hs, line 593
          Over-long elem in unionLists
      
      But the call stack is uninformative.   Better to add HasDebugCallStack
      to isIn.  Ditto isn'tIn.
      c61b9b02
    • Ben Gamari's avatar
      testsuite: Mark ghci056 and ghcilink004 as fragile in unreg · 336eac7e
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      As noted in #17018.
      
      Also fix fragile declaration of T13786, which only runs in the normal
      way.
      336eac7e
    • Ryan Scott's avatar
      Re-quantify when generalising over rewrite rule types · 0bc23338
      Ryan Scott authored and Marge Bot's avatar Marge Bot committed
      Previously, `tcRules` would check for naughty quantification
      candidates (see `Note [Naughty quantification candidates]` in
      `TcMType`) when generalising over the type of a rewrite rule. This
      caused sensible-looking rewrite rules (like those in #17710) to be
      rejected. A more permissing (and easier-to-implement) approach is to
      do what is described in `Note [Generalising in tcTyFamInstEqnGuts]`
      in `TcTyClsDecls`: just re-quantify all the type variable binders,
      regardless of the order in which the user specified them. After all,
      the notion of type variable specificity has no real meaning in
      rewrite rules, since one cannot "visibly apply" a rewrite rule.
      I have written up this wisdom in
      `Note [Re-quantify type variables in rules]` in `TcRules`.
      
      As a result of this patch, compiling the `ExplicitForAllRules1` test
      case now generates one fewer warning than it used to. As far as I can
      tell, this is benign, since the thing that the disappearing warning
      talked about was also mentioned in an entirely separate warning.
      
      Fixes #17710.
      0bc23338
    • Greg Steuck's avatar
      Fixed a minor typo in codegen.rst · 1daa2029
      Greg Steuck authored and Marge Bot's avatar Marge Bot committed
      1daa2029
    • Sylvain Henry's avatar
      Split GHC.Iface.Utils module · 20800b9a
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      * GHC.Iface.Recomp: recompilation avoidance stuff
      * GHC.Iface.Make: mkIface*
      
      Moved `writeIfaceFile` into GHC.Iface.Load alongside `readIface` and
      renamed it `writeIface` for consistency.
      20800b9a
    • Ben Gamari's avatar
      rts: Prefer darwin-specific getCurrentThreadCPUTime · bb586f89
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      macOS Catalina now supports a non-POSIX-compliant version of clock_gettime
      which cannot use the clock_gettime codepath.
      
      Fixes #17906.
      bb586f89
  3. Mar 10, 2020
  4. Mar 09, 2020
  5. Mar 05, 2020
  6. Mar 04, 2020
  7. Mar 02, 2020
    • Sylvain Henry's avatar
      Use configure script to detect that we should use in-tree GMP on Windows · 2a2f51d7
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      2a2f51d7
    • Roland Senn's avatar
      Set `ImpredicativeTypes` during :print command. (#14828) · 7c0c76fb
      Roland Senn authored and Marge Bot's avatar Marge Bot committed
      If ImpredicativeTypes is not enabled, then `:print <term>` will fail if the
      type of <term> has nested `forall`s or `=>`s.
      This is because the GHCi debugger's internals will attempt to unify a
      metavariable with the type of <term> and then display the result, but if the
      type has nested `forall`s or `=>`s, then unification will fail.
      As a result, `:print` will bail out and the unhelpful result will be
      `<term> = (_t1::t1)` (where `t1` is a metavariable).
      
      Beware: <term> can have nested `forall`s even if its definition doesn't use
      RankNTypes! Here is an example from #14828:
      
        class Functor f where
          fmap :: (a -> b) -> f a -> f b
      
      Somewhat surprisingly, `:print fmap` considers the type of fmap to have
      nested foralls. This is because the GHCi debugger sees the type
      `fmap :: forall f. Functor f => forall a b. (a -> b) -> f a -> f b`.
      We could envision deeply instantiating this type to get the type
      `forall f a b. Functor f => (a -> b) -> f a -> f b`,
      but this trick wouldn't work for higher-rank types.
      
      Instead, we adopt a simpler fix: enable `ImpredicativeTypes` when using
      `:print` and friends in the GHCi debugger. This is allows metavariables
      to unify with types that have nested (or higher-rank) `forall`s/`=>`s,
      which makes `:print fmap` display as
      `fmap = (_t1::forall a b. Functor f => (a -> b) -> f a -> f b)`, as expected.
      
      Although ImpredicativeTypes is a somewhat unpredictable from a type inference
      perspective, there is no danger in using it in the GHCi debugger, since all
      of the terms that the GHCi debugger deals with have already been typechecked.
      7c0c76fb
    • Ilias Tsitsimpis's avatar
      Do not define hs_atomic{read,write}64() on non-64bit · dbea7e9d
      Ilias Tsitsimpis authored and Marge Bot's avatar Marge Bot committed
      Do not define hs_atomicread64() and hs_atomicwrite64() on machines where
      WORD_SIZE_IN_BITS is less than 64, just like we do with the rest of the atomic
      functions which work on 64-bit values.
      
      Without this, compilation fails on MIPSel and PowerPC with the following error:
      
      /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicread64':
      atomic.c:(.text.hs_atomicread64+0x8): undefined reference to `__sync_add_and_fetch_8'
      /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicwrite64':
      atomic.c:(.text.hs_atomicwrite64+0x38): undefined reference to `__sync_bool_compare_and_swap_8'
      
      Fixes #17886.
      dbea7e9d
    • Krzysztof Gogolewski's avatar
      Remove dead code · 3cf7303b
      Krzysztof Gogolewski authored and Marge Bot's avatar Marge Bot committed
      * The names in PrelName and THNames are no longer used
        since TH merged types and kinds, Typeable is kind-polymorphic,
        .net support was removed
      * unqualQuasiQuote no longer used since 6f8ff0bb
      3cf7303b
  8. Feb 29, 2020
    • Roland Senn's avatar
      Show breakpoint locations of breakpoints which were ignored during :force (#2950) · 3979485b
      Roland Senn authored
      GHCi is split up into 2 major parts: The user-interface (UI)
      and the byte-code interpreter. With `-fexternal-interpreter`
      they even run in different processes. Communication between
      the UI and the Interpreter (called `iserv`) is done using
      messages over a pipe. This is called `Remote GHCI` and
      explained in the Note [Remote GHCi] in `compiler/ghci/GHCi.hs`.
      
      To process a `:force` command the UI sends a `Seq` message
      to the `iserv` process. Then `iserv` does the effective
      evaluation of the value. When during this process a breakpoint
      is hit, the `iserv` process has no additional information to
      enhance the `Ignoring breakpoint` output with the breakpoint
      location.
      
      To be able to print additional breakpoint information,
      there are 2 possible implementation choices:
      1. Store the needed information in the `iserv` process.
      2. Print the `Ignoring breakpoint` from the UI process.
      
      For option 1 we need to store the breakpoint info redundantely
      in 2 places and this is bad. Therfore option 2 was implemented
      in this MR:
      - The user enters a `force` command
      - The UI sends  a `Seq` message to the `iserv` process.
      - If processing of the `Seq` message hits a breakpoint,
        the `iserv` process returns control to the UI process.
      - The UI looks up the source location of the breakpoint,
        and prints the enhanced `Ignoring breakpoint` output.
      - The UI sends a `ResumeSeq` message to the `iserv` process,
        to continue forcing.
      3979485b
    • Ömer Sinan Ağacan's avatar
      Simplify IfaceIdInfo type · 04d30137
      Ömer Sinan Ağacan authored and Marge Bot's avatar Marge Bot committed
      IfaceIdInfo type is confusing: there's practically no difference between
      `NoInfo` and `HasInfo []`. The comments say NoInfo is used when
      -fomit-interface-pragmas is enabled, but we don't need to distinguish
      `NoInfo` from `HasInfo []` in when reading the interface so the
      distinction is not important.
      
      This patch simplifies the type by removing NoInfo. When we have no info
      we use an empty list.
      
      With this change we no longer read the info list lazily when reading an
      IfaceInfoItem, but when reading an IfaceId the ifIdInfo field is
      read lazily, so I doubt this is going to be a problem.
      04d30137
    • Sylvain Henry's avatar
      Fix Hadrian's ``--configure`` (fix #17883) · 34c7d230
      Sylvain Henry authored and Marge Bot's avatar Marge Bot committed
      34c7d230
    • Jean-Baptiste Mazon's avatar
      rts: enforce POSIX numeric locale for heap profiles · 252e5117
      Jean-Baptiste Mazon authored and Marge Bot's avatar Marge Bot committed
      252e5117
    • adam's avatar
      docs: correct link to th haddocks from users guide · 0f55df7f
      adam authored and Marge Bot's avatar Marge Bot committed
      0f55df7f
Loading