Skip to content
Snippets Groups Projects
  1. Mar 19, 2022
  2. Mar 18, 2022
    • Ben Gamari's avatar
      testsuite: Add test for #21186 · 435a3d5d
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      435a3d5d
    • Ben Gamari's avatar
      codeGen: Fix signedness of jump table indexing · d147428a
      Ben Gamari authored and Marge Bot's avatar Marge Bot committed
      Previously while constructing the jump table index we would
      zero-extend the discriminant before subtracting the start of the
      jump-table. This goes subtly wrong in the case of a sub-word, signed
      discriminant, as described in the included Note. Fix this in both the
      PPC and X86 NCGs.
      
      Fixes #21186.
      d147428a
    • Rodrigo Mesquita's avatar
      TTG: TH brackets finishing touches · ac3b2e7d
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      Rewrite the critical notes and fix outdated ones,
      
      use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the
      bracket being typed or untyped,
      
      remove unused `EpAnn` from `Hs*Bracket GhcRn`,
      
      zonkExpr factor out common brackets code,
      
      ppr_expr factor out common brackets code,
      
      and fix tests,
      
      to finish MR !4782.
      
      -------------------------
      Metric Decrease:
          hard_hole_fits
      -------------------------
      ac3b2e7d
    • Rodrigo Mesquita's avatar
      TTG: Make HsQuote GhcTc isomorphic to NoExtField · b056adc8
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      An untyped bracket `HsQuote p` can never be constructed with
      `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all.
      
      That's OK, because we also never use `HsQuote GhcTc`.
      
      To enforce this at the type level we make `HsQuote GhcTc` isomorphic
      to `NoExtField` and impossible to construct otherwise, by using TTG field
      extensions to make all constructors, except for `XQuote` (which takes `NoExtField`),
      unconstructable, with `DataConCantHappen`
      
      This is explained more in detail in Note [The life cycle of a TH quotation]
      
      Related discussion: !4782
      b056adc8
    • Rodrigo Mesquita's avatar
      TTG: Refactor bracket for desugaring during tc · 4a2567f5
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      When desugaring a bracket we want to desugar /renamed/ rather than
      /typechecked/ code; So in (HsExpr GhcTc) tree, we must
      have a (HsExpr GhcRn) for the quotation itself.
      
      This commit reworks the TTG refactor on typed and untyped brackets by
      storing the /renamed/ code in the bracket field extension rather than in
      the constructor extension in `HsQuote` (previously called
      `HsUntypedBracket`)
      
      See Note [The life cycle of a TH quotation] and !4782
      4a2567f5
    • Rodrigo Mesquita's avatar
      Separate constructors for typed and untyped brackets · 310890a5
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      Split HsBracket into HsTypedBracket and HsUntypedBracket.
      
      Unfortunately, we still cannot get rid of
      
          instance XXTypedBracket GhcTc = HsTypedBracket GhcRn
      
      despite no longer requiring it for typechecking, but rather because the
      TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote)
      310890a5
    • Rodrigo Mesquita's avatar
      Type-checking untyped brackets · 19163397
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket
      GhcRn, rather than an HsBracket GhcTc.
      
      We make use of the HsBracket p extension constructor (XBracket
      (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc
      
      See !4782 !4782
      19163397
    • Rodrigo Mesquita's avatar
      TTG: Refactor HsBracket · 8561c1af
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      8561c1af
  3. Mar 17, 2022
  4. Mar 16, 2022
    • sheaf's avatar
      Add a regression test for #21130 · bb779b90
      sheaf authored and Marge Bot's avatar Marge Bot committed
      This problem was due to a bug in cloneWanted, which was incorrectly
      creating a coercion hole to hold an evidence variable.
      
      This bug was introduced by 8bb52d91 and fixed in 81740ce8.
      
      Fixes #21130
      bb779b90
    • Sebastian Graf's avatar
      Demand: Let `Boxed` win in `lubBoxity` (#21119) · 1575c4a5
      Sebastian Graf authored and Marge Bot's avatar Marge Bot committed
      Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic
      in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox
      parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent.
      
      Until now, we thought that this hack pulled its weight becuase it worked around
      some shortcomings of the phase separation between Boxity analysis and CPR
      analysis. But it is a gross hack which caused regressions itself that needed all
      kinds of fixes and workarounds. See for example #20767. It became impossible to
      work with in !7599, so I want to remove it.
      
      For example, at the moment, `lubDmd B dmd` will not unbox `dmd`,
      but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of
      the lattice, it's hardly justifiable to get a better demand when `lub`bing with
      `A`.
      
      The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress
       #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR
      are able to communicate better. Fortunately, that is not the case since I could
      tweak the other source of optimism in Boxity analysis that is described in
      `Note [Unboxed demand on function bodies returning small products]` so that
      we *recursively* assume unboxed demands on function bodies returning small
      products. See the updated Note.
      
      `Note [Boxity for bottoming functions]` describes why we need bottoming
      functions to have signatures that say that they deeply unbox their arguments.
      In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox
      recursive data constructors. This is in line with our handling of them in CPR.
      I updated `Note [Which types are unboxed?]` to reflect that.
      
      In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler
      implementation (at least to think about). We can also drop the very ad-hoc
      definition of `deferAfterPreciseException` and its Note in favor of the
      simple, intuitive definition we used to have.
      
      Metric Decrease:
          T16875
          T18223
          T18698a
          T18698b
          hard_hole_fits
      Metric Increase:
          LargeRecord
          MultiComponentModulesRecomp
          T15703
          T8095
          T9872d
      
      Out of all the regresions, only the one in T9872d doesn't vanish in a perf
      build, where the compiler is bootstrapped with -O2 and thus SpecConstr.
      Reason for regressions:
      
        * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed.
          That is because the context is passed to a function argument, for
          example in `liftCoSubstTyVarBndrUsing`.
        * In T15703, LargeRecord and T8095, we get a bit more allocations in
          `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed.
          In both cases that guards against reboxing in some code paths.
        * The same is true for MultiComponentModulesRecomp, where we get less unboxing
          in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations
          actually *improve* by over 4%!
      
      Results on NoFib:
      
      --------------------------------------------------------------------------------
              Program         Allocs    Instrs
      --------------------------------------------------------------------------------
               awards          -0.4%     +0.3%
            cacheprof          -0.3%     +2.4%
                  fft          -1.5%     -5.1%
             fibheaps          +1.2%     +0.8%
                fluid          -0.3%     -0.1%
                  ida          +0.4%     +0.9%
         k-nucleotide          +0.4%     -0.1%
           last-piece         +10.5%    +13.9%
                 lift          -4.4%     +3.5%
              mandel2         -99.7%    -99.8%
                 mate          -0.4%     +3.6%
               parser          -1.0%     +0.1%
               puzzle         -11.6%     +6.5%
      reverse-complem          -3.0%     +2.0%
                  scs          -0.5%     +0.1%
               sphere          -0.4%     -0.2%
            wave4main          -8.2%     -0.3%
      --------------------------------------------------------------------------------
      Summary excludes mandel2 because of excessive bias
                  Min         -11.6%     -5.1%
                  Max         +10.5%    +13.9%
       Geometric Mean          -0.2%     +0.3%
      --------------------------------------------------------------------------------
      
      Not bad for a bug fix.
      
      The regression in `last-piece` could become a win if SpecConstr would work on
      non-recursive functions. The regression in `fibheaps` is due to
      `Note [Reboxed crud for bottoming calls]`, e.g., #21128.
      1575c4a5
    • Zubin's avatar
      TH: allow negative patterns in quotes (#20711) · a33d1045
      Zubin authored and Marge Bot's avatar Marge Bot committed
      We still don't allow negative overloaded patterns. Earler all negative patterns
      were treated as negative overloaded patterns. Now, we expliclty check the
      extension field to see if the pattern is actually a negative overloaded pattern
      a33d1045
    • Aaron Allen's avatar
      Suggest FFI extensions as hints (#20116) · c1fed9da
      Aaron Allen authored and Marge Bot's avatar Marge Bot committed
      - Use extension suggestion hints instead of suggesting extensions in the
      error message body for several FFI errors.
      - Adds a test case for `TcRnForeignImportPrimExtNotSet`
      c1fed9da
    • Aaron Allen's avatar
      Convert Diagnostics in GHC.Tc.Gen.Foreign · 577135bf
      Aaron Allen authored and Marge Bot's avatar Marge Bot committed
      Converts all uses of 'TcRnUnknownMessage' to proper diagnostics.
      577135bf
  5. Mar 15, 2022
    • Vladislav Zavialov's avatar
      Export (~) from Data.Type.Equality (#18862) · ab618309
      Vladislav Zavialov authored
      * Users can define their own (~) type operator
      * Haddock can display documentation for the built-in (~)
      * New transitional warnings implemented:
          -Wtype-equality-out-of-scope
          -Wtype-equality-requires-operators
      
      Updates the haddock submodule.
      ab618309
  6. Mar 14, 2022
    • Sebastian Graf's avatar
      DmdAnal: Don't unbox recursive data types (#11545) · 8ff32124
      Sebastian Graf authored and Marge Bot's avatar Marge Bot committed
      As `Note [Demand analysis for recursive data constructors]` describes, we now
      refrain from unboxing recursive data type arguments, for two reasons:
      
       1. Relating to run/alloc perf: Similar to
          `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc
          performance if we just unbox a finite number of layers of a potentially huge
          data structure.
       2. Relating to ghc/alloc perf: Inductive definitions on single-product
          recursive data types like the one in T11545 will (diverge, and) have very
          deep demand signatures before any other abortion mechanism in Demand
          analysis is triggered. That leads to great and unnecessary churn on Demand
          analysis when ultimately we will never make use of any nested strictness
          information anyway.
      
      Conclusion: Discard nested demand and boxity information on such recursive types
      with the help of `Note [Detecting recursive data constructors]`.
      
      I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid
      the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`.
      It's nice and simple and guards against some smaller regressions in T9233 and
      T16577.
      
      ghc/alloc performance-wise, this patch is a very clear win:
      
                                     Test    Metric          value      New value Change
      ---------------------------------------------------------------------------------------
                      LargeRecord(normal) ghc/alloc  6,141,071,720  6,099,871,216  -0.7%
      MultiLayerModulesTH_OneShot(normal) ghc/alloc  2,740,973,040  2,705,146,640  -1.3%
                           T11545(normal) ghc/alloc    945,475,492     85,768,928 -90.9% GOOD
                           T13056(optasm) ghc/alloc    370,245,880    326,980,632 -11.7% GOOD
                           T18304(normal) ghc/alloc     90,933,944     76,998,064 -15.3% GOOD
                           T9872a(normal) ghc/alloc  1,800,576,840  1,792,348,760  -0.5%
                           T9872b(normal) ghc/alloc  2,086,492,432  2,073,991,848  -0.6%
                           T9872c(normal) ghc/alloc  1,750,491,240  1,737,797,832  -0.7%
             TcPlugin_RewritePerf(normal) ghc/alloc  2,286,813,400  2,270,957,896  -0.7%
      
                                geo. mean                                          -2.9%
      
      No noteworthy change in run/alloc either.
      
      NoFib results show slight wins, too:
      
      --------------------------------------------------------------------------------
              Program         Allocs    Instrs
      --------------------------------------------------------------------------------
          constraints          -1.9%     -1.4%
                fasta          -3.6%     -2.7%
      reverse-complem          -0.3%     -0.9%
             treejoin          -0.0%     -0.3%
      --------------------------------------------------------------------------------
                  Min          -3.6%     -2.7%
                  Max          +0.1%     +0.1%
       Geometric Mean          -0.1%     -0.1%
      
      Metric Decrease:
          T11545
          T13056
          T18304
      8ff32124
    • sheaf's avatar
      Fix isLiftedType_maybe and handle fallout · 8eadea67
      sheaf authored and Marge Bot's avatar Marge Bot committed
      As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in
      many situations where it should return `Nothing`, because it didn't
      take into account type families or type variables.
      
      In this patch, we fix this issue. We rename `isLiftedType_maybe` to
      `typeLevity_maybe`, which now returns a `Levity` instead of a boolean.
      We now return `Nothing` for types with kinds of the form
      `TYPE (F a1 ... an)` for a type family `F`, as well as
      `TYPE (BoxedRep l)` where `l` is a type variable.
      
      This fix caused several other problems, as other parts of the compiler
      were relying on `isLiftedType_maybe` returning a `Just` value, and were
      now panicking after the above fix. There were two main situations in
      which panics occurred:
      
        1. Issues involving the let/app invariant. To uphold that invariant,
           we need to know whether something is lifted or not. If we get an
           answer of `Nothing` from `isLiftedType_maybe`, then we don't know
           what to do. As this invariant isn't particularly invariant, we
           can change the affected functions to not panic, e.g. by behaving
           the same in the `Just False` case and in the `Nothing` case
           (meaning: no observable change in behaviour compared to before).
      
        2. Typechecking of data (/newtype) constructor patterns. Some programs
           involving patterns with unknown representations were accepted, such
           as T20363. Now that we are stricter, this caused further issues,
           culminating in Core Lint errors. However, the behaviour was
           incorrect the whole time; the incorrectness only being revealed by
           this change, not triggered by it.
      
           This patch fixes this by overhauling where the representation
           polymorphism involving pattern matching are done. Instead of doing
           it in `tcMatches`, we instead ensure that the `matchExpected`
           functions such as `matchExpectedFunTys`, `matchActualFunTySigma`,
           `matchActualFunTysRho` allow return argument pattern types which
           have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]).
           This ensures that the pattern matching code only ever handles types
           with a known runtime representation. One exception was that
           patterns with an unknown representation type could sneak in via
           `tcConPat`, which points to a missing representation-polymorphism
           check, which this patch now adds.
      
           This means that we now reject the program in #20363, at least until
           we implement PHASE 2 of FixedRuntimeRep (allowing type families in
           RuntimeRep positions). The aforementioned refactoring, in which
           checks have been moved to `matchExpected` functions, is a first
           step in implementing PHASE 2 for patterns.
      
      Fixes #20837
      8eadea67
    • sheaf's avatar
      Add two coercion optimisation perf tests · 106413f0
      sheaf authored and Marge Bot's avatar Marge Bot committed
      106413f0
    • Rodrigo Mesquita's avatar
      TTG Pull AbsBinds and ABExport out of the main AST · 135888dd
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      AbsBinds and ABExport both depended on the typechecker, and were thus
      removed from the main AST Expr.
      
      CollectPass now has a new function `collectXXHsBindsLR` used for the new
      HsBinds extension point
      
      Bumped haddock submodule to work with AST changes.
      
      The removed Notes from Language.Haskell.Syntax.Binds were duplicated
      (and not referenced) and the copies in GHC.Hs.Binds are kept (and
      referenced there). (See #19252)
      135888dd
    • Rodrigo Mesquita's avatar
      Fix up Note [Bind free vars] · 97db789e
      Rodrigo Mesquita authored and Marge Bot's avatar Marge Bot committed
      Move GHC-specific comments from Language.Haskell.Syntax.Binds to
      GHC.Hs.Binds
      
      It looks like the Note was deleted but there were actually two copies of
      it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated
      copy. (See #19252)
      
      There are other duplicated notes -- they will be fixed in the next
      commit
      97db789e
  7. Mar 13, 2022
    • Sebastian Graf's avatar
      Worker/wrapper: Preserve float barriers (#21150) · 76b94b72
      Sebastian Graf authored and Marge Bot's avatar Marge Bot committed
      Issue #21150 shows that worker/wrapper allocated a worker function for a
      function with multiple calls that said "called at most once" when the first
      argument was absent. That's bad!
      
      This patch makes it so that WW preserves at least one non-one-shot value lambda
      (see `Note [Preserving float barriers]`) by passing around `void#` in place of
      absent arguments.
      
      Fixes #21150.
      
      Since the fix is pretty similar to `Note [Protecting the last value argument]`,
      I put the logic in `mkWorkerArgs`. There I realised (#21204) that
      `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated
      the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`.
      SpecConstr is another client of that API.
      
      Fixes #21204.
      
      Metric Decrease:
          T14683
      76b94b72
    • Simon Peyton Jones's avatar
      Fix bug in weak loop-breakers in OccurAnal · ad835531
      Simon Peyton Jones authored and Marge Bot's avatar Marge Bot committed
      Note [Weak loop breakers] explains why we need to track variables free
      in RHS of rules.  But we need to do this for /inactive/ rules as well
      as active ones, unlike the rhs_fv_env stuff.
      
      So we now have two fields in node Details, one for free vars of
      active rules, and one for free vars of all rules.
      
      This was shown up by #20820, which is now fixed.
      ad835531
  8. Mar 12, 2022
Loading