November 2025 - ghc-commits

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

16 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) 16 Nov '25

16 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) 16 Nov '25

16 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) 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: 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) 16 Nov '25

16 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

[Git][ghc/ghc][master] 3 commits: SimpleOpt: refactor & push coercions into lambdas
by Marge Bot (＠marge-bot) 16 Nov '25

16 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 15b311be by sheaf at 2025-11-15T20:32:02-05:00 SimpleOpt: refactor & push coercions into lambdas This commit improves the simple optimiser (in GHC.Core.SimpleOpt) in a couple of ways: - The logic to push coercion lambdas is shored up. The function 'pushCoercionIntoLambda' used to be called in 'finish_app', but this meant we could not continue to optimise the program after performing this transformation. Now, we call 'pushCoercionIntoLambda' as part of 'simple_app'. Doing so can be important when dealing with unlifted newtypes, as explained in Note [Desugaring unlifted newtypes]. - The code is re-structured to avoid duplication and out-of-sync code paths. Now, 'simple_opt_expr' defers to 'simple_app' for the 'App', 'Var', 'Cast' and 'Lam' cases. This means all the logic for those is centralised in a single place (e.g. the 'go_lam' helper function). To do this, the general structure is brought a bit closer to the full-blown simplifier, with a notion of 'continuation' (see 'SimpleContItem'). This commit also modifies GHC.Core.Opt.Arity.pushCoercionIntoLambda to apply a substitution (a slight generalisation of its existing implementation). - - - - - b33284c7 by sheaf at 2025-11-15T20:32:02-05:00 Improve typechecking of data constructors This commit changes the way in which we perform typecheck data constructors, in particular how we make multiplicities line up. Now, impedance matching occurs as part of the existing subsumption machinery. See the revamped Note [Typechecking data constructors] in GHC.Tc.Gen.App, as well as Note [Polymorphisation of linear fields] in GHC.Core.Multiplicity. This allows us to get rid of a fair amount of hacky code that was added with the introduction of LinearTypes; in particular the logic of GHC.Tc.Gen.Head.tcInferDataCon. ------------------------- Metric Decrease: T10421 T14766 T15164 T15703 T19695 T5642 T9630 WWRec ------------------------- - - - - - b6faf5d0 by sheaf at 2025-11-15T20:32:02-05:00 Handle unsaturated rep-poly newtypes This commit allows GHC to handle unsaturated occurrences of unlifted newtype constructors. The plan is detailed in Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Utils.Concrete: for unsaturated unlifted newtypes, we perform the appropriate representation-polymorphism check in tcInstFun. - - - - - 65 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/ghci/scripts/T8959b.stderr - testsuite/tests/ghci/scripts/ghci051.stderr - testsuite/tests/indexed-types/should_compile/T12538.stderr - + testsuite/tests/linear/should_compile/LinearEtaExpansions.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/linear/should_fail/TypeClass.hs - testsuite/tests/linear/should_fail/TypeClass.stderr - testsuite/tests/linear/should_run/LinearGhci.stdout - testsuite/tests/numeric/should_compile/T16402.stderr-ws-64 - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/rep-poly/RepPolyCase1.stderr - − testsuite/tests/rep-poly/RepPolyCase2.stderr - testsuite/tests/rep-poly/RepPolyRule3.stderr - testsuite/tests/rep-poly/RepPolyTuple4.stderr - testsuite/tests/rep-poly/T13233.stderr - − testsuite/tests/rep-poly/T17021.stderr - testsuite/tests/rep-poly/T20363b.stderr - − testsuite/tests/rep-poly/T21650_a.stderr - − testsuite/tests/rep-poly/T21650_b.stderr - + testsuite/tests/rep-poly/T26072.hs - testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr - testsuite/tests/rep-poly/all.T - testsuite/tests/typecheck/should_fail/T15883e.stderr - testsuite/tests/typecheck/should_fail/T2414.stderr - testsuite/tests/typecheck/should_fail/T2534.stderr - testsuite/tests/typecheck/should_fail/T7264.stderr - utils/haddock/hypsrc-test/ref/src/Classes.html - utils/haddock/hypsrc-test/ref/src/Quasiquoter.html The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a64a78bc91a57868195d596d98ebb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a64a78bc91a57868195d596d98ebb… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] AArch64: Simplify CmmAssign and CmmStore
by Marge Bot (＠marge-bot) 16 Nov '25

16 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0a64a78b by Sven Tennie at 2025-11-15T20:31:10-05:00 AArch64: Simplify CmmAssign and CmmStore The special handling for floats was fake: The general case is always used. So, the additional code path isn't needed (and only adds complexity for the reader.) - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -317,15 +317,9 @@ stmtToInstrs stmt = do CmmComment s -> return (unitOL (COMMENT (ftext s))) CmmTick {} -> return nilOL - CmmAssign reg src - | isFloatType ty -> assignReg_FltCode format reg src - | otherwise -> assignReg_IntCode format reg src - where ty = cmmRegType reg - format = cmmTypeFormat ty + CmmAssign reg src -> assignReg reg src - CmmStore addr src _alignment - | isFloatType ty -> assignMem_FltCode format addr src - | otherwise -> assignMem_IntCode format addr src + CmmStore addr src _alignment -> assignMem format addr src where ty = cmmExprType platform src format = cmmTypeFormat ty @@ -1480,13 +1474,8 @@ getAmode _platform _ expr -- fails when the right hand side is forced into a fixed register -- (e.g. the result of a call). -assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock - -assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock - -assignMem_IntCode rep addrE srcE +assignMem :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignMem rep addrE srcE = do (src_reg, _format, code) <- getSomeReg srcE platform <- getPlatform @@ -1497,19 +1486,17 @@ assignMem_IntCode rep addrE srcE `appOL` addr_code `snocOL` STR rep (OpReg w src_reg) (OpAddr addr)) -assignReg_IntCode _ reg src +assignReg :: CmmReg -> CmmExpr -> NatM InstrBlock +assignReg reg src = do platform <- getPlatform let dst = getRegisterReg platform reg r <- getRegister src return $ case r of - Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst - Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` (fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg)) - --- Let's treat Floating point stuff --- as integer code for now. Opaque. -assignMem_FltCode = assignMem_IntCode -assignReg_FltCode = assignReg_IntCode + Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) + `consOL` code dst + Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) + `consOL` (fcode `snocOL` MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg)) -- ----------------------------------------------------------------------------- -- Jumps View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a64a78bc91a57868195d596d98ebbd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a64a78bc91a57868195d596d98ebbd… You're receiving this email because of your account on gitlab.haskell.org.

1 0