- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/T26209-9.14
by Ben Gamari (＠bgamari) 26 Jul '25

26 Jul '25

Ben Gamari pushed new branch wip/T26209-9.14 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26209-9.14 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sol/driver-diagnostics] 12 commits: CprAnal: Detect recursive newtypes (#25944)
by Simon Hengel (＠sol) 26 Jul '25

26 Jul '25

Simon Hengel pushed to branch wip/sol/driver-diagnostics at Glasgow Haskell Compiler / GHC Commits: 4bc78496 by Sebastian Graf at 2025-07-24T16:19:34-04:00 CprAnal: Detect recursive newtypes (#25944) While `cprTransformDataConWork` handles recursive data con workers, it did not detect the case when a newtype is responsible for the recursion. This is now detected in the `Cast` case of `cprAnal`. The same reproducer made it clear that `isRecDataCon` lacked congruent handling for `AppTy` and `CastTy`, now fixed. Furthermore, the new repro case T25944 triggered this bug via an infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`. While it should be much less likely to trigger such an infinite loop now that `isRecDataCon` has been fixed, I made sure to abort the loop after 10 iterations and emitting a warning instead. Fixes #25944. - - - - - 0a583689 by Sylvain Henry at 2025-07-24T16:20:26-04:00 STM: don't create a transaction in the rhs of catchRetry# (#26028) We don't need to create a transaction for the rhs of (catchRetry#) because contrary to the lhs we don't need to abort it on retry. Moreover it is particularly harmful if we have code such as (#26028): let cN = readTVar vN >> retry tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...)) atomically tree Because it will stack transactions for the rhss and the read-sets of all the transactions will be iteratively merged in O(n^2) after the execution of the most nested retry. - - - - - a49eca26 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Renaming around predicate types .. we were (as it turned out) abstracting over type-class selectors in SPECIALISATION rules! Wibble isEqPred - - - - - f80375dd by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Refactor of Specialise.hs This patch just tidies up `specHeader` a bit, removing one of its many results, and adding some comments. No change in behaviour. Also add a few more `HasDebugCallStack` contexts. - - - - - 1bd12371 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Improve treatment of SPECIALISE pragmas -- again! This MR does another major refactor of the way that SPECIALISE pragmas work, to fix #26115, #26116, #26117. * We now /always/ solve forall-constraints in an all-or-nothing way. See Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve This means we might have unsolved quantified constraints, which need to be reported. See `inert_insts` in `getUnsolvedInerts`. * I refactored the short-cut solver for type classes to work by recursively calling the solver rather than by having a little baby solver that kept being not clever enough. See Note [Shortcut solving] in GHC.Tc.Solver.Dict * I totally rewrote the desugaring of SPECIALISE pragmas, again. The new story is in Note [Desugaring new-form SPECIALISE pragmas] in GHC.HsToCore.Binds Both old-form and new-form SPECIALISE pragmas now route through the same function `dsSpec_help`. The tricky function `decomposeRuleLhs` is now used only for user-written RULES, not for SPECIALISE pragmas. * I improved `solveOneFromTheOther` to account for rewriter sets. Previously it would solve a non-rewritten dict from a rewritten one. For equalities we were already dealing with this, in Some incidental refactoring * A small refactor: `ebv_tcvs` in `EvBindsBar` now has a list of coercions, rather than a set of tyvars. We just delay taking the free vars. * GHC.Core.FVs.exprFVs now returns /all/ free vars. Use `exprLocalFVs` for Local vars. Reason: I wanted another variant for /evidence/ variables. * Ues `EvId` in preference to `EvVar`. (Evidence variables are always Ids.) Rename `isEvVar` to `isEvId`. * I moved `inert_safehask` out of `InertCans` and into `InertSet` where it more properly belongs. Compiler-perf changes: * There was a palpable bug (#26117) which this MR fixes in newWantedEvVar, which bypassed all the subtle overlapping-Given and shortcutting logic. (See the new `newWantedEvVar`.) Fixing this but leads to extra dictionary bindings; they are optimised away quickly but they made CoOpt_Read allocate 3.6% more. * Hpapily T15164 improves. * The net compiler-allocation change is 0.0% Metric Decrease: T15164 Metric Increase: CoOpt_Read T12425 - - - - - 953fd8f1 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Solve forall-constraints immediately, or not at all This MR refactors the constraint solver to solve forall-constraints immediately, rather than emitting an implication constraint to be solved later. The most immediate motivation was that when solving quantified constraints in SPECIALISE pragmas, we really really don't want to leave behind half- solved implications. Also it's in tune with the approach of the new short-cut solver, which recursively invokes the solver. It /also/ saves quite a bit of plumbing; e.g - The `wl_implics` field of `WorkList` is gone, - The types of `solveSimpleWanteds` and friends are simplified. - An EvFun contains binding, rather than an EvBindsVar ref-cell that will in the future contain bindings. That makes `evVarsOfTerm` simpler. Much nicer. It also improves error messages a bit. All described in Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve. One tiresome point: in the tricky case of `inferConstraintsCoerceBased` we make a forall-constraint. This we /do/ want to partially solve, so we can infer a suitable context. (I'd be quite happy to force the user to write a context, bt I don't want to change behavior.) So we want to generate an /implication/ constraint in `emitPredSpecConstraints` rather than a /forall-constraint/ as we were doing before. Discussed in (WFA3) of the above Note. Incidental refactoring * `GHC.Tc.Deriv.Infer.inferConstraints` was consulting the state monad for the DerivEnv that the caller had just consulted. Nicer to pass it as an argument I think, so I have done that. No change in behaviour. - - - - - 6921ab42 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Remove duplicated code in Ast.hs for evTermFreeVars This is just a tidy up. - - - - - 1165f587 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Small tc-tracing changes only - - - - - 0776ffe0 by Simon Hengel at 2025-07-26T04:54:20-04:00 Respect `-fdiagnostics-as-json` for core diagnostics (see #24113) - - - - - cc1116e0 by Andrew Lelechenko at 2025-07-26T04:55:01-04:00 docs: add since pragma to Data.List.NonEmpty.mapMaybe - - - - - a796077e by Simon Hengel at 2025-07-26T09:14:33+00:00 Don't use MCDiagnostic for `ghcExit` This changes the error message of `ghcExit` from ``` <no location info>: error: Compilation had errors ``` to ``` Compilation had errors ``` - - - - - 68bd5e0b by Simon Hengel at 2025-07-26T09:14:33+00:00 Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113) - - - - - 96 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - + compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Error.hs - libraries/base/src/Data/List/NonEmpty.hs - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - testsuite/tests/corelint/T21115b.stderr - + testsuite/tests/cpranal/sigs/T25944.hs - + testsuite/tests/cpranal/sigs/T25944.stderr - testsuite/tests/cpranal/sigs/all.T - testsuite/tests/deriving/should_compile/T20815.hs - testsuite/tests/deriving/should_fail/T12768.stderr - testsuite/tests/deriving/should_fail/T1496.stderr - testsuite/tests/deriving/should_fail/T5498.stderr - testsuite/tests/deriving/should_fail/T7148.stderr - testsuite/tests/deriving/should_fail/T7148a.stderr - testsuite/tests/hiefile/should_run/HieQueries.stdout - testsuite/tests/impredicative/T17332.stderr - + testsuite/tests/lib/stm/T26028.hs - + testsuite/tests/lib/stm/T26028.stdout - + testsuite/tests/lib/stm/all.T - testsuite/tests/quantified-constraints/T15290a.stderr - testsuite/tests/quantified-constraints/T19690.stderr - testsuite/tests/quantified-constraints/T19921.stderr - testsuite/tests/quantified-constraints/T21006.stderr - testsuite/tests/roles/should_fail/RolesIArray.stderr - + testsuite/tests/simplCore/should_compile/T26115.hs - + testsuite/tests/simplCore/should_compile/T26115.stderr - + testsuite/tests/simplCore/should_compile/T26116.hs - + testsuite/tests/simplCore/should_compile/T26116.stderr - + testsuite/tests/simplCore/should_compile/T26117.hs - + testsuite/tests/simplCore/should_compile/T26117.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/T12427a.stderr - testsuite/tests/typecheck/should_compile/T23171.hs - testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr - testsuite/tests/typecheck/should_fail/T14605.hs - testsuite/tests/typecheck/should_fail/T14605.stderr - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640b.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T21530b.stderr - testsuite/tests/typecheck/should_fail/T22912.stderr - testsuite/tests/typecheck/should_fail/tcfail174.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d8559cee8ba5c10ebbeeff1fbc557… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d8559cee8ba5c10ebbeeff1fbc557… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] docs: add since pragma to Data.List.NonEmpty.mapMaybe
by Marge Bot (＠marge-bot) 26 Jul '25

26 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cc1116e0 by Andrew Lelechenko at 2025-07-26T04:55:01-04:00 docs: add since pragma to Data.List.NonEmpty.mapMaybe - - - - - 1 changed file: - libraries/base/src/Data/List/NonEmpty.hs Changes: ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -449,6 +449,8 @@ filter p = List.filter p . toList -- something of type @'Maybe' b@. If this is 'Nothing', no element -- is added on to the result list. If it is @'Just' b@, then @b@ is -- included in the result list. +-- +-- @since 4.23.0.0 mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b] mapMaybe f (x :| xs) = maybe id (:) (f x) $ List.mapMaybe f xs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc1116e06c4cc140f6efd9fb1317a58… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc1116e06c4cc140f6efd9fb1317a58… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
by Marge Bot (＠marge-bot) 26 Jul '25

26 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0776ffe0 by Simon Hengel at 2025-07-26T04:54:20-04:00 Respect `-fdiagnostics-as-json` for core diagnostics (see #24113) - - - - - 3 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Core.Opt.Monad ( getAnnotations, getFirstAnnotations, -- ** Screen output - putMsg, putMsgS, errorMsg, msg, + putMsg, putMsgS, errorMsg, msg, diagnostic, fatalErrorMsg, fatalErrorMsgS, debugTraceMsg, debugTraceMsgS, ) where @@ -41,6 +41,8 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) import GHC.Driver.DynFlags +import GHC.Driver.Errors ( reportDiagnostic, reportError ) +import GHC.Driver.Config.Diagnostic ( initDiagOpts ) import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) @@ -52,7 +54,6 @@ import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Error -import GHC.Utils.Error ( errorDiagnostic ) import GHC.Utils.Outputable as Outputable import GHC.Utils.Logger import GHC.Utils.Monad @@ -383,9 +384,22 @@ putMsgS = putMsg . text putMsg :: SDoc -> CoreM () putMsg = msg MCInfo +diagnostic :: DiagnosticReason -> SDoc -> CoreM () +diagnostic reason doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportDiagnostic logger name_ppr_ctx diag_opts loc reason doc + -- | Output an error to the screen. Does not cause the compiler to die. errorMsg :: SDoc -> CoreM () -errorMsg doc = msg errorDiagnostic doc +errorMsg doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportError logger name_ppr_ctx diag_opts loc doc -- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsgS :: String -> CoreM () ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Core.Make ( mkImpossibleExpr ) import GHC.Unit.Module import GHC.Unit.Module.ModGuts -import GHC.Types.Error (MessageClass(..), Severity(..), DiagnosticReason(WarningWithoutFlag), ResolvedDiagnosticReason (..)) +import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.Literal ( litIsLifted ) import GHC.Types.Id import GHC.Types.Id.Info ( IdDetails(..) ) @@ -783,12 +783,11 @@ specConstrProgram guts ; let (_usg, binds', warnings) = initUs_ us $ scTopBinds env0 (mg_binds guts) - ; when (not (null warnings)) $ msg specConstr_warn_class (warn_msg warnings) + ; when (not (null warnings)) $ diagnostic WarningWithoutFlag (warn_msg warnings) ; return (guts { mg_binds = binds' }) } where - specConstr_warn_class = MCDiagnostic SevWarning (ResolvedDiagnosticReason WarningWithoutFlag) Nothing warn_msg :: SpecFailWarnings -> SDoc warn_msg warnings = text "SpecConstr encountered one or more function(s) with a SPEC argument that resulted in too many arguments," $$ text "which resulted in no specialization being generated for these functions:" $$ ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Config -import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) @@ -53,7 +52,6 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Error -import GHC.Utils.Error ( mkMCDiagnostic ) import GHC.Utils.Monad ( foldlM ) import GHC.Utils.Misc import GHC.Utils.FV @@ -935,10 +933,12 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs | otherwise = return () where + allCallersInlined :: Bool allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - diag_opts = initDiagOpts dflags + + doWarn :: DiagnosticReason -> CoreM () doWarn reason = - msg (mkMCDiagnostic diag_opts reason Nothing) + diagnostic reason (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) | caller <- callers]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0776ffe0bac0dc2525d4b5759634553… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0776ffe0bac0dc2525d4b5759634553… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 6 commits: Renaming around predicate types
by Marge Bot (＠marge-bot) 26 Jul '25

26 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a49eca26 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Renaming around predicate types .. we were (as it turned out) abstracting over type-class selectors in SPECIALISATION rules! Wibble isEqPred - - - - - f80375dd by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Refactor of Specialise.hs This patch just tidies up `specHeader` a bit, removing one of its many results, and adding some comments. No change in behaviour. Also add a few more `HasDebugCallStack` contexts. - - - - - 1bd12371 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Improve treatment of SPECIALISE pragmas -- again! This MR does another major refactor of the way that SPECIALISE pragmas work, to fix #26115, #26116, #26117. * We now /always/ solve forall-constraints in an all-or-nothing way. See Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve This means we might have unsolved quantified constraints, which need to be reported. See `inert_insts` in `getUnsolvedInerts`. * I refactored the short-cut solver for type classes to work by recursively calling the solver rather than by having a little baby solver that kept being not clever enough. See Note [Shortcut solving] in GHC.Tc.Solver.Dict * I totally rewrote the desugaring of SPECIALISE pragmas, again. The new story is in Note [Desugaring new-form SPECIALISE pragmas] in GHC.HsToCore.Binds Both old-form and new-form SPECIALISE pragmas now route through the same function `dsSpec_help`. The tricky function `decomposeRuleLhs` is now used only for user-written RULES, not for SPECIALISE pragmas. * I improved `solveOneFromTheOther` to account for rewriter sets. Previously it would solve a non-rewritten dict from a rewritten one. For equalities we were already dealing with this, in Some incidental refactoring * A small refactor: `ebv_tcvs` in `EvBindsBar` now has a list of coercions, rather than a set of tyvars. We just delay taking the free vars. * GHC.Core.FVs.exprFVs now returns /all/ free vars. Use `exprLocalFVs` for Local vars. Reason: I wanted another variant for /evidence/ variables. * Ues `EvId` in preference to `EvVar`. (Evidence variables are always Ids.) Rename `isEvVar` to `isEvId`. * I moved `inert_safehask` out of `InertCans` and into `InertSet` where it more properly belongs. Compiler-perf changes: * There was a palpable bug (#26117) which this MR fixes in newWantedEvVar, which bypassed all the subtle overlapping-Given and shortcutting logic. (See the new `newWantedEvVar`.) Fixing this but leads to extra dictionary bindings; they are optimised away quickly but they made CoOpt_Read allocate 3.6% more. * Hpapily T15164 improves. * The net compiler-allocation change is 0.0% Metric Decrease: T15164 Metric Increase: CoOpt_Read T12425 - - - - - 953fd8f1 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Solve forall-constraints immediately, or not at all This MR refactors the constraint solver to solve forall-constraints immediately, rather than emitting an implication constraint to be solved later. The most immediate motivation was that when solving quantified constraints in SPECIALISE pragmas, we really really don't want to leave behind half- solved implications. Also it's in tune with the approach of the new short-cut solver, which recursively invokes the solver. It /also/ saves quite a bit of plumbing; e.g - The `wl_implics` field of `WorkList` is gone, - The types of `solveSimpleWanteds` and friends are simplified. - An EvFun contains binding, rather than an EvBindsVar ref-cell that will in the future contain bindings. That makes `evVarsOfTerm` simpler. Much nicer. It also improves error messages a bit. All described in Note [Solving a Wanted forall-constraint] in GHC.Tc.Solver.Solve. One tiresome point: in the tricky case of `inferConstraintsCoerceBased` we make a forall-constraint. This we /do/ want to partially solve, so we can infer a suitable context. (I'd be quite happy to force the user to write a context, bt I don't want to change behavior.) So we want to generate an /implication/ constraint in `emitPredSpecConstraints` rather than a /forall-constraint/ as we were doing before. Discussed in (WFA3) of the above Note. Incidental refactoring * `GHC.Tc.Deriv.Infer.inferConstraints` was consulting the state monad for the DerivEnv that the caller had just consulted. Nicer to pass it as an argument I think, so I have done that. No change in behaviour. - - - - - 6921ab42 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Remove duplicated code in Ast.hs for evTermFreeVars This is just a tidy up. - - - - - 1165f587 by Simon Peyton Jones at 2025-07-25T09:49:58+01:00 Small tc-tracing changes only - - - - - 77 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - + compiler/GHC/Tc/Solver/Solve.hs-boot - compiler/GHC/Tc/Solver/Types.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Var.hs - testsuite/tests/deriving/should_compile/T20815.hs - testsuite/tests/deriving/should_fail/T12768.stderr - testsuite/tests/deriving/should_fail/T1496.stderr - testsuite/tests/deriving/should_fail/T5498.stderr - testsuite/tests/deriving/should_fail/T7148.stderr - testsuite/tests/deriving/should_fail/T7148a.stderr - testsuite/tests/hiefile/should_run/HieQueries.stdout - testsuite/tests/impredicative/T17332.stderr - testsuite/tests/quantified-constraints/T15290a.stderr - testsuite/tests/quantified-constraints/T19690.stderr - testsuite/tests/quantified-constraints/T19921.stderr - testsuite/tests/quantified-constraints/T21006.stderr - testsuite/tests/roles/should_fail/RolesIArray.stderr - + testsuite/tests/simplCore/should_compile/T26115.hs - + testsuite/tests/simplCore/should_compile/T26115.stderr - + testsuite/tests/simplCore/should_compile/T26116.hs - + testsuite/tests/simplCore/should_compile/T26116.stderr - + testsuite/tests/simplCore/should_compile/T26117.hs - + testsuite/tests/simplCore/should_compile/T26117.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/T12427a.stderr - testsuite/tests/typecheck/should_compile/T23171.hs - testsuite/tests/typecheck/should_compile/TcSpecPragmas.stderr - testsuite/tests/typecheck/should_fail/T14605.hs - testsuite/tests/typecheck/should_fail/T14605.stderr - testsuite/tests/typecheck/should_fail/T15801.stderr - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640b.stderr - testsuite/tests/typecheck/should_fail/T19627.stderr - testsuite/tests/typecheck/should_fail/T21530b.stderr - testsuite/tests/typecheck/should_fail/T22912.stderr - testsuite/tests/typecheck/should_fail/tcfail174.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a5836891ca29836a24c306d2a364c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a5836891ca29836a24c306d2a364c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
by Marge Bot (＠marge-bot) 26 Jul '25

26 Jul '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9c630dd5 by Simon Hengel at 2025-07-26T00:13:16-04:00 Respect `-fdiagnostics-as-json` for core diagnostics (see #24113) - - - - - 79236c00 by Andrew Lelechenko at 2025-07-26T00:13:17-04:00 docs: add since pragma to Data.List.NonEmpty.mapMaybe - - - - - 4 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - libraries/base/src/Data/List/NonEmpty.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Core.Opt.Monad ( getAnnotations, getFirstAnnotations, -- ** Screen output - putMsg, putMsgS, errorMsg, msg, + putMsg, putMsgS, errorMsg, msg, diagnostic, fatalErrorMsg, fatalErrorMsgS, debugTraceMsg, debugTraceMsgS, ) where @@ -41,6 +41,8 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) import GHC.Driver.DynFlags +import GHC.Driver.Errors ( reportDiagnostic, reportError ) +import GHC.Driver.Config.Diagnostic ( initDiagOpts ) import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) @@ -52,7 +54,6 @@ import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Error -import GHC.Utils.Error ( errorDiagnostic ) import GHC.Utils.Outputable as Outputable import GHC.Utils.Logger import GHC.Utils.Monad @@ -383,9 +384,22 @@ putMsgS = putMsg . text putMsg :: SDoc -> CoreM () putMsg = msg MCInfo +diagnostic :: DiagnosticReason -> SDoc -> CoreM () +diagnostic reason doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportDiagnostic logger name_ppr_ctx diag_opts loc reason doc + -- | Output an error to the screen. Does not cause the compiler to die. errorMsg :: SDoc -> CoreM () -errorMsg doc = msg errorDiagnostic doc +errorMsg doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportError logger name_ppr_ctx diag_opts loc doc -- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsgS :: String -> CoreM () ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Core.Make ( mkImpossibleExpr ) import GHC.Unit.Module import GHC.Unit.Module.ModGuts -import GHC.Types.Error (MessageClass(..), Severity(..), DiagnosticReason(WarningWithoutFlag), ResolvedDiagnosticReason (..)) +import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.Literal ( litIsLifted ) import GHC.Types.Id import GHC.Types.Id.Info ( IdDetails(..) ) @@ -783,12 +783,11 @@ specConstrProgram guts ; let (_usg, binds', warnings) = initUs_ us $ scTopBinds env0 (mg_binds guts) - ; when (not (null warnings)) $ msg specConstr_warn_class (warn_msg warnings) + ; when (not (null warnings)) $ diagnostic WarningWithoutFlag (warn_msg warnings) ; return (guts { mg_binds = binds' }) } where - specConstr_warn_class = MCDiagnostic SevWarning (ResolvedDiagnosticReason WarningWithoutFlag) Nothing warn_msg :: SpecFailWarnings -> SDoc warn_msg warnings = text "SpecConstr encountered one or more function(s) with a SPEC argument that resulted in too many arguments," $$ text "which resulted in no specialization being generated for these functions:" $$ ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Config -import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) @@ -53,7 +52,6 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Error -import GHC.Utils.Error ( mkMCDiagnostic ) import GHC.Utils.Monad ( foldlM ) import GHC.Utils.Misc import GHC.Utils.FV @@ -935,10 +933,12 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs | otherwise = return () where + allCallersInlined :: Bool allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - diag_opts = initDiagOpts dflags + + doWarn :: DiagnosticReason -> CoreM () doWarn reason = - msg (mkMCDiagnostic diag_opts reason Nothing) + diagnostic reason (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) | caller <- callers]) ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -449,6 +449,8 @@ filter p = List.filter p . toList -- something of type @'Maybe' b@. If this is 'Nothing', no element -- is added on to the result list. If it is @'Just' b@, then @b@ is -- included in the result list. +-- +-- @since 4.23.0.0 mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b] mapMaybe f (x :| xs) = maybe id (:) (f x) $ List.mapMaybe f xs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b797aa99e6efd8975d049a27819caf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b797aa99e6efd8975d049a27819caf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
by Marge Bot (＠marge-bot) 26 Jul '25

26 Jul '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c3df697a by Simon Hengel at 2025-07-25T19:27:40-04:00 Respect `-fdiagnostics-as-json` for core diagnostics (see #24113) - - - - - b797aa99 by Andrew Lelechenko at 2025-07-25T19:27:41-04:00 docs: add since pragma to Data.List.NonEmpty.mapMaybe - - - - - 4 changed files: - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - libraries/base/src/Data/List/NonEmpty.hs Changes: ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Core.Opt.Monad ( getAnnotations, getFirstAnnotations, -- ** Screen output - putMsg, putMsgS, errorMsg, msg, + putMsg, putMsgS, errorMsg, msg, diagnostic, fatalErrorMsg, fatalErrorMsgS, debugTraceMsg, debugTraceMsgS, ) where @@ -41,6 +41,8 @@ module GHC.Core.Opt.Monad ( import GHC.Prelude hiding ( read ) import GHC.Driver.DynFlags +import GHC.Driver.Errors ( reportDiagnostic, reportError ) +import GHC.Driver.Config.Diagnostic ( initDiagOpts ) import GHC.Driver.Env import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv ) @@ -52,7 +54,6 @@ import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Error -import GHC.Utils.Error ( errorDiagnostic ) import GHC.Utils.Outputable as Outputable import GHC.Utils.Logger import GHC.Utils.Monad @@ -383,9 +384,22 @@ putMsgS = putMsg . text putMsg :: SDoc -> CoreM () putMsg = msg MCInfo +diagnostic :: DiagnosticReason -> SDoc -> CoreM () +diagnostic reason doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportDiagnostic logger name_ppr_ctx diag_opts loc reason doc + -- | Output an error to the screen. Does not cause the compiler to die. errorMsg :: SDoc -> CoreM () -errorMsg doc = msg errorDiagnostic doc +errorMsg doc = do + logger <- getLogger + loc <- getSrcSpanM + name_ppr_ctx <- getNamePprCtx + diag_opts <- initDiagOpts <$> getDynFlags + liftIO $ reportError logger name_ppr_ctx diag_opts loc doc -- | Output a fatal error to the screen. Does not cause the compiler to die. fatalErrorMsgS :: String -> CoreM () ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Core.Make ( mkImpossibleExpr ) import GHC.Unit.Module import GHC.Unit.Module.ModGuts -import GHC.Types.Error (MessageClass(..), Severity(..), DiagnosticReason(WarningWithoutFlag), ResolvedDiagnosticReason (..)) +import GHC.Types.Error (DiagnosticReason(..)) import GHC.Types.Literal ( litIsLifted ) import GHC.Types.Id import GHC.Types.Id.Info ( IdDetails(..) ) @@ -783,12 +783,11 @@ specConstrProgram guts ; let (_usg, binds', warnings) = initUs_ us $ scTopBinds env0 (mg_binds guts) - ; when (not (null warnings)) $ msg specConstr_warn_class (warn_msg warnings) + ; when (not (null warnings)) $ diagnostic WarningWithoutFlag (warn_msg warnings) ; return (guts { mg_binds = binds' }) } where - specConstr_warn_class = MCDiagnostic SevWarning (ResolvedDiagnosticReason WarningWithoutFlag) Nothing warn_msg :: SpecFailWarnings -> SDoc warn_msg warnings = text "SpecConstr encountered one or more function(s) with a SPEC argument that resulted in too many arguments," $$ text "which resulted in no specialization being generated for these functions:" $$ ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Config -import GHC.Driver.Config.Diagnostic import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) @@ -53,7 +52,6 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Error -import GHC.Utils.Error ( mkMCDiagnostic ) import GHC.Utils.Monad ( foldlM ) import GHC.Utils.Misc import GHC.Utils.FV @@ -935,10 +933,12 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs | otherwise = return () where + allCallersInlined :: Bool allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - diag_opts = initDiagOpts dflags + + doWarn :: DiagnosticReason -> CoreM () doWarn reason = - msg (mkMCDiagnostic diag_opts reason Nothing) + diagnostic reason (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) | caller <- callers]) ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -449,6 +449,8 @@ filter p = List.filter p . toList -- something of type @'Maybe' b@. If this is 'Nothing', no element -- is added on to the result list. If it is @'Just' b@, then @b@ is -- included in the result list. +-- +-- @since 4.23.0.0 mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b] mapMaybe f (x :| xs) = maybe id (:) (f x) $ List.mapMaybe f xs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d11d023ace7678b476e210012dd314… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d11d023ace7678b476e210012dd314… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/26227] 6 commits: ghc-toolchain: Move TgtHasLibm to per-Target file
by Rodrigo Mesquita (＠alt-romes) 25 Jul '25

25 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/26227 at Glasgow Haskell Compiler / GHC Commits: 22cd34a7 by Rodrigo Mesquita at 2025-07-25T22:12:57+01:00 ghc-toolchain: Move TgtHasLibm to per-Target file TargetHasLibm is now part of the per-target configuration Towards #26227 - - - - - 327d381e by Rodrigo Mesquita at 2025-07-25T22:12:57+01:00 ghc-toolchain: Move UseLibdw to per-Target file To support DWARF unwinding, the RTS must be built with the -f+libdw flag and with the -DUSE_LIBDW macro definition. These flags are passed on build by Hadrian when --enable-dwarf-unwinding is specified at configure time. Whether the RTS was built with support for DWARF is a per-target property, and as such, it was moved to the per-target GHC.Toolchain.Target.Target file. Additionally, we keep in the target file the include and library paths for finding libdw, since libdw should be checked at configure time (be it by configure, or ghc-toolchain, that libdw is properly available). Preserving the user-given include paths for libdw facilitates in the future building the RTS on demand for a given target (if we didn't keep that user input, we couldn't) Towards #26227 - - - - - cff62809 by Rodrigo Mesquita at 2025-07-25T22:12:57+01:00 ghc-toolchain: Make "Support SMP" a query on a Toolchain.Target "Support SMP" is merely a function of target, so we can represent it as such in `ghc-toolchain`. Hadrian queries the Target using this predicate to determine how to build GHC, and GHC queries the Target similarly to report under --info whether it "Support SMP" Towards #26227 - - - - - e1913a77 by Rodrigo Mesquita at 2025-07-25T22:12:57+01:00 ghc-toolchain: Make "tgt rts linker only supports shared libs" function on Target Just like with "Support SMP", "target RTS linker only supports shared libraries" is a predicate on a `Target` so we can just compute it when necessary from the given `Target`. Towards #26227 - - - - - 2787b0ee by Rodrigo Mesquita at 2025-07-25T22:12:57+01:00 WIP on Use interpreter - - - - - 281d5506 by Rodrigo Mesquita at 2025-07-25T22:12:58+01:00 Revert "WIP on Use interpreter" This reverts commit 94ed0d7fbd3f9eb59269607892f4b84cee25e6fd. - - - - - 19 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_find_libdw.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - + utils/ghc-toolchain/src/GHC/Toolchain/Library.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3498,8 +3498,10 @@ compilerInfo dflags ("target word size", query $ show . wordSize2Bytes . tgtWordSize), ("target word big endian", queryBool $ (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness), ("target has GNU nonexec stack", queryBool tgtSupportsGnuNonexecStack), + ("target has libm", queryBool tgtHasLibm), ("target has .ident directive", queryBool tgtSupportsIdentDirective), ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("target RTS linker only supports shared libraries", queryBool tgtRTSLinkerOnlySupportsSharedLibs), ("Unregisterised", queryBool tgtUnregisterised), ("LLVM target", query tgtLlvmTarget), ("LLVM llc command", queryCmdMaybe id tgtLlc), @@ -3507,7 +3509,8 @@ compilerInfo dflags ("LLVM llvm-as command", queryCmdMaybe id tgtLlvmAs), ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), ("Tables next to code", queryBool tgtTablesNextToCode), - ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore), + ("RTS expects libdw", queryBool (isJust . tgtRTSWithLibdw)) ] ++ [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), @@ -3544,6 +3547,7 @@ compilerInfo dflags -- If true, we require that the 'id' field in installed package info -- match what is passed to the @-this-unit-id@ flag for modules -- built in it + ("Support SMP", queryBool tgtSupportsSMP), ("Requires unified installed package IDs", "YES"), -- Whether or not we support the @-this-package-key@ flag. Prefer -- "Uses unit IDs" over it. We still say yes even if @-this-package-key@ ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -97,10 +97,6 @@ initSettings top_dir = do getTool :: (Target -> Program) -> (String, [String]) getTool key = (getToolPath key, getToolFlags key) - -- See Note [Settings file] for a little more about this file. We're - -- just partially applying those functions and throwing 'Left's; they're - -- written in a very portable style to keep ghc-boot light. - targetHasLibm <- getBooleanSetting "target has libm" let (cc_prog, cc_args0) = getTool (ccProgram . tgtCCompiler) (cxx_prog, cxx_args) = getTool (cxxProgram . tgtCxxCompiler) @@ -109,7 +105,7 @@ initSettings top_dir = do (js_cpp_prog, js_cpp_args) = getTool (maybe (Program "" []) jsCppProgram . tgtJsCPreprocessor) (cmmCpp_prog, cmmCpp_args) = getTool (cmmCppProgram . tgtCmmCPreprocessor) - platform = getTargetPlatform targetHasLibm target + platform = getTargetPlatform target unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] @@ -150,7 +146,6 @@ initSettings top_dir = do pure (ld_r_path, map Option ld_r_args) iserv_prog = libexec "ghc-iserv" - targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries" ghcWithInterpreter <- getBooleanSetting "Use interpreter" baseUnitId <- getSetting_raw "base unit-id" @@ -235,15 +230,15 @@ initSettings top_dir = do , platformMisc_ghcWithInterpreter = ghcWithInterpreter , platformMisc_libFFI = tgtUseLibffiForAdjustors target , platformMisc_llvmTarget = tgtLlvmTarget target - , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs + , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = tgtRTSLinkerOnlySupportsSharedLibs target } , sRawSettings = settingsList , sRawTarget = target } -getTargetPlatform :: Bool {-^ Does target have libm -} -> Target -> Platform -getTargetPlatform targetHasLibm Target{..} = Platform +getTargetPlatform :: Target -> Platform +getTargetPlatform Target{..} = Platform { platformArchOS = tgtArchOs , platformWordSize = case tgtWordSize of WS4 -> PW4 WS8 -> PW8 @@ -255,6 +250,6 @@ getTargetPlatform targetHasLibm Target{..} = Platform , platformIsCrossCompiling = not tgtLocallyExecutable , platformLeadingUnderscore = tgtSymbolsHaveLeadingUnderscore , platformTablesNextToCode = tgtTablesNextToCode - , platformHasLibm = targetHasLibm + , platformHasLibm = tgtHasLibm , platform_constants = Nothing -- will be filled later when loading (or building) the RTS unit } ===================================== hadrian/bindist/Makefile ===================================== @@ -85,13 +85,9 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("target has libm", "$(TargetHasLibm)")' >> $@ - @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ + @echo '[("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ - @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ - @echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -172,7 +172,7 @@ UseLibffiForAdjustors=@UseLibffiForAdjustors@ # GHC needs arch-specific tweak at least in # rts/Libdw.c:set_initial_registers() -GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) +UseLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x),@UseLibdw@,NO)) #----------------------------------------------------------------------------- # Settings ===================================== hadrian/cfg/default.host.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = False , tgtTablesNextToCode = True , tgtUseLibffiForAdjustors = True +, tgtHasLibm = True +, tgtRTSWithLibdw = Nothing , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} ===================================== hadrian/cfg/default.target.in ===================================== @@ -12,6 +12,8 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtHasLibm = @TargetHasLibmBool@ +, tgtRTSWithLibdw = @UseLibdwMaybeLibrary@ , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC@", prgFlags = @CONF_CC_OPTS_STAGE2List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CXX@", prgFlags = @CONF_CXX_OPTS_STAGE2List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE2List@}} ===================================== hadrian/cfg/system.config.in ===================================== @@ -81,8 +81,6 @@ project-git-commit-id = @ProjectGitCommitId@ # See Note [tooldir: How GHC finds mingw on Windows] settings-use-distro-mingw = @EnableDistroToolchain@ -target-has-libm = @TargetHasLibm@ - # Include and library directories: #================================= @@ -101,9 +99,6 @@ use-system-ffi = @UseSystemLibFFI@ ffi-include-dir = @FFIIncludeDir@ ffi-lib-dir = @FFILibDir@ -libdw-include-dir = @LibdwIncludeDir@ -libdw-lib-dir = @LibdwLibDir@ - libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ @@ -113,7 +108,6 @@ libzstd-lib-dir = @LibZstdLibDir@ # Optional Dependencies: #======================= -use-lib-dw = @UseLibdw@ use-lib-zstd = @UseLibZstd@ static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Flag ( targetRTSLinkerOnlySupportsSharedLibs, targetSupportsThreadedRts, targetSupportsSMP, - useLibffiForAdjustors, + useLibffiForAdjustors, useLibdw, arSupportsDashL, arSupportsAtFile ) where @@ -29,7 +29,6 @@ data Flag = CrossCompiling | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts - | UseLibdw | UseLibnuma | UseLibzstd | StaticLibzstd @@ -53,7 +52,6 @@ flag f = do UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" - UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" UseLibzstd -> "use-lib-zstd" StaticLibzstd -> "static-lib-zstd" @@ -82,23 +80,8 @@ platformSupportsGhciObjects = do only_shared_libs <- targetRTSLinkerOnlySupportsSharedLibs pure $ has_merge_objs && not only_shared_libs --- | Does the target RTS linker only support loading shared libraries? --- If true, this has several implications: --- 1. The GHC driver must not do loadArchive/loadObj etc and must --- always do loadDLL, regardless of whether host GHC is dynamic or --- not. --- 2. The GHC driver will always enable -dynamic-too when compiling --- vanilla way with TH codegen requirement. --- 3. ghci will always enforce dynamic ways even if -dynamic or --- -dynamic-too is not explicitly passed. --- 4. Cabal must not build ghci objects since it's not supported by --- the target. --- 5. The testsuite driver will use dyn way for TH/ghci tests even --- when host GHC is static. --- 6. TH/ghci doesn't work if stage1 is built without shared libraries --- (e.g. quickest/fully_static). targetRTSLinkerOnlySupportsSharedLibs :: Action Bool -targetRTSLinkerOnlySupportsSharedLibs = anyTargetArch [ ArchWasm32 ] +targetRTSLinkerOnlySupportsSharedLibs = queryTargetTarget Toolchain.tgtRTSLinkerOnlySupportsSharedLibs arSupportsDashL :: Stage -> Action Bool arSupportsDashL stage = Toolchain.arSupportsDashL . tgtAr <$> targetStage stage @@ -123,27 +106,10 @@ targetSupportsThreadedRts = do -- | Does the target support the -N RTS flag? targetSupportsSMP :: Action Bool -targetSupportsSMP = do - unreg <- queryTargetTarget tgtUnregisterised - armVer <- targetArmVersion - goodArch <- (||) <$> - anyTargetArch [ ArchX86 - , ArchX86_64 - , ArchPPC - , ArchPPC_64 ELF_V1 - , ArchPPC_64 ELF_V2 - , ArchAArch64 - , ArchS390X - , ArchRISCV64 - , ArchLoongArch64 ] <*> isArmTarget - if -- The THREADED_RTS requires `BaseReg` to be in a register and the - -- Unregisterised mode doesn't allow that. - | unreg -> return False - -- We don't support load/store barriers pre-ARMv7. See #10433. - | Just ver <- armVer - , ver < ARMv7 -> return False - | goodArch -> return True - | otherwise -> return False +targetSupportsSMP = queryTargetTarget Toolchain.tgtSupportsSMP useLibffiForAdjustors :: Action Bool useLibffiForAdjustors = queryTargetTarget tgtUseLibffiForAdjustors + +useLibdw :: Action Bool +useLibdw = queryTargetTarget (isJust . tgtRTSWithLibdw) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -54,8 +54,6 @@ data Setting = CursesIncludeDir | GmpLibDir | IconvIncludeDir | IconvLibDir - | LibdwIncludeDir - | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir | LibZstdIncludeDir @@ -94,8 +92,6 @@ setting key = lookupSystemConfig $ case key of GmpLibDir -> "gmp-lib-dir" IconvIncludeDir -> "iconv-include-dir" IconvLibDir -> "iconv-lib-dir" - LibdwIncludeDir -> "libdw-include-dir" - LibdwLibDir -> "libdw-lib-dir" LibnumaIncludeDir -> "libnuma-include-dir" LibnumaLibDir -> "libnuma-lib-dir" LibZstdIncludeDir -> "libzstd-include-dir" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -427,12 +427,12 @@ bindistRules = do , interpolateSetting "ProjectVersion" ProjectVersion , interpolateVar "EnableDistroToolchain" $ lookupSystemConfig "settings-use-distro-mingw" , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode - , interpolateVar "TargetHasLibm" $ lookupSystemConfig "target-has-libm" + , interpolateVar "TargetHasLibm" $ yesNo <$> getTarget tgtHasLibm , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised - , interpolateVar "UseLibdw" $ fmap yesNo $ interp $ getFlag UseLibdw + , interpolateVar "UseLibdw" $ yesNo <$> getTarget (isJust . tgtRTSWithLibdw) , interpolateVar "UseLibffiForAdjustors" $ yesNo <$> getTarget tgtUseLibffiForAdjustors , interpolateVar "GhcWithSMP" $ yesNo <$> targetSupportsSMP , interpolateVar "BaseUnitId" $ pkgUnitId Stage1 base @@ -484,12 +484,8 @@ generateSettings settingsFile = do settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("target has libm", expr $ lookupSystemConfig "target-has-libm") - , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) - , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) ] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target import GHC.Platform.ArchOS import Data.Version.Extra @@ -304,8 +305,8 @@ rtsPackageArgs = package rts ? do useSystemFfi <- getFlag UseSystemFfi ffiIncludeDir <- getSetting FfiIncludeDir ffiLibraryDir <- getSetting FfiLibDir - libdwIncludeDir <- getSetting LibdwIncludeDir - libdwLibraryDir <- getSetting LibdwLibDir + libdwIncludeDir <- queryTarget (Lib.includePath <=< tgtRTSWithLibdw) + libdwLibraryDir <- queryTarget (Lib.libraryPath <=< tgtRTSWithLibdw) libnumaIncludeDir <- getSetting LibnumaIncludeDir libnumaLibraryDir <- getSetting LibnumaLibDir libzstdIncludeDir <- getSetting LibZstdIncludeDir @@ -443,7 +444,7 @@ rtsPackageArgs = package rts ? do , flag UseLibpthread `cabalFlag` "need-pthread" , flag UseLibbfd `cabalFlag` "libbfd" , flag NeedLibatomic `cabalFlag` "need-atomic" - , flag UseLibdw `cabalFlag` "libdw" + , useLibdw `cabalFlag` "libdw" , flag UseLibnuma `cabalFlag` "libnuma" , flag UseLibzstd `cabalFlag` "libzstd" , flag StaticLibzstd `cabalFlag` "static-libzstd" @@ -453,7 +454,7 @@ rtsPackageArgs = package rts ? do , Debug `wayUnit` way `cabalFlag` "find-ptr" ] , builder (Cabal Setup) ? mconcat - [ cabalExtraDirs libdwIncludeDir libdwLibraryDir + [ useLibdw ? cabalExtraDirs (fromMaybe "" libdwIncludeDir) (fromMaybe "" libdwLibraryDir) , cabalExtraDirs libnumaIncludeDir libnumaLibraryDir , cabalExtraDirs libzstdIncludeDir libzstdLibraryDir , useSystemFfi ? cabalExtraDirs ffiIncludeDir ffiLibraryDir @@ -467,7 +468,7 @@ rtsPackageArgs = package rts ? do , builder HsCpp ? pure [ "-DTOP=" ++ show top ] - , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW" ] + , builder HsCpp ? useLibdw ? arg "-DUSE_LIBDW" ] -- Compile various performance-critical pieces *without* -fPIC -dynamic -- even when building a shared library. If we don't do this, then the ===================================== m4/fp_find_libdw.m4 ===================================== @@ -29,11 +29,11 @@ AC_DEFUN([FP_FIND_LIBDW], AC_ARG_ENABLE(dwarf-unwind, [AS_HELP_STRING([--enable-dwarf-unwind], [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])], - [], - [enable_dwarf_unwind=no]) + [FP_CAPITALIZE_YES_NO(["$enableval"], [enable_dwarf_unwind])], + [enable_dwarf_unwind=NO]) UseLibdw=NO - if test "$enable_dwarf_unwind" != "no" ; then + if test "$enable_dwarf_unwind" != "NO" ; then CFLAGS2="$CFLAGS" CFLAGS="$LIBDW_CFLAGS $CFLAGS" LDFLAGS2="$LDFLAGS" @@ -43,7 +43,7 @@ AC_DEFUN([FP_FIND_LIBDW], [AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES])]) - if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:yes:NO" ; then + if test "x:$enable_dwarf_unwind:$UseLibdw" = "x:YES:NO" ; then AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)]) fi ===================================== m4/ghc_toolchain.m4 ===================================== @@ -120,6 +120,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + ENABLE_GHC_TOOLCHAIN_ARG([dwarf-unwind], [$enable_dwarf_unwind]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS]) @@ -130,6 +131,8 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([js-cpp-opt], [$USER_JS_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([cmm-cpp-opt], [$USER_CMM_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([libdw-includes], [$LibdwIncludeDir]) + ADD_GHC_TOOLCHAIN_ARG([libdw-libraries], [$LibdwLibDir]) INVOKE_GHC_TOOLCHAIN() ===================================== m4/prep_target_file.m4 ===================================== @@ -78,6 +78,22 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) +# PREP_MAYBE_LIBRARY +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty or "NO" +# * Just the library otherwise +AC_DEFUN([PREP_MAYBE_LIBRARY],[ + if test -z "$$1" || test "$$1" = "NO"; then + $1MaybeLibrary=Nothing + else + PREP_LIST([$2]) + $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })" + fi + AC_SUBST([$1MaybeLibrary]) +]) + # PREP_MAYBE_STRING # ========================= # @@ -157,6 +173,7 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([Unregisterised]) PREP_BOOLEAN([TablesNextToCode]) PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([TargetHasLibm]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) PREP_NOT_BOOLEAN([CrossCompiling]) @@ -179,6 +196,10 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE2]) PREP_LIST([CONF_CC_OPTS_STAGE2]) + PREP_MAYBE_STRING([LibdwIncludeDir]) + PREP_MAYBE_STRING([LibdwLibDir]) + PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr]) + dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) PREP_BOOLEAN([ArSupportsDashL_STAGE0]) @@ -188,7 +209,6 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CXX_OPTS_STAGE0]) PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE0]) - if test -z "$MergeObjsCmd"; then MergeObjsCmdMaybe=Nothing else ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -62,6 +62,12 @@ data Opts = Opts -- see #23857 and #22550 for the very unfortunate story. , optLd :: ProgOpt , optUnregisterised :: Maybe Bool + + -- dwarf unwinding + , optDwarfUnwind :: Maybe Bool + , optLibdwIncludes :: Maybe FilePath + , optLibdwLibraries :: Maybe FilePath + , optTablesNextToCode :: Maybe Bool , optUseLibFFIForAdjustors :: Maybe Bool , optLdOverride :: Maybe Bool @@ -112,6 +118,9 @@ emptyOpts = Opts , optOtool = po0 , optInstallNameTool = po0 , optUnregisterised = Nothing + , optDwarfUnwind = Nothing + , optLibdwIncludes = Nothing + , optLibdwLibraries = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing , optLdOverride = Nothing @@ -157,13 +166,18 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride, _optDwarfUnwind :: Lens Opts (Maybe Bool) _optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) +_optDwarfUnwind = Lens optDwarfUnwind (\x o -> o {optDwarfUnwind=x}) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) +_optLibdwIncludes, _optLibdwLibraries :: Lens Opts (Maybe FilePath) +_optLibdwIncludes = Lens optLibdwIncludes (\x o -> o {optLibdwIncludes=x}) +_optLibdwLibraries = Lens optLibdwLibraries (\x o -> o {optLibdwLibraries=x}) + _optVerbosity :: Lens Opts Int _optVerbosity = Lens optVerbosity (\x o -> o {optVerbosity=x}) @@ -185,6 +199,7 @@ options = , enableDisable "libffi-adjustors" "the use of libffi for adjustors, even on platforms which have support for more efficient, native adjustor implementations." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride , enableDisable "locally-executable" "the use of a target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable + , enableDisable "dwarf-unwind" "Enable DWARF unwinding support in the runtime system via elfutils' libdw" _optDwarfUnwind ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -206,6 +221,9 @@ options = , progOpts "ld" "linker" _optLd , progOpts "otool" "otool utility" _optOtool , progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool + ] ++ + [ Option [] ["libdw-includes"] (ReqArg (set _optLibdwIncludes . Just) "PATH") "Look for libdw headers in this extra path" + , Option [] ["libdw-libraries"] (ReqArg (set _optLibdwLibraries . Just) "PATH") "Look for the libdw library in this extra path" ] where progOpts :: String -> String -> Lens Opts ProgOpt -> [OptDescr (Opts -> Opts)] @@ -486,6 +504,10 @@ mkTarget opts = do tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc + tgtHasLibm <- checkTargetHasLibm cc + tgtRTSWithLibdw <- case optDwarfUnwind opts of + Just True -> checkTargetHasLibdw cc (optLibdwIncludes opts) (optLibdwLibraries opts) + _ -> pure Nothing -- code generator configuration tgtUnregisterised <- determineUnregisterised archOs (optUnregisterised opts) @@ -526,6 +548,8 @@ mkTarget opts = do , tgtUnregisterised , tgtTablesNextToCode , tgtUseLibffiForAdjustors = tgtUseLibffi + , tgtHasLibm + , tgtRTSWithLibdw , tgtSymbolsHaveLeadingUnderscore , tgtSupportsSubsectionsViaSymbols , tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -12,6 +12,7 @@ library exposed-modules: GHC.Toolchain, GHC.Toolchain.Lens, + GHC.Toolchain.Library, GHC.Toolchain.Monad, GHC.Toolchain.PlatformDetails, GHC.Toolchain.Prelude, ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Library.hs ===================================== @@ -0,0 +1,22 @@ +module GHC.Toolchain.Library + ( Library(..) + ) + where + +import System.FilePath +import GHC.Toolchain.Prelude + +data Library = Library { libName :: String + , includePath :: Maybe FilePath + , libraryPath :: Maybe FilePath + } + deriving (Read, Eq, Ord) + +instance Show Library where + -- Normalise filepaths before showing to aid with diffing the target files. + show (Library n i l) = unwords + [ "Library { libName = ", show n + , ", includePath = ", show (normalise <$> i) + , ", libraryPath =", show (normalise <$> l) + , "}"] + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -5,6 +5,8 @@ module GHC.Toolchain.PlatformDetails , checkSubsectionsViaSymbols , checkIdentDirective , checkGnuNonexecStack + , checkTargetHasLibm + , checkTargetHasLibdw ) where import Data.List (isInfixOf) @@ -16,6 +18,7 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Utils import GHC.Toolchain.Target import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Nm @@ -112,8 +115,6 @@ checkEndianness__BYTE_ORDER__ cc = checking "endianness (__BYTE_ORDER__)" $ do , "#endif" ] - - checkLeadingUnderscore :: Cc -> Nm -> M Bool checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do let test_o = dir </> "test.o" @@ -156,12 +157,68 @@ checkGnuNonexecStack archOs = , asmStmt ".section .text" ] +checkTargetHasLibm :: Cc -> M Bool +checkTargetHasLibm cc = testLib cc "m" "atan" Nothing + +checkTargetHasLibdw :: Cc -> Maybe FilePath -> Maybe FilePath -> M (Maybe Library) +checkTargetHasLibdw cc mincludeDir mlibDir = do + b1 <- testHeader cc "elfutils/libdwfl.h" mincludeDir + b2 <- testLib cc "dw" "dwfl_attach_state" mlibDir + return $ + if b1 && b2 + then Just + Library{ libName = "dw" + , includePath = mincludeDir, libraryPath = mlibDir} + else Nothing + + +-------------------------------------------------------------------------------- +-- Utilities +-------------------------------------------------------------------------------- + asmStmt :: String -> String asmStmt s = "__asm__(\"" ++ foldMap escape s ++ "\");" where escape '"' = "\\\"" escape c = [c] +-- | Check whether a lib is found and can be linked against. +-- Like @AC_CHECK_LIB@. +testLib :: Cc + -> String -- ^ Lib name + -> String -- ^ Lib symbol + -> Maybe FilePath -- ^ Library dir (-L) + -> M Bool +testLib cc0 libname symbol mlibDir = testCompile ("whether target has lib" ++ libname) prog cc2 + where + cc1 = cc0 & _ccProgram % _prgFlags %++ ("-l" ++ libname) + cc2 | Just libDir <- mlibDir + = cc1 & _ccProgram % _prgFlags %++ ("-L" ++ libDir) + | otherwise = cc1 + prog = unlines + [ "char " ++ symbol ++ " (void);" + , "int" + , "main (void)" + , "{" + , "return " ++ symbol ++ " ();" + , " ;" + , " return 0;" + , "}" + ] + +-- | Like @AC_CHECK_HEADER@ +testHeader :: Cc + -> String -- ^ Header to check for + -> Maybe FilePath -- ^ Extra path + -> M Bool +testHeader cc0 header mincludeDir = testCompile ("whether target has <" ++ header ++ ">") prog cc1 + where + cc1 | Just includeDir <- mincludeDir + = cc0 & _ccProgram % _prgFlags %++ ("-I" ++ includeDir) + | otherwise = cc0 + prog = unlines + [ "#include <" ++ header ++ ">" ] + -- | Try compiling a program, returning 'True' if successful. testCompile :: String -> String -> Cc -> M Bool testCompile what program cc = checking what $ withTempDir $ \dir -> do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE MultiWayIf #-} module GHC.Toolchain.Target ( -- * A Toolchain Target @@ -7,6 +8,9 @@ module GHC.Toolchain.Target , WordSize(..), wordSize2Bytes + -- ** Queries + , tgtSupportsSMP, tgtRTSLinkerOnlySupportsSharedLibs + -- ** Lenses , _tgtCC, _tgtCxx, _tgtCpp, _tgtHsCpp @@ -19,6 +23,7 @@ import GHC.Platform.ArchOS import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Library import GHC.Toolchain.Tools.Cc import GHC.Toolchain.Tools.Cxx @@ -56,6 +61,13 @@ data Target = Target -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping , tgtUseLibffiForAdjustors :: Bool -- ^ We need to know whether or not to include libffi headers, and generate additional code for it + , tgtHasLibm :: Bool + -- ^ Does this target have a libm library that should always be linked against? + + -- RTS capabilities + , tgtRTSWithLibdw :: Maybe Library + -- ^ Whether this target RTS is built with libdw support (for DWARF + -- unwinding), and if yes, the 'Library' configuration. -- C toolchain , tgtCCompiler :: Cc @@ -121,6 +133,8 @@ instance Show Target where , ", tgtUnregisterised = " ++ show tgtUnregisterised , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtHasLibm = " ++ show tgtHasLibm + , ", tgtRTSWithLibdw = " ++ show tgtRTSWithLibdw , ", tgtCCompiler = " ++ show tgtCCompiler , ", tgtCxxCompiler = " ++ show tgtCxxCompiler , ", tgtCPreprocessor = " ++ show tgtCPreprocessor @@ -141,6 +155,54 @@ instance Show Target where , "}" ] +-------------------------------------------------------------------------------- +-- Queries +-------------------------------------------------------------------------------- + +tgtSupportsSMP :: Target -> Bool +tgtSupportsSMP Target{..} = do + let goodArch = + isARM (archOS_arch tgtArchOs) + || archOS_arch tgtArchOs `elem` + [ ArchX86 + , ArchX86_64 + , ArchPPC + , ArchPPC_64 ELF_V1 + , ArchPPC_64 ELF_V2 + , ArchAArch64 + , ArchS390X + , ArchRISCV64 + , ArchLoongArch64 ] + + if -- The THREADED_RTS requires `BaseReg` to be in a register and the + -- Unregisterised mode doesn't allow that. + | tgtUnregisterised -> False + -- We don't support load/store barriers pre-ARMv7. See #10433. + | ArchARM ver _ _ <- archOS_arch tgtArchOs + , ver < ARMv7 -> False + | goodArch -> True + | otherwise -> False + +-- | Does the target RTS linker only support loading shared libraries? +-- If true, this has several implications: +-- 1. The GHC driver must not do loadArchive/loadObj etc and must +-- always do loadDLL, regardless of whether host GHC is dynamic or +-- not. +-- 2. The GHC driver will always enable -dynamic-too when compiling +-- vanilla way with TH codegen requirement. +-- 3. ghci will always enforce dynamic ways even if -dynamic or +-- -dynamic-too is not explicitly passed. +-- 4. Cabal must not build ghci objects since it's not supported by +-- the target. +-- 5. The testsuite driver will use dyn way for TH/ghci tests even +-- when host GHC is static. +-- 6. TH/ghci doesn't work if stage1 is built without shared libraries +-- (e.g. quickest/fully_static). +tgtRTSLinkerOnlySupportsSharedLibs :: Target -> Bool +tgtRTSLinkerOnlySupportsSharedLibs Target{tgtArchOs} = + archOS_arch tgtArchOs `elem` + [ ArchWasm32 ] + -------------------------------------------------------------------------------- -- Lenses -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9ed03c765f637633edf5304f8b7be… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9ed03c765f637633edf5304f8b7be… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26226] 3 commits: ghci: always enable the internal-interpreter flag
by Teo Camarasu (＠teo) 25 Jul '25

25 Jul '25

Teo Camarasu pushed to branch wip/T26226 at Glasgow Haskell Compiler / GHC Commits: 846ab130 by Teo Camarasu at 2025-07-25T21:35:00+01:00 ghci: always enable the internal-interpreter flag Building iserv requires the modules hidden behind the ghci internal-interpreter flag. This flag exists because these modules depend on parts of the TemplateHaskell interface, and historically we couldn't distinguish between the boot and the in-tree TH interface. This meant that these modules could only be built in stage0 if we've ensured that the boot TH interface matches the in-tree one. This restriction no longer holds as of https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12306. Removing this flag simplifies our logic, and is a step towards enabling using TH in bootstrapping (https://gitlab.haskell.org/ghc/ghc/-/issues/24624) - - - - - 14a6e7d6 by Teo Camarasu at 2025-07-25T21:35:00+01:00 compiler: rename ghciSuported -> internalInterpreterSupported GHCi and the internal interpreter are two different things. This tracks support for the latter. You can use GHCi without the internal interpreter. - - - - - 260db985 by Teo Camarasu at 2025-07-25T21:35:00+01:00 ghcBin: rename internal-interpreter flag to ghci This flag controls whether we include the ghci interface, ie, --interactive mode in the ghc executable. This is orthogonal to whether we support the internal interpreter. We can use GHCi with the external interpreter. - - - - - 9 changed files: - cabal.project-reinstall - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Utils/Constants.hs - ghc/GHC/Driver/Session/Mode.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== cabal.project-reinstall ===================================== @@ -56,7 +56,7 @@ packages: ./compiler ./linters/**/*.cabal constraints: ghc +internal-interpreter +dynamic-system-linke, - ghc-bin +internal-interpreter +threaded, + ghc-bin +ghci +threaded, ghci +internal-interpreter, haddock +in-ghc-tree, any.array installed, ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -1010,7 +1010,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically -- turn on -fexternal-interpreter. - ext_interp_enable ms = not ghciSupported && internalInterpreter + ext_interp_enable ms = not internalInterpreterSupported && internalInterpreter where lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) ===================================== compiler/GHC/Utils/Constants.hs ===================================== @@ -2,7 +2,7 @@ module GHC.Utils.Constants ( debugIsOn - , ghciSupported + , internalInterpreterSupported , isWindowsHost , isDarwinHost ) @@ -22,11 +22,11 @@ branch of the conditional, thereby dropping debug code altogether when the flags are off. -} -ghciSupported :: Bool +internalInterpreterSupported :: Bool #if defined(HAVE_INTERNAL_INTERPRETER) -ghciSupported = True +internalInterpreterSupported = True #else -ghciSupported = False +internalInterpreterSupported = False #endif debugIsOn :: Bool ===================================== ghc/GHC/Driver/Session/Mode.hs ===================================== @@ -134,7 +134,7 @@ isDoEvalMode :: Mode -> Bool isDoEvalMode (Right (Right (DoEval _))) = True isDoEvalMode _ = False -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) isInteractiveMode :: PostLoadMode -> Bool isInteractiveMode DoInteractive = True isInteractiveMode _ = False ===================================== ghc/Main.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Driver.Config.Diagnostic import GHC.Platform import GHC.Platform.Host -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif @@ -289,7 +289,7 @@ doRun units srcs args = do args' = drop 1 $ dropWhile (/= "--") $ map unLoc args ghciUI :: [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () -#if !defined(HAVE_INTERNAL_INTERPRETER) +#if !defined(HAVE_GHCI) ghciUI _ _ _ = throwGhcException (CmdLineError "not built for interactive use") #else @@ -333,7 +333,7 @@ showBanner :: PostLoadMode -> DynFlags -> IO () showBanner _postLoadMode dflags = do let verb = verbosity dflags -#if defined(HAVE_INTERNAL_INTERPRETER) +#if defined(HAVE_GHCI) -- Show the GHCi banner when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg #endif ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -17,8 +17,8 @@ Category: Development Build-Type: Simple Cabal-Version: >=1.10 -Flag internal-interpreter - Description: Build with internal interpreter support. +Flag ghci + Description: Build with support for GHCi. Default: False Manual: True @@ -56,7 +56,7 @@ Executable ghc -rtsopts=all "-with-rtsopts=-K512M -H -I5 -T" - if flag(internal-interpreter) + if flag(ghci) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq >= 1.4 && < 1.6, @@ -65,7 +65,7 @@ Executable ghc haskeline == 0.8.*, exceptions == 0.10.*, time >= 1.8 && < 1.15 - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + CPP-Options: -DHAVE_GHCI Other-Modules: GHCi.Leak GHCi.UI ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -25,10 +25,6 @@ packageArgs = do -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling - -- Check if the bootstrap compiler has the same version as the one we - -- are building. This is used to build cross-compilers - bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1 - compilerStageOption f = buildingCompilerStage' . f =<< expr flavour cursesIncludeDir <- getSetting CursesIncludeDir @@ -128,39 +124,9 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ - -- The use case here is that we want to build @iserv-proxy@ for the - -- cross compiler. That one needs to be compiled by the bootstrap - -- compiler as it needs to run on the host. Hence @iserv@ needs - -- @GHCi.TH@, @GHCi.Message@, @GHCi.Run@, and @GHCi.Server@ from - -- @ghci@. And those are behind the @-finternal-interpreter@ flag. - -- - -- But it may not build if we have made some changes to ghci's - -- dependencies (see #16051). - -- - -- To fix this properly Hadrian would need to: - -- * first build a compiler for the build platform (stage1 is enough) - -- * use it as a bootstrap compiler to build the stage1 cross-compiler - -- - -- The issue is that "configure" would have to be executed twice (for - -- the build platform and for the cross-platform) and Hadrian would - -- need to be fixed to support two different stage1 compilers. - -- - -- The workaround we use is to check if the bootstrap compiler has - -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with - -- `-finternal-interpreter`. - -- - -- TODO: Note that in that case we also do not need to build most of - -- the Stage1 libraries, as we already know that the bootstrap - -- compiler comes with the same versions as the one we are building. - -- - builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir + [ builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir , builder (Cabal Flags) ? mconcat - [ ifM stage0 - (andM [cross, bootCross] `cabalFlag` "internal-interpreter") - (arg "internal-interpreter") - , stage0 `cabalFlag` "bootstrap" + [ stage0 `cabalFlag` "bootstrap" ] ] ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -260,7 +260,11 @@ sandboxIO opts io = do -- rethrow :: EvalOpts -> IO a -> IO a rethrow EvalOpts{..} io = +#if MIN_VERSION_base(4,21,0) catchNoPropagate io $ \(ExceptionWithContext cx se) -> do +#else + catch io $ \se -> do +#endif -- If -fbreak-on-error, we break unconditionally, -- but with care of not breaking twice if breakOnError && not breakOnException @@ -271,7 +275,11 @@ rethrow EvalOpts{..} io = Just UserInterrupt -> return () -- In any other case, we don't want to break _ -> poke exceptionFlag 0 +#if MIN_VERSION_base(4,21,0) rethrowIO (ExceptionWithContext cx se) +#else + throwIO se +#endif -- -- While we're waiting for the sandbox thread to return a result, if ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,11 +17,6 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag internal-interpreter - Description: Build with internal interpreter support. - Default: False - Manual: True - Flag bootstrap Description: Enabled when building the stage1 compiler in order to vendor the in-tree @@ -56,23 +51,19 @@ library TupleSections UnboxedTuples - if flag(internal-interpreter) - CPP-Options: -DHAVE_INTERNAL_INTERPRETER + if !arch(javascript) exposed-modules: - GHCi.Run - GHCi.Debugger - GHCi.CreateBCO - GHCi.ObjLink - GHCi.Signals - GHCi.StaticPtrTable - GHCi.TH - GHCi.Server - - if !arch(javascript) - exposed-modules: - GHCi.InfoTable + GHCi.InfoTable exposed-modules: + GHCi.Run + GHCi.Debugger + GHCi.CreateBCO + GHCi.ObjLink + GHCi.Signals + GHCi.StaticPtrTable + GHCi.TH + GHCi.Server GHCi.BreakArray GHCi.BinaryArray GHCi.Message View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44cdfa931f541242796c37d099d0a2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44cdfa931f541242796c37d099d0a2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26226] compiler: rename ghciSuported -> internalInterpreterSupported
by Teo Camarasu (＠teo) 25 Jul '25

25 Jul '25

Teo Camarasu pushed to branch wip/T26226 at Glasgow Haskell Compiler / GHC Commits: 44cdfa93 by Teo Camarasu at 2025-07-25T20:25:50+01:00 compiler: rename ghciSuported -> internalInterpreterSupported GHCi and the internal interpreter are two different things. This tracks support for the latter. You can use GHCi without the internal interpreter. - - - - - 2 changed files: - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Utils/Constants.hs Changes: ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -1010,7 +1010,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically -- turn on -fexternal-interpreter. - ext_interp_enable ms = not ghciSupported && internalInterpreter + ext_interp_enable ms = not internalInterpreterSupported && internalInterpreter where lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) ===================================== compiler/GHC/Utils/Constants.hs ===================================== @@ -2,7 +2,7 @@ module GHC.Utils.Constants ( debugIsOn - , ghciSupported + , internalInterpreterSupported , isWindowsHost , isDarwinHost ) @@ -22,11 +22,11 @@ branch of the conditional, thereby dropping debug code altogether when the flags are off. -} -ghciSupported :: Bool +internalInterpreterSupported :: Bool #if defined(HAVE_INTERNAL_INTERPRETER) -ghciSupported = True +internalInterpreterSupported = True #else -ghciSupported = False +internalInterpreterSupported = False #endif debugIsOn :: Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44cdfa931f541242796c37d099d0a26… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44cdfa931f541242796c37d099d0a26… You're receiving this email because of your account on gitlab.haskell.org.

1 0