- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new tag ghc-9.14.1-rc2
by Zubin (＠wz1000) 17 Nov '25

17 Nov '25

Zubin pushed new tag ghc-9.14.1-rc2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.14.1-rc2 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] In `addArgCtxt` the nth argument's err ctxt adds a generated error ctxt if the argument is XExpr
by Apoorv Ingle (＠ani) 17 Nov '25

17 Nov '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 45e4940f by Apoorv Ingle at 2025-11-16T20:12:02-06:00 In `addArgCtxt` the nth argument's err ctxt adds a generated error ctxt if the argument is XExpr - - - - - 2 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -183,7 +183,7 @@ tcExprSigma inst rn_expr ; do_ql <- wantQuickLook rn_fun ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; code_orig <- getSrcCodeOrigin - ; let fun_orig | isGoodSrcSpan fun_lspan + ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin rn_fun | otherwise = srcCodeOriginCtOrigin rn_fun code_orig @@ -435,7 +435,7 @@ tcApp rn_expr exp_res_ty -- See Note [Error contexts in generated code] -- See Note [Error Context Stack] ; code_orig <- getSrcCodeOrigin - ; let fun_orig | isGoodSrcSpan fun_lspan + ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin rn_fun | otherwise = srcCodeOriginCtOrigin rn_fun code_orig @@ -962,9 +962,7 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside , ppr arg_loc , ppr arg , ppr arg_no]) - ; setSrcSpanA arg_loc $ - addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ - thing_inside + ; setSrcSpanA arg_loc $ mkNthFunArgErrCtxt app_head arg arg_no thing_inside } | otherwise = do { traceTc "addArgCtxt" (vcat [text "generated Head" @@ -975,6 +973,15 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside ; addLExprCtxt (locA arg_loc) arg $ thing_inside } + where + mkNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a + mkNthFunArgErrCtxt app_head arg arg_no thing_inside + | XExpr (ExpandedThingRn o _) <- arg + = addExpansionErrCtxt o (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ + thing_inside + | otherwise + = addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ + thing_inside @@ -1839,7 +1846,7 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ do { let tc_head = (tc_fun, fun_lspan) ; do_ql <- wantQuickLook rn_fun ; code_orig <- getSrcCodeOrigin - ; let arg_orig | isGoodSrcSpan fun_lspan + ; let arg_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin fun | otherwise = srcCodeOriginCtOrigin fun code_orig ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -264,9 +264,9 @@ splitHsApps e = go e noSrcSpan [] -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args = pure ( (op, locA l) - , mkEValArg generatedSrcSpan arg1 - : mkEValArg generatedSrcSpan arg2 - -- generatedSrcSpan because this the span of the call, + , mkEValArg noSrcSpan arg1 + : mkEValArg noSrcSpan arg2 + -- noSrcSpan because this the span of the call, -- and its hard to say exactly what that is : EWrap (EExpand e) : args ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e4940f052d8e9994eac4da1aa9d00… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e4940f052d8e9994eac4da1aa9d00… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26582
by Simon Peyton Jones (＠simonpj) 17 Nov '25

17 Nov '25

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

1 0

[Git][ghc/ghc][wip/io-manager-deadlock-detection] 4 commits: FIXUP: Add an FdWakup module for posix I/O managers
by Duncan Coutts (＠dcoutts) 17 Nov '25

17 Nov '25

Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC Commits: a37c97bc by Duncan Coutts at 2025-11-15T22:01:39+00:00 FIXUP: Add an FdWakup module for posix I/O managers cpp warnings - - - - - 0ad3b03d by Duncan Coutts at 2025-11-15T22:10:18+00:00 FIXUP: Rationalise some scheduler run queue utilities win32 conditional compilation issues - - - - - 31bdf200 by Duncan Coutts at 2025-11-15T23:00:51+00:00 FIXUP: Clean up signal handling internal API ifdefs - - - - - 050e03a4 by Duncan Coutts at 2025-11-16T22:58:03+00:00 FIXUP: event and timer manager init synchronisation I'm not terribly satisfied by this. It might work but it's not principled. - - - - - 4 changed files: - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - rts/RtsStartup.c - rts/Schedule.c - rts/posix/FdWakeup.c Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs ===================================== @@ -223,38 +223,48 @@ threadWaitWriteSTM = threadWaitSTM evtWrite {-# INLINE threadWaitWriteSTM #-} --- | Retrieve the system event manager for the capability on which the --- calling thread is running. --- --- This function always returns 'Just' the current thread's event manager --- when using the threaded RTS and 'Nothing' otherwise. -getSystemEventManager :: IO (Maybe EventManager) -getSystemEventManager = do +getSystemEventManager_ :: IO EventManager +getSystemEventManager_ = do t <- myThreadId eventManagerArray <- readIORef eventManager let r = boundsIOArray eventManagerArray (cap, _) <- threadCapability t - -- It is possible that we've just increased the number of capabilities and the - -- new EventManager has not yet been constructed by - -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. - -- T21561 exercises this. - -- Two options to proceed: - -- 1) return the EventManager for capability 0. This is guaranteed to exist, - -- and "shouldn't" cause any correctness issues. - -- 2) Busy wait, with or without a call to 'yield'. This can't deadlock, - -- because we must be on a brand capability and there must be a call to - -- 'ioManagerCapabilitiesChanged' pending. + -- It is possible that either: + -- 1) we've just started the RTS or done forkProcess and the EventManager + -- is still being started concurrently by 'ensureIOManagerIsRunning'. + -- This usually happens once at startup. + -- 2) we've just increased the number of capabilities and the new + -- EventManager is being started concurrently by + -- 'ioManagerCapabilitiesChanged'. We expect this to happen very rarely. + -- T21561 exercises this. + -- + -- For both situations we follow the strategy to busy wait, with a call to + -- 'yield'. This can't deadlock, because there must be a call to either + -- 'ensureIOManagerIsRunning' or 'ioManagerCapabilitiesChanged' running. -- - -- We take the second option, with the yield, judging it the most robust. if not (inRange r cap) - then yield >> getSystemEventManager - else fmap snd `fmap` readIOArray eventManagerArray cap + then yield >> getSystemEventManager_ -- for num caps changed + else do + mem <- readIOArray eventManagerArray cap + case mem of + Just (_, em) -> return em + Nothing + | threaded -> yield >> getSystemEventManager_ -- for startup + | otherwise -> err + where + err = error "GHC.Internal.Event.Thread.getSystemEventManager: the EventManager requires linking against the threaded runtime" -getSystemEventManager_ :: IO EventManager -getSystemEventManager_ = do - Just mgr <- getSystemEventManager - return mgr -{-# INLINE getSystemEventManager_ #-} + +-- | Retrieve the system event manager for the capability on which the +-- calling thread is running. +-- +-- This function always returns 'Just' the current thread's event +-- manager when using the threaded RTS and 'Nothing' otherwise. +getSystemEventManager :: IO (Maybe EventManager) +getSystemEventManager + | threaded = Just `fmap` getSystemEventManager_ + | otherwise = return Nothing +{-# INLINE getSystemEventManager #-} foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore" getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a) @@ -299,8 +309,18 @@ ioManagerLock = unsafePerformIO $ do sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore getSystemTimerManager :: IO TM.TimerManager -getSystemTimerManager = - fromMaybe err `fmap` readIORef timerManager +getSystemTimerManager = do + mtm <- readIORef timerManager + case mtm of + Just tm -> return tm + Nothing + -- Same logic as in getSystemEventManager: yield and try again. + -- This can't deadlock, because we must be on a brand new + -- capability (either the main cap during startup or a new cap + -- after forkProcess) and there must be a call to + -- 'ensureIOManagerIsRunning' pending. + | threaded -> yield >> getSystemTimerManager + | otherwise -> err where err = error "GHC.Internal.Event.Thread.getSystemTimerManager: the TimerManager requires linking against the threaded runtime" ===================================== rts/RtsStartup.c ===================================== @@ -625,7 +625,9 @@ hs_exit_(bool wait_foreign) hs_restoreConsoleCP(); #endif - finiUserSignals(); +#if defined(RTS_USER_SIGNALS) + finiUserSignals(); +#endif /* tear down statistics subsystem */ stat_exit(); ===================================== rts/Schedule.c ===================================== @@ -173,8 +173,9 @@ static void deleteAllThreads (void); static void deleteThread_(StgTSO *tso); #endif -static void removeFromRunQueue (Capability *cap, StgTSO *tso); +#if defined(FORKPROCESS_PRIMOP_SUPPORTED) static void truncateRunQueue(Capability *cap); +#endif static StgTSO *popRunQueue (Capability *cap); /* --------------------------------------------------------------------------- @@ -3025,6 +3026,7 @@ static StgTSO *popRunQueue (Capability *cap) return t; } +#if defined(FORKPROCESS_PRIMOP_SUPPORTED) static void truncateRunQueue(Capability *cap) { // Can only be called by the task owning the capability. @@ -3035,6 +3037,7 @@ static void truncateRunQueue(Capability *cap) cap->run_queue_tl = END_TSO_QUEUE; cap->n_run_queue = 0; } +#endif static void removeFromRunQueue (Capability *cap, StgTSO *tso) { ===================================== rts/posix/FdWakeup.c ===================================== @@ -47,7 +47,7 @@ static void fcntl_CLOEXEC_NONBLOCK(int fd) void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w) { -#if HAVE_EVENTFD +#if defined(HAVE_EVENTFD) int wakeup_fd; #if defined(EFD_CLOEXEC) && defined(EFD_NONBLOCK) wakeup_fd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK); @@ -79,7 +79,7 @@ void newFdWakeup(int *wakeup_fd_r, int *wakeup_fd_w) void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w) { -#if HAVE_EVENTFD +#if defined(HAVE_EVENTFD) ASSERT(wakeup_fd_r == wakeup_fd_w); close(wakeup_fd_r); #else @@ -92,7 +92,7 @@ void closeFdWakeup(int wakeup_fd_r, int wakeup_fd_w) void sendFdWakeup(int wakeup_fd_w) { int res; -#if HAVE_EVENTFD +#if defined(HAVE_EVENTFD) uint64_t val = 1; res = write(wakeup_fd_w, &val, 8); #else @@ -110,7 +110,7 @@ void sendFdWakeup(int wakeup_fd_w) void collectFdWakeup(int wakeup_fd_r) { int res; -#if HAVE_EVENTFD +#if defined(HAVE_EVENTFD) uint64_t buf; /* eventfd combines events into one counter, so a single read is enough */ res = read(wakeup_fd_r, &buf, 8); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb13b6d4e399b073746fd79abd736e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb13b6d4e399b073746fd79abd736e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23162-part2] Refine Yikes 3
by Simon Peyton Jones (＠simonpj) 17 Nov '25

17 Nov '25

Simon Peyton Jones pushed to branch wip/T23162-part2 at Glasgow Haskell Compiler / GHC Commits: b71acd03 by Simon Peyton Jones at 2025-11-16T17:39:32+00:00 Refine Yikes 3 - - - - - 1 changed file: - compiler/GHC/Tc/Solver/FunDeps.hs Changes: ===================================== compiler/GHC/Tc/Solver/FunDeps.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Core.FamInstEnv import GHC.Core.Coercion import GHC.Core.Predicate( EqRel(..) ) import GHC.Core.TyCon -import GHC.Core.Type( tyConAppTyCon_maybe ) +import GHC.Core.TyCo.Rep( Type(..) ) import GHC.Core.Unify( tcUnifyTysForInjectivity, typeListsAreApart ) import GHC.Core.Coercion.Axiom import GHC.Core.TyCo.Subst( elemSubst ) @@ -36,6 +36,7 @@ import GHC.Types.Var.Set import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc( lengthExceeds ) import GHC.Data.Pair import Data.Maybe( isNothing, mapMaybe ) @@ -543,8 +544,7 @@ tryFDEqns fam_tc work_args work_item@(EqCt { eq_ev = ev, eq_rhs= rhs }) mk_fd_eq ----------------------------------------- mkTopClosedFamEqFDs :: CoAxiom Branched -> [TcType] -> Xi -> TcS [FunDepEqns] mkTopClosedFamEqFDs ax work_args work_rhs - | Just tc <- tyConAppTyCon_maybe work_rhs -- Does RHS have anything useful to say? - , isGenerativeTyCon tc Nominal + | isInformativeType work_rhs -- Does RHS have anything useful to say? = do { let branches = fromBranches (coAxiomBranches ax) ; traceTcS "mkTopClosed" (ppr branches $$ ppr work_args $$ ppr work_rhs) ; case getRelevantBranches ax work_args work_rhs of @@ -555,6 +555,16 @@ mkTopClosedFamEqFDs ax work_args work_rhs | otherwise = return [] +isInformativeType :: Type -> Bool +-- The type is headed by something generative, not just +-- a type variable or a type-family application +isInformativeType ty | Just ty' <- coreView ty = isInformativeType ty' +isInformativeType (CastTy ty _) = isInformativeType ty +isInformativeType (TyVarTy {}) = False +isInformativeType (CoercionTy {}) = False -- Moot +isInformativeType (TyConApp tc tys) = isGenerativeTyCon tc Nominal || + tys `lengthExceeds` tyConArity tc +isInformativeType _ = True -- AppTy, ForAllTy, FunTy, LitTy getRelevantBranches :: CoAxiom Branched -> [TcType] -> Xi -> [CoAxBranch] getRelevantBranches ax work_args work_rhs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b71acd03112ce0ae8ab889a0d0cbd26… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b71acd03112ce0ae8ab889a0d0cbd26… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] 2 commits: Rebase fixup: ghcWithInternalInterpreter
by Sven Tennie (＠supersven) 17 Nov '25

17 Nov '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: aa674958 by Sven Tennie at 2025-11-16T17:35:37+01:00 Rebase fixup: ghcWithInternalInterpreter - - - - - 54471b88 by Sven Tennie at 2025-11-16T17:35:37+01:00 Provide config.cross flag to testsuite - - - - - 5 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Setting ( -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, libsuf, ghcVersionStage, bashPath, targetStage, crossStage, queryTarget, queryTargetTarget, - ghcWithInterpreter, isHostStage, + isHostStage, -- ** Target platform things anyTargetOs, anyTargetArch, anyHostOs, @@ -181,22 +181,6 @@ targetSupportsRPaths stage = queryTargetTarget stage (\t -> let os = archOS_OS (tgtArchOs t) in osElfTarget os || osMachOTarget os) --- | Check whether the target supports GHCi. -ghcWithInterpreter :: Stage -> Action Bool -ghcWithInterpreter stage = do - goodOs <- anyTargetOs stage [ OSMinGW32, OSLinux, OSSolaris2 -- TODO "cygwin32"?, - , OSFreeBSD, OSDragonFly, OSNetBSD, OSOpenBSD - , OSDarwin, OSKFreeBSD - , OSWasi ] - goodArch <- (||) <$> - anyTargetArch stage [ ArchX86, ArchX86_64, ArchPPC - , ArchAArch64, ArchS390X - , ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2 - , ArchRISCV64, ArchLoongArch64 - , ArchWasm32 ] - <*> isArmTarget stage - return $ goodOs && goodArch && (stage >= Stage1) - -- | Which variant of the ARM architecture is the target (or 'Nothing' if not -- ARM)? targetArmVersion :: Stage -> Action (Maybe ArmISA) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -12,6 +12,7 @@ import Hadrian.Oracles.TextFile (lookupStageBuildConfig) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles import Oracles.Setting +import Settings.Program (ghcWithInterpreter) import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) @@ -489,7 +490,7 @@ generateSettings settingsFile = do -- ROMES:TODO: WHERE HAS CROSS COMPILING GONE? -- ("cross compiling", expr $ yesNo <$> crossStage (predStage stage)) [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit, Context.stage = predStage stage }))) - , ("Use interpreter", expr $ yesNo <$> Oracles.Setting.ghcWithInterpreter stage) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) -- Hard-coded as Cabal queries these to determine way support and we -- need to always advertise all ways when bootstrapping. -- The settings file is generated at install time when installing a bindist. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -11,7 +11,7 @@ import Settings.Builders.Common import qualified Settings.Builders.Common as S import Control.Exception (assert) import qualified Data.Set as Set -import Settings.Program (programContext) +import Settings.Program (programContext, ghcWithInterpreter) import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink, targetPlatformTriple) import GHC.Toolchain.Program (prgFlags) @@ -139,7 +139,7 @@ libraryArgs = do contextWay <- getWay package <- getPackage stage <- getStage - withGhci <- expr (ghcWithInterpreter stage) + withGhci <- expr $ ghcWithInterpreter stage dynPrograms <- expr (flavour >>= flip dynamicGhcPrograms stage) ghciObjsSupported <- expr (targetSupportsGhciObjects stage) let ways = Set.insert contextWay flavourWays ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -15,6 +15,7 @@ import CommandLine import Oracles.TestSettings import Packages import Settings.Builders.Common +import Settings.Program (ghcWithInterpreter) import qualified Data.Set as Set import Flavour import qualified Context.Type as C @@ -62,6 +63,7 @@ data TestCompilerArgs = TestCompilerArgs{ , leadingUnderscore :: Bool , withNativeCodeGen :: Bool , withInterpreter :: Bool + , cross :: Bool , interpForceDyn :: Bool , unregisterised :: Bool , tables_next_to_code :: Bool @@ -96,9 +98,9 @@ allowHaveLLVM = not . (`elem` ["wasm32", "javascript"]) -- inTreeCompilerArgs :: Stage -> Action TestCompilerArgs inTreeCompilerArgs stg = do - isCrossStage <- crossStage stg + cross <- crossStage stg let ghcStage = succStage stg - pkgCacheStage = if isCrossStage then ghcStage else stg + pkgCacheStage = if cross then ghcStage else stg (hasDynamicRts, hasThreadedRts) <- do ways <- interpretInContext (vanillaContext ghcStage rts) getRtsWays return (dynamic `elem` ways, threaded `elem` ways) @@ -158,11 +160,11 @@ outOfTreeCompilerArgs = do leadingUnderscore <- getBooleanSetting TestLeadingUnderscore withNativeCodeGen <- getBooleanSetting TestGhcWithNativeCodeGen withInterpreter <- getBooleanSetting TestGhcWithInterpreter + cross <- getBooleanSetting TestGhcCrossCompiling interpForceDyn <- getBooleanSetting TestRTSLinkerForceDyn unregisterised <- getBooleanSetting TestGhcUnregisterised tables_next_to_code <- getBooleanSetting TestGhcTablesNextToCode targetWithSMP <- getBooleanSetting TestGhcWithSMP - debugAssertions <- getBooleanSetting TestGhcDebugAssertions os <- getTestSetting TestHostOS @@ -279,6 +281,7 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter + , arg "-e", arg $ "config.cross=" ++ show cross , arg "-e", arg $ "config.interp_force_dyn=" ++ show interpForceDyn , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised , arg "-e", arg $ "config.tables_next_to_code=" ++ show tables_next_to_code ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Oracles.Flag import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import Settings.Program (ghcWithInterpreter) import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target @@ -24,7 +25,6 @@ packageArgs = do -- immediately and may lead to cyclic dependencies. -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling - isCrossStage = crossStage stage haveCurses = any (/= "") <$> traverse (flip buildSetting stage) [ CursesIncludeDir, CursesLibDir ] -- Check if the bootstrap compiler has the same version as the one we @@ -82,16 +82,18 @@ packageArgs = do ] , builder (Cabal Flags) ? mconcat - -- For the ghc library, internal-interpreter only makes - -- sense when we're not cross compiling. For cross GHC, - -- external interpreter is used for loading target code - -- and internal interpreter is supposed to load native - -- code for plugins (!7377), however it's unfinished work - -- (#14335) and completely untested in CI for cross - -- backends at the moment, so we might as well disable it - -- for cross GHC. - -- TODO: MP - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + -- In order to enable internal-interpreter for the ghc + -- library: + -- + -- 1. ghcWithInterpreter must be True ("Use interpreter" = + -- "YES") + -- 2. For non-cross case it can be enabled + -- 3. For cross case, disable for stage0 since that runs + -- on the host and must rely on external interpreter to + -- load target code, otherwise enable for stage1 since + -- that runs on the target and can use target's own + -- ghci object linker + [ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage2]] `cabalFlag` "internal-interpreter" , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , staged (buildFlag UseLibzstd) `cabalFlag` "with-libzstd" @@ -113,7 +115,7 @@ packageArgs = do , compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0586cc4bd871709fac5921b72044a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0586cc4bd871709fac5921b72044a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/torsten.schmits/mercury-mhu-transitive-th-deps] Use OsPath in PkgDbRef and UnitDatabase, not FilePath
by Torsten Schmits (＠torsten.schmits) 17 Nov '25

17 Nov '25

Torsten Schmits pushed to branch wip/torsten.schmits/mercury-mhu-transitive-th-deps at Glasgow Haskell Compiler / GHC Commits: e5fb170e by Georgios Karachalias at 2025-11-16T16:53:38+01:00 Use OsPath in PkgDbRef and UnitDatabase, not FilePath - - - - - 6 changed files: - + compiler/GHC/Data/OsPath.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -0,0 +1,45 @@ +module GHC.Data.OsPath + ( + -- * OsPath initialisation and transformation + OsPath + , OsString + , encodeUtf + , decodeUtf + , unsafeDecodeUtf + , unsafeEncodeUtf + , os + -- * Common utility functions + , (</>) + , (<.>) + , splitSearchPath + , isRelative + , dropTrailingPathSeparator + , takeDirectory + , isSuffixOf + , doesDirectoryExist + , doesFileExist + , getDirectoryContents + , createDirectoryIfMissing + , pprOsPath + ) + where + +import GHC.Prelude + +import GHC.Utils.Misc (HasCallStack) +import GHC.Utils.Outputable qualified as Outputable +import GHC.Utils.Panic (panic) + +import System.OsPath +import System.OsString (isSuffixOf) +import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing) +import System.Directory.Internal (os) + +-- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. +-- Prefer 'decodeUtf' and gracious error handling. +unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath +unsafeDecodeUtf p = + either (\err -> panic $ "Failed to decodeUtf \"" ++ show p ++ "\", because: " ++ show err) id (decodeUtf p) + +pprOsPath :: HasCallStack => OsPath -> Outputable.SDoc +pprOsPath = Outputable.text . unsafeDecodeUtf ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -76,6 +76,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe import GHC.Data.StringBuffer import GHC.Data.FastString +import qualified GHC.Data.OsPath as OsPath import qualified GHC.Data.EnumSet as EnumSet import qualified GHC.Data.ShortText as ST @@ -432,7 +433,7 @@ addUnit u = do Nothing -> panic "addUnit: called too early" Just dbs -> let newdb = UnitDatabase - { unitDatabasePath = "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" + { unitDatabasePath = OsPath.unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" , unitDatabaseUnits = [u] } in return (dbs ++ [newdb]) -- added at the end because ordering matters ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -96,6 +96,7 @@ import GHC.Core.Unfold import GHC.Data.Bool import GHC.Data.EnumSet (EnumSet) import GHC.Data.Maybe +import GHC.Data.OsPath (OsPath) import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Backend import GHC.Driver.Flags @@ -948,7 +949,7 @@ setDynamicNow dflags0 = data PkgDbRef = GlobalPkgDb | UserPkgDb - | PkgDbPath FilePath + | PkgDbPath OsPath deriving Eq -- | Used to differentiate the scope an include needs to apply to. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -255,6 +255,7 @@ import GHC.Types.SrcLoc import GHC.Types.SafeHaskell import GHC.Types.Basic ( treatZeroAsInf ) import GHC.Data.FastString +import qualified GHC.Data.OsPath as OsPath import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable @@ -1962,7 +1963,7 @@ package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] package_flags_deps = [ ------- Packages ---------------------------------------------------- make_ord_flag defFlag "package-db" - (HasArg (addPkgDbRef . PkgDbPath)) + (HasArg (addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf)) , make_ord_flag defFlag "clear-package-db" (NoArg clearPkgDb) , make_ord_flag defFlag "no-global-package-db" (NoArg removeGlobalPkgDb) , make_ord_flag defFlag "no-user-package-db" (NoArg removeUserPkgDb) @@ -1972,7 +1973,7 @@ package_flags_deps = [ (NoArg (addPkgDbRef UserPkgDb)) -- backwards compat with GHC<=7.4 : , make_dep_flag defFlag "package-conf" - (HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead" + (HasArg $ addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf) "Use -package-db instead" , make_dep_flag defFlag "no-user-package-conf" (NoArg removeUserPkgDb) "Use -no-user-package-db instead" , make_ord_flag defGhcFlag "package-name" (HasArg $ \name -> @@ -3377,7 +3378,7 @@ parseEnvFile :: FilePath -> String -> DynP () parseEnvFile envfile = mapM_ parseEntry . lines where parseEntry str = case words str of - ("package-db": _) -> addPkgDbRef (PkgDbPath (envdir </> db)) + ("package-db": _) -> addPkgDbRef (PkgDbPath (OsPath.unsafeEncodeUtf (envdir </> db))) -- relative package dbs are interpreted relative to the env file where envdir = takeDirectory envfile db = drop 11 str ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -103,6 +103,8 @@ import GHC.Data.Maybe import System.Environment ( getEnv ) import GHC.Data.FastString import qualified GHC.Data.ShortText as ST +import GHC.Data.OsPath (OsPath) +import qualified GHC.Data.OsPath as OsPath import GHC.Utils.Logger import GHC.Utils.Error import GHC.Utils.Exception @@ -112,7 +114,7 @@ import System.FilePath as FilePath import Control.Monad import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) -import Data.List ( intersperse, partition, sortBy, isSuffixOf, sortOn ) +import Data.List ( intersperse, partition, sortBy, sortOn ) import Data.Set (Set) import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup @@ -405,7 +407,7 @@ initUnitConfig dflags cached_dbs home_units = where offsetPackageDb :: Maybe FilePath -> PackageDBFlag -> PackageDBFlag - offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | isRelative p = PackageDB (PkgDbPath (offset </> p)) + offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | OsPath.isRelative p = PackageDB (PkgDbPath (OsPath.unsafeEncodeUtf offset OsPath.</> p)) offsetPackageDb _ p = p @@ -500,12 +502,12 @@ emptyUnitState = UnitState { -- | Unit database data UnitDatabase unit = UnitDatabase - { unitDatabasePath :: FilePath + { unitDatabasePath :: OsPath , unitDatabaseUnits :: [GenUnitInfo unit] } instance Outputable u => Outputable (UnitDatabase u) where - ppr (UnitDatabase fp _u) = text "DB:" <+> text fp + ppr (UnitDatabase fp _u) = text "DB:" <+> OsPath.pprOsPath fp type UnitInfoMap = UniqMap UnitId UnitInfo @@ -720,9 +722,9 @@ getUnitDbRefs cfg = do Left _ -> system_conf_refs Right path | Just (xs, x) <- snocView path, isSearchPathSeparator x - -> map PkgDbPath (splitSearchPath xs) ++ system_conf_refs + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf xs)) ++ system_conf_refs | otherwise - -> map PkgDbPath (splitSearchPath path) + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf path)) -- Apply the package DB-related flags from the command line to get the -- final list of package DBs. @@ -751,24 +753,24 @@ getUnitDbRefs cfg = do -- NB: This logic is reimplemented in Cabal, so if you change it, -- make sure you update Cabal. (Or, better yet, dump it in the -- compiler info so Cabal can use the info.) -resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath) -resolveUnitDatabase cfg GlobalPkgDb = return $ Just (unitConfigGlobalDB cfg) +resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe OsPath) +resolveUnitDatabase cfg GlobalPkgDb = return $ Just $ OsPath.unsafeEncodeUtf $ unitConfigGlobalDB cfg resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOS cfg) let pkgconf = dir </> unitConfigDBName cfg exist <- tryMaybeT $ doesDirectoryExist pkgconf - if exist then return pkgconf else mzero + if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero resolveUnitDatabase _ (PkgDbPath name) = return $ Just name -readUnitDatabase :: Logger -> UnitConfig -> FilePath -> IO (UnitDatabase UnitId) +readUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do - isdir <- doesDirectoryExist conf_file + isdir <- OsPath.doesDirectoryExist conf_file proto_pkg_configs <- if isdir then readDirStyleUnitInfo conf_file else do - isfile <- doesFileExist conf_file + isfile <- OsPath.doesFileExist conf_file if isfile then do mpkgs <- tryReadOldFileStyleUnitInfo @@ -776,48 +778,49 @@ readUnitDatabase logger cfg conf_file = do Just pkgs -> return pkgs Nothing -> throwGhcExceptionIO $ InstallationError $ "ghc no longer supports single-file style package " ++ - "databases (" ++ conf_file ++ + "databases (" ++ show conf_file ++ ") use 'ghc-pkg init' to create the database with " ++ "the correct format." else throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file + "can't find a package database at " ++ show conf_file let -- Fix #16360: remove trailing slash from conf_file before calculating pkgroot - conf_file' = dropTrailingPathSeparator conf_file - top_dir = unitConfigGHCDir cfg - pkgroot = takeDirectory conf_file' + conf_file' = OsPath.dropTrailingPathSeparator conf_file + top_dir = OsPath.unsafeEncodeUtf (unitConfigGHCDir cfg) -- TODO: hm. + pkgroot = OsPath.takeDirectory conf_file' pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) . mkUnitKeyInfo) proto_pkg_configs -- return $ UnitDatabase conf_file' pkg_configs1 where + readDirStyleUnitInfo :: OsPath -> IO [DbUnitInfo] readDirStyleUnitInfo conf_dir = do - let filename = conf_dir </> "package.cache" - cache_exists <- doesFileExist filename + let filename = conf_dir OsPath.</> (OsPath.unsafeEncodeUtf "package.cache") + cache_exists <- OsPath.doesFileExist filename if cache_exists then do - debugTraceMsg logger 2 $ text "Using binary package database:" <+> text filename - readPackageDbForGhc filename + debugTraceMsg logger 2 $ text "Using binary package database:" <+> OsPath.pprOsPath filename + readPackageDbForGhc (OsPath.unsafeDecodeUtf filename) -- TODO: Can we help it with this one? it comes from the ghc-boot package else do -- If there is no package.cache file, we check if the database is not -- empty by inspecting if the directory contains any .conf file. If it -- does, something is wrong and we fail. Otherwise we assume that the -- database is empty. debugTraceMsg logger 2 $ text "There is no package.cache in" - <+> text conf_dir + <+> OsPath.pprOsPath conf_dir <> text ", checking if the database is empty" - db_empty <- all (not . isSuffixOf ".conf") - <$> getDirectoryContents conf_dir + db_empty <- all (not . OsPath.isSuffixOf (OsPath.unsafeEncodeUtf ".conf")) + <$> OsPath.getDirectoryContents conf_dir if db_empty then do debugTraceMsg logger 3 $ text "There are no .conf files in" - <+> text conf_dir <> text ", treating" + <+> OsPath.pprOsPath conf_dir <> text ", treating" <+> text "package database as empty" return [] else throwGhcExceptionIO $ InstallationError $ - "there is no package.cache in " ++ conf_dir ++ + "there is no package.cache in " ++ show conf_dir ++ " even though package database is not empty" @@ -830,13 +833,13 @@ readUnitDatabase logger cfg conf_file = do -- assumes it's a file and tries to overwrite with 'writeFile'. -- ghc-pkg also cooperates with this workaround. tryReadOldFileStyleUnitInfo = do - content <- readFile conf_file `catchIO` \_ -> return "" + content <- readFile (OsPath.unsafeDecodeUtf conf_file) `catchIO` \_ -> return "" if take 2 content == "[]" then do - let conf_dir = conf_file <.> "d" - direxists <- doesDirectoryExist conf_dir + let conf_dir = conf_file OsPath.<.> OsPath.unsafeEncodeUtf "d" + direxists <- OsPath.doesDirectoryExist conf_dir if direxists - then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir) + then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> OsPath.pprOsPath conf_dir) liftM Just (readDirStyleUnitInfo conf_dir) else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing @@ -846,11 +849,12 @@ distrustAllUnits pkgs = map distrust pkgs where distrust pkg = pkg{ unitIsTrusted = False } -mungeUnitInfo :: FilePath -> FilePath +-- TODO: Can we help it with this one? it comes from the ghc-boot package +mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = mungeDynLibFields - . mungeUnitInfoPaths (ST.pack top_dir) (ST.pack pkgroot) + . mungeUnitInfoPaths (ST.pack (OsPath.unsafeDecodeUtf top_dir)) (ST.pack (OsPath.unsafeDecodeUtf pkgroot)) mungeDynLibFields :: UnitInfo -> UnitInfo mungeDynLibFields pkg = @@ -1388,7 +1392,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] where merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ - text "loading package database" <+> text db_path + text "loading package database" <+> OsPath.pprOsPath db_path forM_ (Set.toList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> ===================================== compiler/ghc.cabal.in ===================================== @@ -115,6 +115,7 @@ Library containers >= 0.6.2.1 && < 0.8, array >= 0.1 && < 0.6, filepath >= 1 && < 1.6, + os-string >= 2.0.1 && < 2.1, template-haskell == 2.22.*, hpc >= 0.6 && < 0.8, transformers >= 0.5 && < 0.7, @@ -430,6 +431,7 @@ Library GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList + GHC.Data.OsPath GHC.Data.Pair GHC.Data.SmallArray GHC.Data.Stream View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5fb170e47efa851ad43659899feb1f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5fb170e47efa851ad43659899feb1f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/torsten.schmits/mercury-ghc910-mhu-transitive-th-deps_ospath
by Torsten Schmits (＠torsten.schmits) 16 Nov '25

16 Nov '25

Torsten Schmits pushed new branch wip/torsten.schmits/mercury-ghc910-mhu-transitive-th-deps_ospath at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/mercury-ghc91… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] 2 commits: Rebase fixup: ghcWithInternalInterpreter
by Sven Tennie (＠supersven) 16 Nov '25

16 Nov '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: 025f7892 by Sven Tennie at 2025-11-16T15:25:51+01:00 Rebase fixup: ghcWithInternalInterpreter - - - - - b0586cc4 by Sven Tennie at 2025-11-16T15:26:12+01:00 Provide config.cross flag to testsuite - - - - - 5 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Setting ( -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, libsuf, ghcVersionStage, bashPath, targetStage, crossStage, queryTarget, queryTargetTarget, - ghcWithInterpreter, isHostStage, + isHostStage, -- ** Target platform things anyTargetOs, anyTargetArch, anyHostOs, @@ -181,22 +181,6 @@ targetSupportsRPaths stage = queryTargetTarget stage (\t -> let os = archOS_OS (tgtArchOs t) in osElfTarget os || osMachOTarget os) --- | Check whether the target supports GHCi. -ghcWithInterpreter :: Stage -> Action Bool -ghcWithInterpreter stage = do - goodOs <- anyTargetOs stage [ OSMinGW32, OSLinux, OSSolaris2 -- TODO "cygwin32"?, - , OSFreeBSD, OSDragonFly, OSNetBSD, OSOpenBSD - , OSDarwin, OSKFreeBSD - , OSWasi ] - goodArch <- (||) <$> - anyTargetArch stage [ ArchX86, ArchX86_64, ArchPPC - , ArchAArch64, ArchS390X - , ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2 - , ArchRISCV64, ArchLoongArch64 - , ArchWasm32 ] - <*> isArmTarget stage - return $ goodOs && goodArch && (stage >= Stage1) - -- | Which variant of the ARM architecture is the target (or 'Nothing' if not -- ARM)? targetArmVersion :: Stage -> Action (Maybe ArmISA) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -12,6 +12,7 @@ import Hadrian.Oracles.TextFile (lookupStageBuildConfig) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles import Oracles.Setting +import Settings.Program (ghcWithInterpreter) import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) @@ -489,7 +490,7 @@ generateSettings settingsFile = do -- ROMES:TODO: WHERE HAS CROSS COMPILING GONE? -- ("cross compiling", expr $ yesNo <$> crossStage (predStage stage)) [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit, Context.stage = predStage stage }))) - , ("Use interpreter", expr $ yesNo <$> Oracles.Setting.ghcWithInterpreter stage) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) -- Hard-coded as Cabal queries these to determine way support and we -- need to always advertise all ways when bootstrapping. -- The settings file is generated at install time when installing a bindist. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -11,7 +11,7 @@ import Settings.Builders.Common import qualified Settings.Builders.Common as S import Control.Exception (assert) import qualified Data.Set as Set -import Settings.Program (programContext) +import Settings.Program (programContext, ghcWithInterpreter) import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink, targetPlatformTriple) import GHC.Toolchain.Program (prgFlags) @@ -139,7 +139,7 @@ libraryArgs = do contextWay <- getWay package <- getPackage stage <- getStage - withGhci <- expr (ghcWithInterpreter stage) + withGhci <- expr $ ghcWithInterpreter stage dynPrograms <- expr (flavour >>= flip dynamicGhcPrograms stage) ghciObjsSupported <- expr (targetSupportsGhciObjects stage) let ways = Set.insert contextWay flavourWays ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -15,6 +15,7 @@ import CommandLine import Oracles.TestSettings import Packages import Settings.Builders.Common +import Settings.Program (ghcWithInterpreter) import qualified Data.Set as Set import Flavour import qualified Context.Type as C @@ -62,6 +63,7 @@ data TestCompilerArgs = TestCompilerArgs{ , leadingUnderscore :: Bool , withNativeCodeGen :: Bool , withInterpreter :: Bool + , cross :: Bool , interpForceDyn :: Bool , unregisterised :: Bool , tables_next_to_code :: Bool @@ -96,9 +98,9 @@ allowHaveLLVM = not . (`elem` ["wasm32", "javascript"]) -- inTreeCompilerArgs :: Stage -> Action TestCompilerArgs inTreeCompilerArgs stg = do - isCrossStage <- crossStage stg + cross <- crossStage stg let ghcStage = succStage stg - pkgCacheStage = if isCrossStage then ghcStage else stg + pkgCacheStage = if cross then ghcStage else stg (hasDynamicRts, hasThreadedRts) <- do ways <- interpretInContext (vanillaContext ghcStage rts) getRtsWays return (dynamic `elem` ways, threaded `elem` ways) @@ -158,11 +160,11 @@ outOfTreeCompilerArgs = do leadingUnderscore <- getBooleanSetting TestLeadingUnderscore withNativeCodeGen <- getBooleanSetting TestGhcWithNativeCodeGen withInterpreter <- getBooleanSetting TestGhcWithInterpreter + cross <- getBooleanSetting TestGhcCrossCompiling interpForceDyn <- getBooleanSetting TestRTSLinkerForceDyn unregisterised <- getBooleanSetting TestGhcUnregisterised tables_next_to_code <- getBooleanSetting TestGhcTablesNextToCode targetWithSMP <- getBooleanSetting TestGhcWithSMP - debugAssertions <- getBooleanSetting TestGhcDebugAssertions os <- getTestSetting TestHostOS @@ -279,6 +281,7 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter + , arg "-e", arg $ "config.cross=" ++ show cross , arg "-e", arg $ "config.interp_force_dyn=" ++ show interpForceDyn , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised , arg "-e", arg $ "config.tables_next_to_code=" ++ show tables_next_to_code ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Oracles.Flag import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import Settings.Program (ghcWithInterpreter) import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target @@ -82,16 +83,18 @@ packageArgs = do ] , builder (Cabal Flags) ? mconcat - -- For the ghc library, internal-interpreter only makes - -- sense when we're not cross compiling. For cross GHC, - -- external interpreter is used for loading target code - -- and internal interpreter is supposed to load native - -- code for plugins (!7377), however it's unfinished work - -- (#14335) and completely untested in CI for cross - -- backends at the moment, so we might as well disable it - -- for cross GHC. - -- TODO: MP - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + -- In order to enable internal-interpreter for the ghc + -- library: + -- + -- 1. ghcWithInterpreter must be True ("Use interpreter" = + -- "YES") + -- 2. For non-cross case it can be enabled + -- 3. For cross case, disable for stage0 since that runs + -- on the host and must rely on external interpreter to + -- load target code, otherwise enable for stage1 since + -- that runs on the target and can use target's own + -- ghci object linker + [ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage2]] `cabalFlag` "internal-interpreter" , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , staged (buildFlag UseLibzstd) `cabalFlag` "with-libzstd" @@ -113,7 +116,7 @@ packageArgs = do , compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5ea99680084fed87bb672f4da135e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5ea99680084fed87bb672f4da135e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] 2 commits: Rebase fixup: ghcWithInternalInterpreter
by Sven Tennie (＠supersven) 16 Nov '25

16 Nov '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: 652091c5 by GHC GitLab CI at 2025-11-16T14:35:18+01:00 Rebase fixup: ghcWithInternalInterpreter - - - - - b5ea9968 by GHC GitLab CI at 2025-11-16T14:35:56+01:00 Provide config.cross flag to testsuite - - - - - 5 changed files: - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -7,7 +7,7 @@ module Oracles.Setting ( -- * Helpers ghcCanonVersion, cmdLineLengthLimit, targetSupportsRPaths, topDirectory, libsuf, ghcVersionStage, bashPath, targetStage, crossStage, queryTarget, queryTargetTarget, - ghcWithInterpreter, isHostStage, + isHostStage, -- ** Target platform things anyTargetOs, anyTargetArch, anyHostOs, @@ -181,22 +181,6 @@ targetSupportsRPaths stage = queryTargetTarget stage (\t -> let os = archOS_OS (tgtArchOs t) in osElfTarget os || osMachOTarget os) --- | Check whether the target supports GHCi. -ghcWithInterpreter :: Stage -> Action Bool -ghcWithInterpreter stage = do - goodOs <- anyTargetOs stage [ OSMinGW32, OSLinux, OSSolaris2 -- TODO "cygwin32"?, - , OSFreeBSD, OSDragonFly, OSNetBSD, OSOpenBSD - , OSDarwin, OSKFreeBSD - , OSWasi ] - goodArch <- (||) <$> - anyTargetArch stage [ ArchX86, ArchX86_64, ArchPPC - , ArchAArch64, ArchS390X - , ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2 - , ArchRISCV64, ArchLoongArch64 - , ArchWasm32 ] - <*> isArmTarget stage - return $ goodOs && goodArch && (stage >= Stage1) - -- | Which variant of the ARM architecture is the target (or 'Nothing' if not -- ARM)? targetArmVersion :: Stage -> Action (Maybe ArmISA) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -12,6 +12,7 @@ import Hadrian.Oracles.TextFile (lookupStageBuildConfig) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles import Oracles.Setting +import Settings.Program (ghcWithInterpreter) import Hadrian.Haskell.Cabal.Type (PackageData(version)) import Hadrian.Haskell.Cabal import Hadrian.Oracles.Cabal (readPackageData) @@ -489,7 +490,7 @@ generateSettings settingsFile = do -- ROMES:TODO: WHERE HAS CROSS COMPILING GONE? -- ("cross compiling", expr $ yesNo <$> crossStage (predStage stage)) [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit, Context.stage = predStage stage }))) - , ("Use interpreter", expr $ yesNo <$> Oracles.Setting.ghcWithInterpreter stage) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) -- Hard-coded as Cabal queries these to determine way support and we -- need to always advertise all ways when bootstrapping. -- The settings file is generated at install time when installing a bindist. ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -11,7 +11,7 @@ import Settings.Builders.Common import qualified Settings.Builders.Common as S import Control.Exception (assert) import qualified Data.Set as Set -import Settings.Program (programContext) +import Settings.Program (programContext, ghcWithInterpreter) import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink, targetPlatformTriple) import GHC.Toolchain.Program (prgFlags) @@ -139,7 +139,7 @@ libraryArgs = do contextWay <- getWay package <- getPackage stage <- getStage - withGhci <- expr (ghcWithInterpreter stage) + withGhci <- expr $ ghcWithInterpreter stage dynPrograms <- expr (flavour >>= flip dynamicGhcPrograms stage) ghciObjsSupported <- expr (targetSupportsGhciObjects stage) let ways = Set.insert contextWay flavourWays ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -15,6 +15,7 @@ import CommandLine import Oracles.TestSettings import Packages import Settings.Builders.Common +import Settings.Program (ghcWithInterpreter) import qualified Data.Set as Set import Flavour import qualified Context.Type as C @@ -62,6 +63,7 @@ data TestCompilerArgs = TestCompilerArgs{ , leadingUnderscore :: Bool , withNativeCodeGen :: Bool , withInterpreter :: Bool + , cross :: Bool , interpForceDyn :: Bool , unregisterised :: Bool , tables_next_to_code :: Bool @@ -96,9 +98,9 @@ allowHaveLLVM = not . (`elem` ["wasm32", "javascript"]) -- inTreeCompilerArgs :: Stage -> Action TestCompilerArgs inTreeCompilerArgs stg = do - isCrossStage <- crossStage stg + cross <- crossStage stg let ghcStage = succStage stg - pkgCacheStage = if isCrossStage then ghcStage else stg + pkgCacheStage = if cross then ghcStage else stg (hasDynamicRts, hasThreadedRts) <- do ways <- interpretInContext (vanillaContext ghcStage rts) getRtsWays return (dynamic `elem` ways, threaded `elem` ways) @@ -158,11 +160,11 @@ outOfTreeCompilerArgs = do leadingUnderscore <- getBooleanSetting TestLeadingUnderscore withNativeCodeGen <- getBooleanSetting TestGhcWithNativeCodeGen withInterpreter <- getBooleanSetting TestGhcWithInterpreter + cross <- getBooleanSetting TestGhcCrossCompiling interpForceDyn <- getBooleanSetting TestRTSLinkerForceDyn unregisterised <- getBooleanSetting TestGhcUnregisterised tables_next_to_code <- getBooleanSetting TestGhcTablesNextToCode targetWithSMP <- getBooleanSetting TestGhcWithSMP - debugAssertions <- getBooleanSetting TestGhcDebugAssertions os <- getTestSetting TestHostOS @@ -279,6 +281,7 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter + , arg "-e", arg $ "config.cross=" ++ show cross , arg "-e", arg $ "config.interp_force_dyn=" ++ show interpForceDyn , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised , arg "-e", arg $ "config.tables_next_to_code=" ++ show tables_next_to_code ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -8,6 +8,7 @@ import Oracles.Flag import Packages import Settings import Settings.Builders.Common (wayCcArgs) +import Settings.Program (ghcWithInterpreter) import qualified GHC.Toolchain.Library as Lib import GHC.Toolchain.Target @@ -82,16 +83,18 @@ packageArgs = do ] , builder (Cabal Flags) ? mconcat - -- For the ghc library, internal-interpreter only makes - -- sense when we're not cross compiling. For cross GHC, - -- external interpreter is used for loading target code - -- and internal interpreter is supposed to load native - -- code for plugins (!7377), however it's unfinished work - -- (#14335) and completely untested in CI for cross - -- backends at the moment, so we might as well disable it - -- for cross GHC. - -- TODO: MP - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + -- In order to enable internal-interpreter for the ghc + -- library: + -- + -- 1. ghcWithInterpreter must be True ("Use interpreter" = + -- "YES") + -- 2. For non-cross case it can be enabled + -- 3. For cross case, disable for stage0 since that runs + -- on the host and must rely on external interpreter to + -- load target code, otherwise enable for stage1 since + -- that runs on the target and can use target's own + -- ghci object linker + [ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage2]] `cabalFlag` "internal-interpreter" , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , staged (buildFlag UseLibzstd) `cabalFlag` "with-libzstd" @@ -113,7 +116,7 @@ packageArgs = do , compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ] , builder (Cabal Flags) ? mconcat - [ andM [ghcWithInterpreter stage, notM isCrossStage] `cabalFlag` "internal-interpreter" + [ (expr (ghcWithInterpreter stage)) `cabalFlag` "internal-interpreter" , ifM stage0 -- We build a threaded stage 1 if the bootstrapping compiler -- supports it. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca6129780c811d78cfbc04fde5f1ac… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca6129780c811d78cfbc04fde5f1ac… You're receiving this email because of your account on gitlab.haskell.org.

1 0