- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/dcoutts/windows-dlls-experimental] 11 commits: Fixup: merge mistake from foreign-label-source-refactoring on top of cmm-imports
by Duncan Coutts (＠dcoutts) 29 Apr '26

29 Apr '26

Duncan Coutts pushed to branch wip/dcoutts/windows-dlls-experimental at Glasgow Haskell Compiler / GHC Commits: f7379956 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Fixup: merge mistake from foreign-label-source-refactoring on top of cmm-imports - - - - - 12f32953 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Use response files for hadrian linking with ghc (support long command lines) In future support for windows dynamic linking, we expect long command lines for linking dll files with ghc. Experiments with dynamic linking the ghc-internal library yielded a link command well over 32kb. We did not encounter this before for static libs, since we already use ar's @file feature (if available, which it is for the llvm toolchain). Co-authored-by: David Eichmann <davide(a)well-typed.com> - - - - - f8aa77ce by Duncan Coutts at 2026-04-28T22:08:53+01:00 Use __attribute__((dllimport)) for external RTS symbol declarations This is needed to be hygenic about DLL symbol imports and exports. The attribute is ignored on platforms other than Windows. Use of the attribute however means that external data symbols do not have a compile-time constant address (they are loaded using an indirection). This means we have to adjust the rtsSyms initial linker table so that it is a local constant in a function, rather than a global constant. We now define it within a function that pre-populates the symbol table with the RTS symbols. - - - - - 38a785e6 by Duncan Coutts at 2026-04-28T22:08:53+01:00 Fix the rts linker declarations for a few data symbols and ensure that the (windows only) rts_IOManagerIsWin32Native data symbol is marked as externally visible. - - - - - 146a2773 by David Eichmann at 2026-04-28T22:08:53+01:00 Hadrian: Disable runtime pseudo relocations for RTS on windows hosts - - - - - 8515501c by Duncan Coutts at 2026-04-28T22:08:54+01:00 Hadrian: remove legacy rts .so symlinks For compatibility with the old makefile based build system, hadrian had rules to generate symlinks from unversioned to versioned names for the rts .so/.dynlib file, like libHSrts-ghcx.y.so -> libHSrts-1.0.3-ghcx.y.so We no longer need these symlinks since the makefile build system has been retired some time ago. The need for these symlinks is awkward on windows where we cannot (in practice) create symlinks. So rather than make them conditional (non-windows), just remove them entirely. - - - - - f619d4b9 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Enable -dynamic-too on Windows, and static top level constructors To make -dynamic-too work on Windows we have to enable top level static constructors as well. Otherwise the static and dynamic output differs in ways that are incompatible with -dynamic-too. Enabling top level constructors also significantly reduces the number of exported symbols, which is useful since on Windows where there is a 64k limit. Historically top level constructors did not work for Windows Dlls, but with the modern toolchain (llvm lld or gcc ld and Mingw) we can use "pseudo relocations" to patch up the initialised data when the .dll is loaded. This is much like ELF relocations, but is performed by the Mingw C library, using data tables generated by ld/lld. - - - - - b10aafe7 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Enable dynamic lib support on Windows The build system will now try to build dynamic libs. - - - - - d8139e1d by Duncan Coutts at 2026-04-28T22:08:54+01:00 Hadrian: only build executable modules in the one way they will be used Previously, for an executable, the modules that are part of the exeutable itself (so not in lib dependencies) can be built in multiple ways. This makes use of the info about the ways that would be used for library modules. In particular, if the library ways include vanilla and dynamic, then the executable modules will be built with -dynamic-too. This is obviously a waste of time. This commit changes the defaultLibraryWays so that for exeutable packages it only picks the single program way. This involves factoring out a programWay helper from the existing programContext function. - - - - - 23a3a960 by Duncan Coutts at 2026-04-28T22:08:54+01:00 Update defaultDynamicGhcPrograms to use windows target not host The inability to build ghc dynamically is about the windows as the target machine, not as the host machine. Add a comment to explain why we limit it on windows for now. - - - - - 9b0ddfde by Duncan Coutts at 2026-04-28T22:08:54+01:00 Only build the ghc lib the dynamic way if supported It is not supported on Windows, yet. The problem is that we hit the 64k limit on the number of exported symbols for a single dll. We delegate to the defaultDynamicGhcPrograms predicate to decide if it is supported. - - - - - 16 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/Session.hs - compiler/GHC/Stg/Utils.hs - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - rts/IOManager.h - rts/Linker.c - rts/RtsSymbols.c - rts/RtsSymbols.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -668,25 +668,29 @@ importName -- an unnamed Haskell package. This corresponds on Windows/PE to -- __declspec(dllimport) in C. | 'extern' NAME - { ($2, mkForeignLabel $2 ForeignLabelInExternalPackage IsFunction) } + { ($2, mkForeignLabel $2 ForeignLabelInExternalPackage + ForeignLabelIsFunction) } -- A data label imported from another unamed shared library. -- This corresponds on Windows/PE to __declspec(dllimport) in C (but -- cmm doesn't know about data vs function symbols so we have to say). | 'extern' 'DATA' NAME - { ($3, mkForeignLabel $3 ForeignLabelInExternalPackage IsData) } + { ($3, mkForeignLabel $3 ForeignLabelInExternalPackage + ForeignLabelIsData) } -- A code label imported from the shared library for a Haskell package -- with the given UnitId. Such labels behave as local when used within -- the specified unit, or as extern otherwise. | STRING NAME - { ($2, mkForeignLabel $2 (ForeignLabelInPackage (UnitId (mkFastString $1))) IsFunction) } + { ($2, mkForeignLabel $2 (ForeignLabelInPackage (UnitId (mkFastString $1))) + ForeignLabelIsFunction) } -- A data label imported from the shared library for a Haskell package -- with the given UnitId. Such labels behave as local when used within -- the specified unit, or as extern otherwise. | STRING 'DATA' NAME - { ($3, mkForeignLabel $3 (ForeignLabelInPackage (UnitId (mkFastString $1))) IsData) } + { ($3, mkForeignLabel $3 (ForeignLabelInPackage (UnitId (mkFastString $1))) + ForeignLabelIsData) } names :: { [FastString] } ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3624,7 +3624,7 @@ compilerInfo dflags ("target has RTS linker", showBool $ platformHasRTSLinker platform), ("Target default backend", show $ platformDefaultBackend platform), -- Whether or not we support @-dynamic-too@ - ("Support dynamic-too", showBool $ not isWindows), + ("Support dynamic-too", "YES"), -- Whether or not we support the @-j@ flag with @--make@. ("Support parallel --make", "YES"), -- Whether or not we support "Foo from foo-0.1-XXX:Foo" syntax in @@ -3659,7 +3659,6 @@ compilerInfo dflags showBool True = "YES" showBool False = "NO" platform = targetPlatform dflags - isWindows = platformOS platform == OSMinGW32 expandDirectories = expandToolDir (toolDir dflags) . expandTopDir (topDir dflags) query :: (Target -> a) -> a query f = f (rawTarget dflags) @@ -3757,11 +3756,6 @@ makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Warn], [Located SDoc]) -- ensure that a later change doesn't invalidate an earlier check. -- Be careful not to introduce potential loops! makeDynFlagsConsistent dflags - -- Disable -dynamic-too on Windows (#8228, #7134, #5987) - | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags - = let dflags' = gopt_unset dflags Opt_BuildDynamicToo - warn = "-dynamic-too is not supported on Windows" - in loop dflags' warn -- Disable -dynamic-too if we are are compiling with -dynamic already, otherwise -- you get two dynamic object files (.o and .dyn_o). (#20436) | ways dflags `hasWay` WayDyn && gopt Opt_BuildDynamicToo dflags ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -128,6 +128,9 @@ stripStgTicksTopE p = go go other = other -- | Do we allow the given top-level (static) ConApp? +-- +-- Currently this is unconditionally True, but historically it has been more +-- complicated, so the mechanism to choose otherwise is still here for now. allowTopLevelConApp :: Platform -> Bool -- is Opt_ExternalDynamicRefs enabled? @@ -138,22 +141,18 @@ allowTopLevelConApp allowTopLevelConApp platform ext_dyn_refs this_mod con args -- we're not using dynamic linking | not ext_dyn_refs = True - -- if the target OS is Windows, we only allow top-level ConApps if they don't - -- reference external names (Windows DLLs have a problem with static cross-DLL - -- refs) - | platformOS platform == OSMinGW32 = not is_external_con_app + + -- On Windows, for now, always use top level constructor applications, and + -- rely on Mingw "pseudo relocations" to make this work. We might want to + -- have a flag to control this behaviour, because using pseudo-relocations + -- can be incompatible with some security restrictions, but note that + -- ghc-internal and everything would need to be rebuilt. Note also that + -- dynamic top level con apps increases symbol exports a lot. + | platformOS platform == OSMinGW32 = True + -- otherwise, allowed -- Sylvain: shouldn't this be False when (ext_dyn_refs && is_external_con_app)? | otherwise = True - where - is_external_con_app = isDynLinkName platform this_mod (dataConName con) || any is_dll_arg args - - -- NB: typePrimRep1 is legit because any free variables won't have - -- unlifted type (there are no unlifted things at top level) - is_dll_arg :: StgArg -> Bool - is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep1 (idType v)) - && isDynLinkName platform this_mod (idName v) - is_dll_arg _ = False -- True of machine addresses; these are the things that don't work across DLLs. -- The key point here is that VoidRep comes out False, so that a top level ===================================== hadrian/src/Builder.hs ===================================== @@ -346,11 +346,7 @@ instance H.Builder Builder where Haddock BuildPackage -> runHaddock path buildArgs buildInputs - Ghc FindHsDependencies _ -> do - -- Use a response file for ghc -M invocations, to - -- avoid issues with command line size limit on - -- Windows (#26637) - runGhcWithResponse path buildArgs buildInputs + Ghc _ _ -> runGhcWithResponse path buildArgs buildInputs buildOptions HsCpp -> captureStdout @@ -394,16 +390,18 @@ runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do writeFile' tmp $ escapeArgs fileInputs cmd [haddockPath] flagArgs ('@' : tmp) -runGhcWithResponse :: FilePath -> [String] -> [FilePath] -> Action () -runGhcWithResponse ghcPath flagArgs fileInputs = withTempFile $ \tmp -> do - - writeFile' tmp $ escapeArgs fileInputs - - -- We can't put the flags in a response file, because some flags - -- require empty arguments (such as the -dep-suffix flag), but - -- that isn't supported yet due to #26560. - cmd [ghcPath] flagArgs ('@' : tmp) - +-- | Use a response file for ghc invocations to avoid issues with command line +-- size limit on Windows (#26637). +runGhcWithResponse :: FilePath -- ^ Path to ghc + -> [String] -- ^ Arguments passed on the command line + -> [FilePath] -- ^ Input file paths (passed via response file) + -> [CmdOption] + -> Action () +runGhcWithResponse ghcPath buildArgs buildInputs buildOptions = withTempFile $ \tmp -> do + let tmpContents = escapeArgs buildInputs + putVerbose $ "Build Inputs (" <> tmp <> "): " <> show buildInputs + writeFile' tmp tmpContents + cmd [ghcPath] buildArgs ('@' : tmp) buildOptions -- TODO: Some builders are required only on certain platforms. For example, -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -29,7 +29,9 @@ import Hadrian.Utilities -- | This data structure captures all information relevant to invoking a builder. data BuildInfo = BuildInfo { - -- | Command line arguments. + -- | Command line arguments. Some builders (e.g. Ar, Ghc, Haddock) omit + -- buildInputs from buildArgs so that buildInputs can be passed separately + -- using a response file. buildArgs :: [String], -- | Input files. buildInputs :: [FilePath], ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -82,11 +82,10 @@ arSupportsAtFile stage = Toolchain.arSupportsAtFile . tgtAr <$> targetStage stag platformSupportsSharedLibs :: Action Bool -- FIXME: This is querying about the target but is named "platformXXX", targetSupportsSharedLibs would be better platformSupportsSharedLibs = do - windows <- isWinTarget ppc_linux <- (&&) <$> anyTargetArch [ ArchPPC ] <*> anyTargetOs [ OSLinux ] solaris <- (&&) <$> anyTargetArch [ ArchX86 ] <*> anyTargetOs [ OSSolaris2 ] javascript <- anyTargetArch [ ArchJavaScript ] - return $ not (windows || javascript || ppc_linux || solaris) + return $ not (javascript || ppc_linux || solaris) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -12,7 +12,6 @@ import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal import Packages -import Rules.Rts import Settings import Target import Utilities @@ -88,14 +87,9 @@ parseToBuildSubdirectory root = do -- * Registering registerPackages :: [Context] -> Action () -registerPackages ctxs = do +registerPackages ctxs = need =<< mapM pkgRegisteredLibraryFile ctxs - -- Dynamic RTS library files need symlinks (Rules.Rts.rtsRules). - forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do - ways <- interpretInContext ctx (getLibraryWays <> getRtsWays) - needRtsSymLinks (stage ctx) ways - -- | Register a package and initialise the corresponding package database if -- need be. Note that we only register packages in 'Stage0' and 'Stage1'. registerPackageRules :: [(Resource, Int)] -> Stage -> Inplace -> Rules () ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -1,10 +1,5 @@ -{-# LANGUAGE MultiWayIf #-} +module Rules.Rts (rtsRules) where -module Rules.Rts (rtsRules, needRtsSymLinks) where - -import qualified Data.Set as Set - -import Packages (rts) import Hadrian.Utilities import Settings.Builders.Common @@ -12,18 +7,7 @@ import Settings.Builders.Common -- library files (see Rules.Library.libraryRules). rtsRules :: Rules () rtsRules = priority 3 $ do - -- Dynamic RTS library files need symlinks without the dummy version number. - -- This is for backwards compatibility (the old make build system omitted the - -- dummy version number). root <- buildRootRules - [ root -/- "**/libHSrts_*-ghc*.so", - root -/- "**/libHSrts_*-ghc*.dylib", - root -/- "**/libHSrts-ghc*.so", - root -/- "**/libHSrts-ghc*.dylib"] - |%> \ rtsLibFilePath' -> createFileLink - (addRtsDummyVersion $ takeFileName rtsLibFilePath') - rtsLibFilePath' - -- Solve the recursive dependency between the rts and ghc-internal -- on Windows by creating an import lib for the ghc-internal dll, -- to be linked into the rts dll. @@ -37,35 +21,3 @@ buildGhcInternalImportLib target = do output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] - --- Need symlinks generated by rtsRules. -needRtsSymLinks :: Stage -> Set.Set Way -> Action () -needRtsSymLinks stage rtsWays - = forM_ (Set.filter (wayUnit Dynamic) rtsWays) $ \ way -> do - let ctx = Context stage rts way Final - distDir <- distDynDir ctx - rtsLibFile <- takeFileName <$> pkgLibraryFile ctx - need [removeRtsDummyVersion (distDir </> rtsLibFile)] - -prefix, versionlessPrefix :: String -versionlessPrefix = "libHSrts" -prefix = versionlessPrefix ++ "-1.0.3" - --- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so" --- == "a/libHSrts-ghc1.2.3.4.so" -removeRtsDummyVersion :: FilePath -> FilePath -removeRtsDummyVersion = replaceLibFilePrefix prefix versionlessPrefix - --- addRtsDummyVersion "a/libHSrts-ghc1.2.3.4.so" --- == "a/libHSrts-1.0-ghc1.2.3.4.so" -addRtsDummyVersion :: FilePath -> FilePath -addRtsDummyVersion = replaceLibFilePrefix versionlessPrefix prefix - -replaceLibFilePrefix :: String -> String -> FilePath -> FilePath -replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let - oldFileName = takeFileName oldFilePath - newFileName = maybe - (error $ "Expected RTS library file to start with " ++ oldPrefix) - (newPrefix ++) - (stripPrefix oldPrefix oldFileName) - in replaceFileName oldFilePath newFileName ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -62,7 +62,6 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do [ arg "-fwrite-ide-info" , arg "-hiedir", arg hie_path ] - , getInputs , arg "-o", arg =<< getOutput ] compileC :: Args @@ -78,7 +77,6 @@ compileC = builder (Ghc CompileCWithGhc) ? do , mconcat (map (map ("-optc" ++) <$>) ccArgs) , defaultGhcWarningsArgs , arg "-c" - , getInputs , arg "-o" , arg =<< getOutput ] @@ -95,7 +93,6 @@ compileCxx = builder (Ghc CompileCppWithGhc) ? do , mconcat (map (map ("-optcxx" ++) <$>) ccArgs) , defaultGhcWarningsArgs , arg "-c" - , getInputs , arg "-o" , arg =<< getOutput ] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -44,6 +44,7 @@ import Settings.Builders.SplitSections import Settings.Builders.RunTest import Settings.Builders.Xelatex import Settings.Packages +import Settings.Program import Settings.Warnings import qualified Hadrian.Builder.Git import Settings.Builders.Win32Tarballs @@ -215,12 +216,32 @@ testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, -- * We build 'profiling' way when stage > Stage0. -- * We build 'dynamic' way when stage > Stage0 and the platform supports it. defaultLibraryWays :: Ways -defaultLibraryWays = Set.fromList <$> - mconcat - [ pure [vanilla] - , notStage0 ? pure [profiling] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic, profilingDynamic] - ] +defaultLibraryWays = do + pkg <- getPackage + if isLibrary pkg + + -- modules for libraries get built several ways + then Set.fromList <$> + mconcat + [ pure [vanilla] + , notStage0 ? pure [profiling] + , notStage0 ? platformSupportsSharedLibs + ? onlyDynGhcLibIfSupported + ? pure [dynamic, profilingDynamic] + ] + + -- modules for executables get built only one way + else do stage <- getStage + Set.singleton <$> expr (programWay stage pkg) + +-- | Only build the ghc library the dynamic way, if the platform supports it. +-- +onlyDynGhcLibIfSupported :: Predicate +onlyDynGhcLibIfSupported = do + pkg <- getPackage + if pkg == compiler + then expr defaultDynamicGhcPrograms + else pure True -- | Default build ways for the RTS. defaultRtsWays :: Ways @@ -310,7 +331,10 @@ defaultFlavour = Flavour defaultDynamicGhcPrograms :: Action Bool defaultDynamicGhcPrograms = do supportsShared <- platformSupportsSharedLibs - return (not windowsHost && supportsShared) + winTarget <- isWinTarget + -- For now, don't build dynamic ghc on windows because we hit dll + -- symbol limits for the ghc library. + return (supportsShared && not winTarget) -- | All 'Builder'-dependent command line arguments. defaultBuilderArgs :: Args ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -321,6 +321,7 @@ rtsPackageArgs = package rts ? do , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? arg "-optc-DNOSMP" + , isWinHost ? arg "-optl-Wl,--disable-runtime-pseudo-reloc" -- See Note [AutoApply.cmm for vectors] in genapply/Main.hs -- ===================================== hadrian/src/Settings/Program.hs ===================================== @@ -1,5 +1,6 @@ module Settings.Program ( programContext + , programWay , ghcWithInterpreter ) where @@ -17,18 +18,21 @@ import Settings.Builders.Common (anyTargetOs, anyTargetArch, isArmTarget) -- get a context/contexts for a given stage and package. programContext :: Stage -> Package -> Action Context programContext stage pkg = do - profiled <- askGhcProfiled stage - dynGhcProgs <- askDynGhcPrograms --dynamicGhcPrograms =<< flavour - return $ Context stage pkg (wayFor profiled dynGhcProgs) Final + way <- programWay stage pkg + return $ Context stage pkg way Final - where wayFor prof dyn - | prof && dyn = profilingDynamic - | pkg == ghc && prof && notStage0 stage = profiling - | dyn && notStage0 stage = dynamic - | otherwise = vanilla +programWay :: Stage -> Package -> Action Way +programWay stage pkg = + wayFor <$> askGhcProfiled stage <*> askDynGhcPrograms + where + wayFor prof dyn + | prof && dyn = profilingDynamic + | pkg == ghc && prof && notStage0 stage = profiling + | dyn && notStage0 stage = dynamic + | otherwise = vanilla - notStage0 (Stage0 {}) = False - notStage0 _ = True + notStage0 (Stage0 {}) = False + notStage0 _ = True -- | When cross compiling, enable for stage0 to get ghci -- support. But when not cross compiling, disable for ===================================== rts/IOManager.h ===================================== @@ -21,6 +21,15 @@ #include "sm/GC.h" // for evac_fn +#if defined(mingw32_HOST_OS) +/* Global var (only on Windows) that is exported (hence before BeginPrivate.h) + * to be shared with the I/O code in the base library to tell us which style + * of I/O manager we are using: one that uses the Windows native API HANDLEs, + * or one that uses Posix style fds. + */ +extern bool rts_IOManagerIsWin32Native; +#endif + #include "BeginPrivate.h" /* The ./configure gives us a set of CPP flags, one for each named I/O manager: @@ -160,14 +169,6 @@ typedef enum { /* Global var to tell us which I/O manager impl we are using */ extern IOManagerType iomgr_type; -#if defined(mingw32_HOST_OS) -/* Global var (only on Windows) that is exported to be shared with the I/O code - * in the base library to tell us which style of I/O manager we are using: one - * that uses the Windows native API HANDLEs, or one that uses Posix style fds. - */ -extern bool rts_IOManagerIsWin32Native; -#endif - /* The CapIOManager is the per-capability data structure belonging to the I/O * manager. It is defined in full in IOManagerInternals.h. The opaque forward ===================================== rts/Linker.c ===================================== @@ -478,16 +478,7 @@ initLinker_ (int retain_cafs) symhash = allocStrHashTable(); /* populate the symbol table with stuff from the RTS */ - IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n")); - for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) { - IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); - if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), - symhash, sym->lbl, sym->addr, - sym->strength, sym->type, 0, NULL)) { - barf("ghciInsertSymbolTable failed"); - } - } - IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n")); + initLinkerRtsSyms(symhash); /* Add extra symbols. rtsExtraSyms() is a weakly defined symbol in the rts, * that can be overrided by linking in an object with a corresponding ===================================== rts/RtsSymbols.c ===================================== @@ -9,6 +9,8 @@ #include "ghcplatform.h" #include "Rts.h" #include "RtsSymbols.h" +#include "LinkerInternals.h" +#include "PathUtils.h" #include "TopHandler.h" #include "HsFFI.h" @@ -51,6 +53,19 @@ extern char **environ; /* ----------------------------------------------------------------------------- * Symbols to be inserted into the RTS symbol table. + * + * Note [Naming Scheme for Symbol Macros] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * SymI_*: symbol is internal to the RTS. It resides in an object + * file/library that is statically. + * SymE_*: symbol is external to the RTS library. It might be linked + * dynamically. + * + * Sym*_HasProto : the symbol prototype is imported in an include file + * or defined explicitly + * Sym*_NeedsProto: the symbol is undefined and we add a dummy + * default proto extern void sym(void); */ #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \ @@ -162,7 +177,7 @@ extern char **environ; SymI_HasProto(stg_asyncWritezh) \ SymI_HasProto(stg_asyncDoProczh) \ SymI_HasProto(rts_InstallConsoleEvent) \ - SymI_HasProto(rts_IOManagerIsWin32Native) \ + SymI_HasDataProto(rts_IOManagerIsWin32Native) \ SymI_HasProto(rts_ConsoleHandlerDone) \ SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ @@ -912,7 +927,7 @@ extern char **environ; SymI_HasProto(freeExecPage) \ SymI_HasProto(getAllocations) \ SymI_HasProto(revertCAFs) \ - SymI_HasProto(RtsFlags) \ + SymI_HasDataProto(RtsFlags) \ SymI_NeedsDataProto(rts_breakpoint_io_action) \ SymI_NeedsDataProto(rts_stop_next_breakpoint) \ SymI_NeedsDataProto(rts_stop_on_exception) \ @@ -923,9 +938,9 @@ extern char **environ; SymI_NeedsProto(rts_enableStopAfterReturn) \ SymI_NeedsProto(rts_disableStopAfterReturn) \ SymI_HasProto(stopTimer) \ - SymI_HasProto(n_capabilities) \ - SymI_HasProto(max_n_capabilities) \ - SymI_HasProto(enabled_capabilities) \ + SymI_HasDataProto(n_capabilities) \ + SymI_HasDataProto(max_n_capabilities) \ + SymI_HasDataProto(enabled_capabilities) \ SymI_HasDataProto(stg_traceEventzh) \ SymI_HasDataProto(stg_traceMarkerzh) \ SymI_HasDataProto(stg_traceBinaryEventzh) \ @@ -1143,12 +1158,27 @@ extern char **environ; SymI_HasProto(hs_word2float64) -/* entirely bogus claims about types of these symbols */ -#define SymI_NeedsProto(vvv) extern void vvv(void); -#define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; -#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv); -#define SymE_NeedsDataProto(vvv) SymI_NeedsDataProto(vvv); -#define SymE_HasProto(vvv) SymI_HasProto(vvv); +/* Declare prototypes for the symbols that need it, so we can refer + * to them in the rtsSyms table below. + * + * In particular, for the external ones (SymE_*) we use the dllimport attribute + * to indicate that (on Windows) they come from external DLLs. This attribute + * is ignored on other platforms. + * + * The claims about the types of these symbols are entirely bogus. + */ +#if defined(mingw32_HOST_OS) && defined(DYNAMIC) +#define DLLIMPORT __attribute__((dllimport)) +#else +#define DLLIMPORT /**/ +#endif + +#define SymI_NeedsProto(vvv) extern void vvv(void); +#define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; +#define SymE_NeedsProto(vvv) extern DLLIMPORT void vvv(void); +#define SymE_NeedsDataProto(vvv) extern DLLIMPORT StgWord vvv[]; + +#define SymE_HasProto(vvv) /**/ #define SymI_HasProto(vvv) /**/ #define SymI_HasDataProto(vvv) /**/ #define SymI_HasProto_redirect(vvv,xxx,strength,ty) /**/ @@ -1177,6 +1207,8 @@ RTS_SYMBOLS_PRIM #undef SymE_NeedsProto #undef SymE_NeedsDataProto +/* See Note [Naming Scheme for Symbol Macros] */ + #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE }, #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ @@ -1197,7 +1229,16 @@ RTS_SYMBOLS_PRIM { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(xxx)), strength, ty }, -RtsSymbolVal rtsSyms[] = { + +/* Populate the symbol table with stuff from the RTS. */ +void initLinkerRtsSyms (StrHashTable *symhash) { + + /* The address of data symbols with the dllimport attribute are not + * compile-time constants and so cannot be used in constant initialisers. + * For this reason, rtsSyms is a local variable within this function + * rather than a global constant (as it was historically). + */ + const RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS RTS_RET_SYMBOLS RTS_POSIX_ONLY_SYMBOLS @@ -1212,7 +1253,19 @@ RtsSymbolVal rtsSyms[] = { RTS_SYMBOLS_PRIM SymI_HasDataProto(nonmoving_write_barrier_enabled) { 0, 0, STRENGTH_NORMAL, SYM_TYPE_CODE } /* sentinel */ -}; + }; + + IF_DEBUG(linker, debugBelch("populating linker symbol table with built-in RTS symbols\n")); + for (const RtsSymbolVal *sym = rtsSyms; sym->lbl != NULL; sym++) { + IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr)); + if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), + symhash, sym->lbl, sym->addr, + sym->strength, sym->type, 0, NULL)) { + barf("ghciInsertSymbolTable failed"); + } + } + IF_DEBUG(linker, debugBelch("done with built-in RTS symbols\n")); +} // Note [Extra RTS symbols] ===================================== rts/RtsSymbols.h ===================================== @@ -9,6 +9,7 @@ #pragma once #include "ghcautoconf.h" +#include "Hash.h" #if defined(LEADING_UNDERSCORE) #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s) @@ -46,7 +47,7 @@ typedef struct _RtsSymbolVal { SymType type; } RtsSymbolVal; -extern RtsSymbolVal rtsSyms[]; +void initLinkerRtsSyms (StrHashTable *symhash); extern RtsSymbolVal* __attribute__((weak)) rtsExtraSyms(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b5778cbdee0bba703072661297bb6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b5778cbdee0bba703072661297bb6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Widen the condition for taking the `sorted_deps` shortcut
by Wolfgang Jeltsch (＠jeltsch) 29 Apr '26

29 Apr '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC Commits: cd32e98b by Wolfgang Jeltsch at 2026-04-28T22:21:02+03:00 Widen the condition for taking the `sorted_deps` shortcut - - - - - 1 changed file: - compiler/GHC/Unit/Finder.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -252,10 +252,7 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit hpt_deps :: Set.Set UnitId hpt_deps = homeUnitDepends units - -- TODO: this predicate is wrong, we need something more focused - sorted_deps = if finder_lookupHomeInterfaces fopts - then Set.toList hpt_deps - else sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps + sorted_deps = sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps other_fopts = [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) @@ -263,6 +260,11 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit ] sortHomeUnitsByLikelihoodFor :: HomeModuleNameProvidersMap -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] +sortHomeUnitsByLikelihoodFor _ _ _ hpt_deps | Set.null hpt_deps = [] +{- + With the above shortcut, evaluation of the module graph will not be + triggered. +-} sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps = let cached_module_providers = lookupWithDefaultUniqMap home_module_name_providers_map Set.empty mod_name View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd32e98b21c955544e1e5a73b7fcecf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd32e98b21c955544e1e5a73b7fcecf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Replace a boolean `case` by an `if`
by Wolfgang Jeltsch (＠jeltsch) 29 Apr '26

29 Apr '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC Commits: 382247a8 by Wolfgang Jeltsch at 2026-04-28T21:57:16+03:00 Replace a boolean `case` by an `if` - - - - - 1 changed file: - compiler/GHC/Unit/Finder.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -253,9 +253,9 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit hpt_deps = homeUnitDepends units -- TODO: this predicate is wrong, we need something more focused - sorted_deps = case finder_lookupHomeInterfaces fopts of - True -> Set.toList hpt_deps - False -> sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps + sorted_deps = if finder_lookupHomeInterfaces fopts + then Set.toList hpt_deps + else sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps other_fopts = [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/382247a829cd8bb8608b1ad1f0a58e3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/382247a829cd8bb8608b1ad1f0a58e3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Turn cache of home module name providers into a unique-map
by Wolfgang Jeltsch (＠jeltsch) 29 Apr '26

29 Apr '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC Commits: 441d6c7d by Wolfgang Jeltsch at 2026-04-28T21:19:22+03:00 Turn cache of home module name providers into a unique-map - - - - - 2 changed files: - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Graph.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -46,8 +46,8 @@ import GHC.Unit.Types import GHC.Unit.Module import GHC.Unit.Module.Graph ( - CompleteUnits (cu_inventory, cu_providers), - mgCompleteUnits + HomeModuleNameProvidersMap, + mgHomeModuleNameProvidersMap ) import GHC.Unit.Home import GHC.Unit.Home.Graph (UnitEnvGraph) @@ -187,8 +187,8 @@ findImportedModule hsc_env mod pkg_qual = dflags = hsc_dflags hsc_env fopts = initFinderOpts dflags in do - let complete_home_units = mgCompleteUnits (hsc_mod_graph hsc_env) - findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) complete_home_units mb_home_unit mod pkg_qual + let home_module_name_providers_map = mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env) + findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod pkg_qual findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do @@ -201,12 +201,12 @@ findImportedModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnv - -> CompleteUnits + -> HomeModuleNameProvidersMap -> Maybe HomeUnit -> ModuleName -> PkgQual -> IO FindResult -findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb_pkg = +findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit mod_name mb_pkg = case mb_pkg of NoPkgQual -> unqual_import ThisPkg uid | (homeUnitId <$> mb_home_unit) == Just uid -> home_import @@ -228,7 +228,7 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb -- If the module is reexported, then look for it as if it was from the perspective -- of that package which reexports it. | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name = - findImportedModuleNoHsc fc opts ue complete_home_units (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual + findImportedModuleNoHsc fc opts ue home_module_name_providers_map (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual | elementOfUniqSet mod_name (finder_hiddenModules opts) = return (mkHomeHidden uid) | otherwise = @@ -255,17 +255,17 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb -- TODO: this predicate is wrong, we need something more focused sorted_deps = case finder_lookupHomeInterfaces fopts of True -> Set.toList hpt_deps - False -> sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps + False -> sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps other_fopts = [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) | uid <- sorted_deps ] -sortHomeUnitsByLikelihoodFor :: CompleteUnits -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] -sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps = +sortHomeUnitsByLikelihoodFor :: HomeModuleNameProvidersMap -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] +sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps = let - cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) + cached_module_providers = lookupWithDefaultUniqMap home_module_name_providers_map Set.empty mod_name cached_providing_deps = Set.intersection cached_module_providers hpt_deps other_cached_providing_deps = Set.toList $ ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -67,8 +67,8 @@ module GHC.Unit.Module.Graph , mgLookupModule , mgLookupModuleName , mgHasHoles - , CompleteUnits (CompleteUnits, cu_inventory, cu_providers) - , mgCompleteUnits + , HomeModuleNameProvidersMap + , mgHomeModuleNameProvidersMap , showModMsg -- ** Reachability queries @@ -163,6 +163,7 @@ import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import GHC.Types.Unique.DSet +import GHC.Types.Unique.Map (UniqMap, emptyUniqMap, listToUniqMap_C) import GHC.Unit.Module import GHC.Unit.Module.ModNodeKey import GHC.Unit.Module.Stage @@ -205,34 +206,24 @@ data ModuleGraph = ModuleGraph -- Cached computation, whether any of the ModuleGraphNode are isHoleModule, -- This is only used for a hack in GHC.Iface.Load to do with backpack, please -- remove this at the earliest opportunity. - , mg_complete_units :: !CompleteUnits - -- ^ For each module name, which home unit UnitIds define it together with the set of units for which the listing is complete. + , mg_home_module_name_providers_map :: !HomeModuleNameProvidersMap + -- ^ For each module name, which home units provide it. } -data CompleteUnits = CompleteUnits - { - cu_inventory :: !(Set UnitId), - cu_providers :: !(Map ModuleName (Set UnitId)) - } +type HomeModuleNameProvidersMap = UniqMap ModuleName (Set UnitId) -mkCompleteUnits :: [ModuleGraphNode] -> CompleteUnits -mkCompleteUnits nodes = CompleteUnits inventory providers where +mkHomeModuleNameProvidersMap :: [ModuleGraphNode] -> HomeModuleNameProvidersMap +mkHomeModuleNameProvidersMap nodes + = listToUniqMap_C Set.union $ + [ + (moduleName, Set.singleton unitID) | + ModuleNode _ moduleNodeInfo <- nodes, + let moduleName = moduleNodeInfoModuleName moduleNodeInfo, + let unitID = moduleNodeInfoUnitId moduleNodeInfo + ] - providers :: Map ModuleName (Set UnitId) - providers - = Map.fromListWith Set.union $ - [ - (moduleName, Set.singleton unitID) | - ModuleNode _ moduleNodeInfo <- nodes, - let moduleName = moduleNodeInfoModuleName moduleNodeInfo, - let unitID = moduleNodeInfoUnitId moduleNodeInfo - ] - - inventory :: Set UnitId - inventory = Set.unions (Map.elems providers) - -mgCompleteUnits :: ModuleGraph -> CompleteUnits -mgCompleteUnits = mg_complete_units +mgHomeModuleNameProvidersMap :: ModuleGraph -> HomeModuleNameProvidersMap +mgHomeModuleNameProvidersMap = mg_home_module_name_providers_map -- | Why do we ever need to construct empty graphs? Is it because of one shot mode? emptyMG :: ModuleGraph @@ -240,7 +231,7 @@ emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) False - (CompleteUnits Set.empty Map.empty) + emptyUniqMap -- | Construct a module graph. This function should be the only entry point for -- building a 'ModuleGraph', since it is supposed to be built once and never modified. @@ -516,7 +507,7 @@ isEmptyMG = null . mg_mss mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG f mg@ModuleGraph{..} = mg { mg_mss = new_mss - , mg_complete_units = mkCompleteUnits new_mss + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } where new_mss = @@ -1089,7 +1080,7 @@ extendMG ModuleGraph{..} node = , mg_loop_graph = mkTransLoopDeps new_mss , mg_zero_graph = mkTransZeroDeps new_mss , mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node) - , mg_complete_units = mkCompleteUnits new_mss + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } where new_mss = node : mg_mss View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/441d6c7dbf32101cd8e0bff72c99b7b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/441d6c7dbf32101cd8e0bff72c99b7b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/epa-parens] 10 commits: Ensure TcM plugins are only initialised once
by Vladislav Zavialov (＠int-index) 29 Apr '26

29 Apr '26

Vladislav Zavialov pushed to branch wip/int-index/epa-parens at Glasgow Haskell Compiler / GHC Commits: 1350271b by sheaf at 2026-04-27T09:32:53-04:00 Ensure TcM plugins are only initialised once This commit ensures we keep TcM plugins (typechecker plugins, defaulting plugins and hole fit plugins) running all the way through desugaring, instead of stopping them at the end of typechecking. To do this, the "stop" actions of TcPlugin and DefaultingPlugin are split into two: one for the "post-typecheck" action, and one for the final shutdown action (after desugaring). This allows the plugins to be invoked by the pattern match checker (during desugaring) without having to be repeatedly re-initialised and stopped, fixing #26839. In the process, this commit modifies 'initTc' and 'initTcInteractive', adding an extra argument that describes whether to start/stop the 'TcM' plugins. See Note [Stop TcM plugins after desugaring] for an overview. - - - - - 42549222 by sheaf at 2026-04-27T09:33:50-04:00 Hadrian: add --keep-response-files This commit adds a Hadrian flag that allows response files to be retained. This is useful for debugging a failing Hadrian command line. - - - - - 40564e8d by sheaf at 2026-04-27T09:34:46-04:00 hadrian/build-cabal.bat: fix build on Windows Commit 8cb99552f6 introduced a warning for a missing package index. However, the logic was faulty on Windows: the piping was broken, and "remote-repo-cache:" was being interpreted as a (malformed) drive letter, leading to the error: The filename, directory name, or volume label syntax is incorrect. This commit fixes that by using a temporary file instead of piping. - - - - - 14bc71e4 by Sven Tennie at 2026-04-28T13:22:47-04:00 ghc: Distinguish between having an interpreter and having an internal one Actually, these are related but different things: - ghc can run an interpreter (either internal or external) - ghc is compiled with an internal interpreter Splitting the logic solves compiler warnings and expresses the intent better. - - - - - df691563 by Vladislav Zavialov at 2026-04-28T13:23:29-04:00 Refactor HsWildCardTy to use HoleKind (#27111) The payload of this patch is that the extension fields of HsWildCardTy and HsHole now match: type instance XWildCardTy Ghc{Ps,Rn} = HoleKind type instance XHole Ghc{Ps,Rn} = HoleKind This is progress towards unification of HsExpr and HsType. Test case: T25121_status In addition to that, exact-printing of infix holes is fixed. Test case: PprInfixHole - - - - - f3485446 by fendor at 2026-04-28T13:24:12-04:00 Expose startupHpc as an rts symbol - - - - - 28f07d70 by fendor at 2026-04-28T13:24:12-04:00 Make HPC work with bytecode interpreter Add support to generate .tix files from bytecode objects and the bytecode interpreter. Conceptually, we insert HPC ticks into the bytecode similar to how we insert breakpoints. HPC and breakpoints do not share the same tick array but we use a separate tick-array for hpc/breakpoint ticks during bytecode generation. We teach the bytecode interpreter to handle hpc ticks. The implementation is quite trivial, simply increment the counter in the global hpc_ticks array for the respective module. This hpc_ticks array is generated as part of the `CStub`, so we can rely on it existing. A tricky bit is "registering" a bytecode object for HPC instrumentation. In the compiled case, this is achieved via CStub and initializer/finalizers `.init` sections which are called when the executable is run. After the initializers have been invoked, which is before `hs_init_ghc`, we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered" for hpc instrumentation via `hs_hpc_module`. Since bytecode objects are loaded after starting up GHCi, this workflow doesn't work for supporting `hpc` and the `hpc` run-time is never started, even if a module is added for instrumentation. We fix this issue by employing the same technique as is for `SptEntry`s: * We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo` which contains enough information to call `hs_hpc_module`, allowing us to register the module for `hpc` instrumentation`. * After registering the module, we unconditionally call `startupHpc`, to make sure the .tix file is written. Calling `startupHpc` multiple times is safe. Calling `hs_hpc_module` multiple times for the same module is also safe. If we didn't register the hpc module in this way, evaluating a bytecode object instrumented with `-fhpc` without registering it in the `hpc` run-time will simply not generate any `.tix` files for this bytecode object. However, this shouldn't happen if everything is set up correctly. Closes #27036 - - - - - 950879f0 by Vladislav Zavialov at 2026-04-28T13:24:55-04:00 Move NamespaceSpecifier from x-fields into the AST proper (#26678) This refactoring moves NamespaceSpecifier out of extension fields and into the AST proper, as it is part of the user-written source, and is not pass-specific. Summary of changes: * Move NamespaceSpecifier from GHC/Hs/Basic.hs to Language/Haskell/Syntax/ImpExp.hs and parameterise it by the compiler pass, creating the necessary extension points * Move NamespaceSpecifier out of XFixitySig into FixitySig * Move NamespaceSpecifier out of XIEThingAll (IEThingAllExt) into IEThingAll * Move NamespaceSpecifier out of XIEWholeNamespace (IEWholeNamespaceExt) into IEWholeNamespace This is a pure refactoring with no change in behaviour. - - - - - 9797052b by Simon Peyton Jones at 2026-04-28T13:25:37-04:00 Fix assertion check in checkResultTy As #27210 shows, the assertion was a little bit too eager. I refactored a bit by moving some code from GHC.Tc.Gen.App to GHC.Tc.Utils.Unify; see the new function tcSubTypeApp, which replaces tcSubTypeDS - - - - - 51da0465 by Vladislav Zavialov at 2026-04-28T21:14:10+03:00 EPA: Use AnnParen for tuples and sums Summary of changes * Do not use AnnParen in XListTy, replace it with EpToken "[" and "]" * Specialise AnnParen to tuple/sums by dropping the AnnParensSquare and keeping only AnnParens and AnnParensHash * Use AnnParen in XExplicitTuple * Use AnnParen in XExplicitTupleTy * Use AnnParen in XTuplePat * Use AnnParen in XExplicitSum (via AnnExplicitSum) * Use AnnParen in XSumPat (via EpAnnSumPat) This is a refactoring with no user-facing changes. - - - - - 179 changed files: - + changelog.d/T19174.md - + changelog.d/bytecode-interpreter-hpc-support - + changelog.d/ghc-api-epa-parens - + changelog.d/ghc-api-holes-ast-27111 - + changelog.d/ghc-api-namespace-specifier-26678 - + changelog.d/hadrian-response-files.md - + changelog.d/tcplugin_init.md - + changelog.d/tcplugins-pmc.md - + changelog.d/typecheckModule-API.md - + changelog.d/withTcPlugins.md - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Binary.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/HpcInfo.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - docs/users_guide/extending_ghc.rst - ghc/GHC/Driver/Session/Mode.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/build-cabal.bat - hadrian/src/Builder.hs - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Packages.hs - + libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Disassembler.c - rts/Hpc.c - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/rts/Bytecodes.h - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/ghc-api/T26910.hs - testsuite/tests/ghc-api/T6145.hs - testsuite/tests/ghci/should_run/tc-plugin-ghci/TcPluginGHCi.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/hpc/Makefile - testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout - + testsuite/tests/hpc/T17073b.stdout - testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout - + testsuite/tests/hpc/T20568b.stdout - testsuite/tests/hpc/all.T - testsuite/tests/hpc/fork/Makefile - testsuite/tests/hpc/function/Makefile - testsuite/tests/hpc/function/test.T - + testsuite/tests/hpc/function/tough1.stderr - + testsuite/tests/hpc/function/tough1.stdout - testsuite/tests/hpc/function2/test.T - + testsuite/tests/hpc/function2/tough3.script - + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs - testsuite/tests/hpc/ghc_ghci/Makefile - + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci01.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci02.stdout - testsuite/tests/hpc/ghc_ghci/test.T - testsuite/tests/hpc/simple/Makefile - + testsuite/tests/hpc/simple/hpc002.hs - + testsuite/tests/hpc/simple/hpc002.stdout - + testsuite/tests/hpc/simple/hpc003.hs - + testsuite/tests/hpc/simple/hpc003.script - + testsuite/tests/hpc/simple/hpc003.stdout - testsuite/tests/hpc/simple/test.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/plugins/defaulting-plugin/DefaultInterference.hs - testsuite/tests/plugins/defaulting-plugin/DefaultInvalid.hs - testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs - testsuite/tests/plugins/defaulting-plugin/DefaultMultiParam.hs - testsuite/tests/plugins/echo-plugin/Echo.hs - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprInfixHole.hs - testsuite/tests/printer/all.T - testsuite/tests/quasiquotation/T7918.hs - testsuite/tests/tcplugins/Common.hs - testsuite/tests/tcplugins/RewritePerfPlugin.hs - testsuite/tests/tcplugins/T11462_Plugin.hs - testsuite/tests/tcplugins/T11525_Plugin.hs - testsuite/tests/tcplugins/T26395_Plugin.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.script - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.stderr - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.stdout - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.hs-boot - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.stderr - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode_aux.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Warn.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Warn.stderr - testsuite/tests/tcplugins/all.T - + testsuite/tests/tcplugins/tc-plugin-initstop/Makefile - + testsuite/tests/tcplugins/tc-plugin-initstop/Setup.hs - + testsuite/tests/tcplugins/tc-plugin-initstop/TcPlugin_InitStop_Plugin.hs - + testsuite/tests/tcplugins/tc-plugin-initstop/tc-plugin-initstop.cabal - + testsuite/tests/typecheck/should_fail/T27210.hs - + testsuite/tests/typecheck/should_fail/T27210.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a7f1cf06a48b617912289b47c28b5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a7f1cf06a48b617912289b47c28b5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: ghc: Distinguish between having an interpreter and having an internal one
by Marge Bot (＠marge-bot) 29 Apr '26

29 Apr '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 14bc71e4 by Sven Tennie at 2026-04-28T13:22:47-04:00 ghc: Distinguish between having an interpreter and having an internal one Actually, these are related but different things: - ghc can run an interpreter (either internal or external) - ghc is compiled with an internal interpreter Splitting the logic solves compiler warnings and expresses the intent better. - - - - - df691563 by Vladislav Zavialov at 2026-04-28T13:23:29-04:00 Refactor HsWildCardTy to use HoleKind (#27111) The payload of this patch is that the extension fields of HsWildCardTy and HsHole now match: type instance XWildCardTy Ghc{Ps,Rn} = HoleKind type instance XHole Ghc{Ps,Rn} = HoleKind This is progress towards unification of HsExpr and HsType. Test case: T25121_status In addition to that, exact-printing of infix holes is fixed. Test case: PprInfixHole - - - - - f3485446 by fendor at 2026-04-28T13:24:12-04:00 Expose startupHpc as an rts symbol - - - - - 28f07d70 by fendor at 2026-04-28T13:24:12-04:00 Make HPC work with bytecode interpreter Add support to generate .tix files from bytecode objects and the bytecode interpreter. Conceptually, we insert HPC ticks into the bytecode similar to how we insert breakpoints. HPC and breakpoints do not share the same tick array but we use a separate tick-array for hpc/breakpoint ticks during bytecode generation. We teach the bytecode interpreter to handle hpc ticks. The implementation is quite trivial, simply increment the counter in the global hpc_ticks array for the respective module. This hpc_ticks array is generated as part of the `CStub`, so we can rely on it existing. A tricky bit is "registering" a bytecode object for HPC instrumentation. In the compiled case, this is achieved via CStub and initializer/finalizers `.init` sections which are called when the executable is run. After the initializers have been invoked, which is before `hs_init_ghc`, we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered" for hpc instrumentation via `hs_hpc_module`. Since bytecode objects are loaded after starting up GHCi, this workflow doesn't work for supporting `hpc` and the `hpc` run-time is never started, even if a module is added for instrumentation. We fix this issue by employing the same technique as is for `SptEntry`s: * We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo` which contains enough information to call `hs_hpc_module`, allowing us to register the module for `hpc` instrumentation`. * After registering the module, we unconditionally call `startupHpc`, to make sure the .tix file is written. Calling `startupHpc` multiple times is safe. Calling `hs_hpc_module` multiple times for the same module is also safe. If we didn't register the hpc module in this way, evaluating a bytecode object instrumented with `-fhpc` without registering it in the `hpc` run-time will simply not generate any `.tix` files for this bytecode object. However, this shouldn't happen if everything is set up correctly. Closes #27036 - - - - - 950879f0 by Vladislav Zavialov at 2026-04-28T13:24:55-04:00 Move NamespaceSpecifier from x-fields into the AST proper (#26678) This refactoring moves NamespaceSpecifier out of extension fields and into the AST proper, as it is part of the user-written source, and is not pass-specific. Summary of changes: * Move NamespaceSpecifier from GHC/Hs/Basic.hs to Language/Haskell/Syntax/ImpExp.hs and parameterise it by the compiler pass, creating the necessary extension points * Move NamespaceSpecifier out of XFixitySig into FixitySig * Move NamespaceSpecifier out of XIEThingAll (IEThingAllExt) into IEThingAll * Move NamespaceSpecifier out of XIEWholeNamespace (IEWholeNamespaceExt) into IEWholeNamespace This is a pure refactoring with no change in behaviour. - - - - - 9797052b by Simon Peyton Jones at 2026-04-28T13:25:37-04:00 Fix assertion check in checkResultTy As #27210 shows, the assertion was a little bit too eager. I refactored a bit by moving some code from GHC.Tc.Gen.App to GHC.Tc.Utils.Unify; see the new function tcSubTypeApp, which replaces tcSubTypeDS - - - - - 9f3ac00c by David Eichmann at 2026-04-28T13:57:13-04:00 Hadrian: withResponseFile outputs response file when verbodity is Verbose At the Verbose verbosity, shake will display full commandlines. With the use of response files, the full command is hidden. That makes it hard to run the command manually. This commit outputs the contents of the response file so that that full command can be recreated and also hints at the use of the --keep-response-files hadrian flag. - - - - - 6c01446b by Duncan Coutts at 2026-04-28T13:57:14-04:00 Use response files for hadrian linking with ghc (support long command lines) In future support for windows dynamic linking, we expect long command lines for linking dll files with ghc. Experiments with dynamic linking the ghc-internal library yielded a link command well over 32kb. We did not encounter this before for static libs, since we already use ar's @file feature (if available, which it is for the llvm toolchain). Co-authored-by: David Eichmann <davide(a)well-typed.com> - - - - - 2952c860 by Cheng Shao at 2026-04-28T13:57:15-04:00 compiler: avoid unique OccNames for internal Names in bytecode objects This patch improves bytecode object serialization logic by avoiding the construction of unique `OccName`s when serializing/deserializing internal `Name`s. Closes #27213. ------------------------- Metric Decrease: LinkableUsage01 ------------------------- - - - - - 112 changed files: - + changelog.d/T19174.md - + changelog.d/bytecode-interpreter-hpc-support - + changelog.d/ghc-api-holes-ast-27111 - + changelog.d/ghc-api-namespace-specifier-26678 - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Binary.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/HpcInfo.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - ghc/GHC/Driver/Session/Mode.hs - ghc/GHCi/UI.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - + libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Disassembler.c - rts/Hpc.c - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/rts/Bytecodes.h - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/hpc/Makefile - testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout - + testsuite/tests/hpc/T17073b.stdout - testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout - + testsuite/tests/hpc/T20568b.stdout - testsuite/tests/hpc/all.T - testsuite/tests/hpc/fork/Makefile - testsuite/tests/hpc/function/Makefile - testsuite/tests/hpc/function/test.T - + testsuite/tests/hpc/function/tough1.stderr - + testsuite/tests/hpc/function/tough1.stdout - testsuite/tests/hpc/function2/test.T - + testsuite/tests/hpc/function2/tough3.script - + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs - testsuite/tests/hpc/ghc_ghci/Makefile - + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci01.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci02.stdout - testsuite/tests/hpc/ghc_ghci/test.T - testsuite/tests/hpc/simple/Makefile - + testsuite/tests/hpc/simple/hpc002.hs - + testsuite/tests/hpc/simple/hpc002.stdout - + testsuite/tests/hpc/simple/hpc003.hs - + testsuite/tests/hpc/simple/hpc003.script - + testsuite/tests/hpc/simple/hpc003.stdout - testsuite/tests/hpc/simple/test.T - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprInfixHole.hs - testsuite/tests/printer/all.T - + testsuite/tests/typecheck/should_fail/T27210.hs - + testsuite/tests/typecheck/should_fail/T27210.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f88ba364af31618f7a8f9ed0b23d3f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f88ba364af31618f7a8f9ed0b23d3f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix assertion check in checkResultTy
by Marge Bot (＠marge-bot) 29 Apr '26

29 Apr '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9797052b by Simon Peyton Jones at 2026-04-28T13:25:37-04:00 Fix assertion check in checkResultTy As #27210 shows, the assertion was a little bit too eager. I refactored a bit by moving some code from GHC.Tc.Gen.App to GHC.Tc.Utils.Unify; see the new function tcSubTypeApp, which replaces tcSubTypeDS - - - - - 6 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Unify.hs - + testsuite/tests/typecheck/should_fail/T27210.hs - + testsuite/tests/typecheck/should_fail/T27210.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -458,45 +458,9 @@ checkResultTy :: HsExpr GhcRn -- expose foralls, but maybe not /deeply/ instantiated -> ExpRhoType -- Expected type; this is deeply skolemised -> TcM HsWrapper -checkResultTy rn_expr (tc_fun,_) _ app_res_rho (Infer inf_res) - = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun - -- Why the "DataConHead" bit? See (IIR5) in - -- Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify. - ; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res } - -checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty) --- Unify with expected type from the context --- See Note [Unify with expected type before typechecking arguments] --- --- Match up app_res_rho: the result type of rn_expr --- with res_ty: the expected result type +checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho res_ty = perhaps_add_res_ty_ctxt $ - do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun - ; traceTc "checkResultTy {" $ - vcat [ text "tc_fun:" <+> ppr tc_fun - , text "app_res_rho:" <+> ppr app_res_rho - , text "res_ty:" <+> ppr res_ty - , text "ds_flag:" <+> ppr ds_flag ] - ; case ds_flag of - Shallow -> -- No deep subsumption - -- app_res_rho and res_ty are both rho-types, - -- so with simple subsumption we can just unify them - -- No need to zonk; the unifier does that - do { co <- unifyExprType rn_expr app_res_rho res_ty - ; traceTc "checkResultTy 1 }" (ppr co) - ; return (mkWpCastN co) } - - Deep ds_reason -> -- Deep subsumption - -- Even though both app_res_rho and res_ty are rho-types, - -- they may have nested polymorphism, so if deep subsumption - -- is on we must call tcSubType. - do { wrap <- tcSubTypeDS tc_fun ds_reason rn_expr app_res_rho res_ty - ; traceTc "checkResultTy 2 }" $ - vcat [ text "app_res_rho:" <+> ppr app_res_rho - , text "res_ty:" <+> ppr res_ty - , text "wrap:" <+> ppr wrap - ] - ; return wrap } } + tcSubTypeApp rn_expr tc_fun app_res_rho res_ty where -- perhaps_add_res_ty_ctxt: Inside an expansion, the addFunResCtxt stuff is -- more confusing than helpful because the function at the head isn't in @@ -506,7 +470,7 @@ checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty) | isGeneratedSrcSpan fun_loc = thing_inside | otherwise - = addFunResCtxt tc_fun inst_args app_res_rho (mkCheckExpType res_ty) $ + = addFunResCtxt tc_fun inst_args app_res_rho res_ty $ thing_inside ---------------- ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -791,10 +791,9 @@ nonBidirectionalErr = TcRnPatSynNotBidirectional {- Note [Typechecking data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As per Note [Polymorphisation of linear fields] in -GHC.Core.Multiplicity, when we use a data constructor as a term, we want to -consider its field to have polymorphic multiplicities. That is, -Note [Data constructors are linear by default] says: +As per Note [Polymorphisation of linear fields] in GHC.Core.Multiplicity, when +we use a data constructor as a term, we want to consider its field to have +polymorphic multiplicities. Note [Data constructors are linear by default] says: Just :: a. a %1 -> Maybe a ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -11,7 +11,7 @@ module GHC.Tc.Utils.Unify ( -- Full-blown subsumption tcWrapResult, tcWrapResultO, tcWrapResultMono, - tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS, tcSubTypeHoleFit, + tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeApp, tcSubTypeHoleFit, addSubTypeCtxt, tcSubTypeAmbiguity, tcSubMult, checkConstraints, checkTvConstraints, @@ -1488,24 +1488,62 @@ tcSubTypePat _ _ (Infer inf_res) ty_expected --------------- --- | A subtype check that performs deep subsumption. --- See also 'tcSubTypeMono', for when no instantiation is required. -tcSubTypeDS :: HsExpr GhcTc -- ^ App head (for error messages only) - -> DeepSubsumptionDepth - -> HsExpr GhcRn - -> TcRhoType -- ^ Actual type; a rho-type, not a sigma-type - -> TcRhoType -- ^ Expected type - -- DeepSubsumption <=> when checking, this type - -- is deeply skolemised - -> TcM HsWrapper --- Only one call site, in GHC.Tc.Gen.App.checkResultTy -tcSubTypeDS tc_fun ds_depth rn_expr act_rho exp_rho - = do { wrap <- tc_sub_type_deep (Just tc_fun, Top) ds_depth - (unifyExprType rn_expr) - (exprCtOrigin rn_expr) - GenSigCtxt act_rho exp_rho +-- | Connect up the inferred type of an application with the expected type. +-- This is usually just a unification, but with deep subsumption there is more to do. +tcSubTypeApp :: HsExpr GhcRn + -> HsExpr GhcTc -- Head + -> TcRhoType -- Inferred type of the application; zonked to + -- expose foralls, but maybe not /deeply/ instantiated + -> ExpRhoType -- Expected type; this is deeply skolemised + -> TcM HsWrapper +tcSubTypeApp rn_expr tc_fun app_res_rho (Infer inf_res) + = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun + -- Why the "DataConHead" bit? See (IIR5) in + -- Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify. + ; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res } + +tcSubTypeApp rn_expr tc_fun app_res_rho (Check exp_rho) + = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun + ; traceTc "tcSubTypeApp {" $ + vcat [ text "tc_fun:" <+> ppr tc_fun + , text "app_res_rho:" <+> ppr app_res_rho + , text "exp_rho:" <+> ppr exp_rho + , text "ds_flag:" <+> ppr ds_flag ] + ; wrap <- case ds_flag of + Shallow -- No deep subsumption + -- app_res_rho and res_ty are both rho-types, + -- so with simple subsumption we can just unify them + -- No need to zonk; the unifier does that + -> do { co <- unifyExprType rn_expr app_res_rho exp_rho + ; return (mkWpCastN co) } + + Deep ds_depth -- Deep subsumption is ON + -- Even though both app_res_rho and res_ty are rho-types, + -- they may have nested polymorphism, so if deep subsumption + -- is on we must call tcSubType. + -> tc_sub_type_deep (Just tc_fun, Top) ds_depth + (unifyExprType rn_expr) + (exprCtOrigin rn_expr) + GenSigCtxt app_res_rho exp_rho + + ; traceTc "tcSubTypeApp }" $ + vcat [ text "tc_fun:" <+> ppr tc_fun + , text "wrap:" <+> ppr wrap ] + ; return (mkWpSubType wrap) } +-- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption +-- in order to implement the plan of Note [Typechecking data constructors]. +getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag +getDeepSubsumptionFlag_DataConHead app_head + = do { user_ds <- xoptM LangExt.DeepSubsumption + ; return $ if | user_ds + -> Deep DeepSub + | XExpr (ConLikeTc (RealDataCon {})) <- app_head + -> Deep TopSub + | otherwise + -> Shallow } + --------------- -- | Checks that the 'actual' type is more polymorphic than the 'expected' type. @@ -2104,18 +2142,6 @@ getDeepSubsumptionFlag = else return Shallow } --- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption --- in order to implement the plan of Note [Typechecking data constructors]. -getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag -getDeepSubsumptionFlag_DataConHead app_head - = do { user_ds <- xoptM LangExt.DeepSubsumption - ; return $ if | user_ds - -> Deep DeepSub - | XExpr (ConLikeTc (RealDataCon {})) <- app_head - -> Deep TopSub - | otherwise - -> Shallow } - -- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption. -- @@ -2132,11 +2158,7 @@ tc_sub_type_deep :: HasDebugCallStack -> TcRhoType -- ^ Expected; deeply skolemised -> TcM HsWrapper tc_sub_type_deep fun_pos@(tc_fun, pos) ds_depth unify inst_orig ctxt ty_actual ty_expected - = assertPpr (isDeeplySkolemised ty_expected) - (vcat [ text "tc_sub_type_deep: expected type is not a deep rho type" - , text "ty_expected:" <+> ppr ty_expected - , text "ty_actual:" <+> ppr ty_actual - ]) $ + = assert_precondition $ do { traceTc "tc_sub_type_deep" $ vcat [ text "ty_actual =" <+> ppr ty_actual , text "ty_expected =" <+> ppr ty_expected ] @@ -2250,6 +2272,27 @@ tc_sub_type_deep fun_pos@(tc_fun, pos) ds_depth unify inst_orig ctxt ty_actual t where given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) + -- Assertion check. + -- If DeepSubsumption is on (ds_depth = Deep DeepSub) then `exp_rho` + -- should already be deeply skolemised; the assertion checks this + -- But if DeepSubsumption is NOT on, but there is a data constructor at the + -- head, we must still call `tc_sub_type_deep` (for the multiplicity arrows) + -- Hence ds_flag = Deep TopSub, but `exp_rho` will only be /top-level/ skolemised + -- So we can only check for top-level skolemisation (`isRhoTy`) + -- Example of the latter (see #27210), with -XNoDeepSubsumption + -- foo :: forall a. a -> forall b. b -> (a,b) + -- foo = (,) + -- We will only shallowly-skolemise the expected type + assert_precondition = assertPpr ty_expected_is_ok $ + vcat [ text "tc_sub_type_deep: expected type is not a deep rho type" + , text "ty_expected:" <+> ppr ty_expected + , text "ty_actual:" <+> ppr ty_actual ] + ty_expected_is_ok + = case ds_depth of + TopSub -> True + DeepSub -> isDeeplySkolemised ty_expected + + -- | Whether to do deep subsumption when recurring inside arguments. recurInArgumentDSFlag :: DeepSubsumptionDepth -> DeepSubsumptionFlag recurInArgumentDSFlag = \case @@ -5145,5 +5188,3 @@ lookupCycleBreakerVar cbv (IS { inert_cycle_breakers = cbvs_stack }) = tyfam_app | otherwise = pprPanic "lookupCycleBreakerVar found an unbound cycle breaker" (ppr cbv $$ ppr cbvs_stack) - --------------------------------------------------------------------------------- ===================================== testsuite/tests/typecheck/should_fail/T27210.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE RankNTypes, ExistentialQuantification #-} + +-- NB: No deep subsumption + +module T27210 where + +data Parser a + = forall x. BindP (Parser x) (x -> Parser a) + +oneM :: Parser a -> ( forall x. (a -> Parser x) -> Parser x ) +oneM = BindP ===================================== testsuite/tests/typecheck/should_fail/T27210.stderr ===================================== @@ -0,0 +1,9 @@ +T27210.hs:11:8: error: [GHC-83865] + • Couldn't match expected type: forall x. + (a -> Parser x) -> Parser x + with actual type: (a -> Parser a0) -> Parser a0 + • In the expression: BindP + In an equation for ‘oneM’: oneM = BindP + • Relevant bindings include + oneM :: Parser a -> forall x. (a -> Parser x) -> Parser x + (bound at T27210.hs:11:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -758,3 +758,4 @@ test('T23162d', normal, compile, ['']) test('T26823', normal, compile_fail, ['']) test('T26861', normal, compile_fail, ['']) test('T26862', normal, compile_fail, ['']) +test('T27210', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9797052b974b3356c34b457558ffda3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9797052b974b3356c34b457558ffda3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Move NamespaceSpecifier from x-fields into the AST proper (#26678)
by Marge Bot (＠marge-bot) 29 Apr '26

29 Apr '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 950879f0 by Vladislav Zavialov at 2026-04-28T13:24:55-04:00 Move NamespaceSpecifier from x-fields into the AST proper (#26678) This refactoring moves NamespaceSpecifier out of extension fields and into the AST proper, as it is part of the user-written source, and is not pass-specific. Summary of changes: * Move NamespaceSpecifier from GHC/Hs/Basic.hs to Language/Haskell/Syntax/ImpExp.hs and parameterise it by the compiler pass, creating the necessary extension points * Move NamespaceSpecifier out of XFixitySig into FixitySig * Move NamespaceSpecifier out of XIEThingAll (IEThingAllExt) into IEThingAll * Move NamespaceSpecifier out of XIEWholeNamespace (IEWholeNamespaceExt) into IEWholeNamespace This is a pure refactoring with no change in behaviour. - - - - - 31 changed files: - + changelog.d/ghc-api-namespace-specifier-26678 - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/T20846.stderr - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/950879f0c65fd2cf9c72096aced32dc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/950879f0c65fd2cf9c72096aced32dc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Expose startupHpc as an rts symbol
by Marge Bot (＠marge-bot) 29 Apr '26

29 Apr '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f3485446 by fendor at 2026-04-28T13:24:12-04:00 Expose startupHpc as an rts symbol - - - - - 28f07d70 by fendor at 2026-04-28T13:24:12-04:00 Make HPC work with bytecode interpreter Add support to generate .tix files from bytecode objects and the bytecode interpreter. Conceptually, we insert HPC ticks into the bytecode similar to how we insert breakpoints. HPC and breakpoints do not share the same tick array but we use a separate tick-array for hpc/breakpoint ticks during bytecode generation. We teach the bytecode interpreter to handle hpc ticks. The implementation is quite trivial, simply increment the counter in the global hpc_ticks array for the respective module. This hpc_ticks array is generated as part of the `CStub`, so we can rely on it existing. A tricky bit is "registering" a bytecode object for HPC instrumentation. In the compiled case, this is achieved via CStub and initializer/finalizers `.init` sections which are called when the executable is run. After the initializers have been invoked, which is before `hs_init_ghc`, we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered" for hpc instrumentation via `hs_hpc_module`. Since bytecode objects are loaded after starting up GHCi, this workflow doesn't work for supporting `hpc` and the `hpc` run-time is never started, even if a module is added for instrumentation. We fix this issue by employing the same technique as is for `SptEntry`s: * We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo` which contains enough information to call `hs_hpc_module`, allowing us to register the module for `hpc` instrumentation`. * After registering the module, we unconditionally call `startupHpc`, to make sure the .tix file is written. Calling `startupHpc` multiple times is safe. Calling `hs_hpc_module` multiple times for the same module is also safe. If we didn't register the hpc module in this way, evaluating a bytecode object instrumented with `-fhpc` without registering it in the `hpc` run-time will simply not generate any `.tix` files for this bytecode object. However, this shouldn't happen if everything is set up correctly. Closes #27036 - - - - - 53 changed files: - + changelog.d/bytecode-interpreter-hpc-support - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Binary.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/HpcInfo.hs - compiler/GHC/Unit/Module/ModGuts.hs - + libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Disassembler.c - rts/Hpc.c - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/rts/Bytecodes.h - testsuite/tests/hpc/Makefile - testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout - + testsuite/tests/hpc/T17073b.stdout - testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout - + testsuite/tests/hpc/T20568b.stdout - testsuite/tests/hpc/all.T - testsuite/tests/hpc/fork/Makefile - testsuite/tests/hpc/function/Makefile - testsuite/tests/hpc/function/test.T - + testsuite/tests/hpc/function/tough1.stderr - + testsuite/tests/hpc/function/tough1.stdout - testsuite/tests/hpc/function2/test.T - + testsuite/tests/hpc/function2/tough3.script - + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs - testsuite/tests/hpc/ghc_ghci/Makefile - + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci01.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci02.stdout - testsuite/tests/hpc/ghc_ghci/test.T - testsuite/tests/hpc/simple/Makefile - + testsuite/tests/hpc/simple/hpc002.hs - + testsuite/tests/hpc/simple/hpc002.stdout - + testsuite/tests/hpc/simple/hpc003.hs - + testsuite/tests/hpc/simple/hpc003.script - + testsuite/tests/hpc/simple/hpc003.stdout - testsuite/tests/hpc/simple/test.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df6915631ddf6fb881b8a2e5ccefb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df6915631ddf6fb881b8a2e5ccefb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Refactor HsWildCardTy to use HoleKind (#27111)
by Marge Bot (＠marge-bot) 29 Apr '26

29 Apr '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: df691563 by Vladislav Zavialov at 2026-04-28T13:23:29-04:00 Refactor HsWildCardTy to use HoleKind (#27111) The payload of this patch is that the extension fields of HsWildCardTy and HsHole now match: type instance XWildCardTy Ghc{Ps,Rn} = HoleKind type instance XHole Ghc{Ps,Rn} = HoleKind This is progress towards unification of HsExpr and HsType. Test case: T25121_status In addition to that, exact-printing of infix holes is fixed. Test case: PprInfixHole - - - - - 19 changed files: - + changelog.d/ghc-api-holes-ast-27111 - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/ThToHs.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprInfixHole.hs - testsuite/tests/printer/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs Changes: ===================================== changelog.d/ghc-api-holes-ast-27111 ===================================== @@ -0,0 +1,10 @@ +section: ghc-lib +synopsis: Refactor ``HsWildCardTy`` to use ``HoleKind`` +issues: #27111 +mrs: !15817 + +description: { +Refactor the AST to store ``HoleKind`` not only in ``XHole``, but also in +``XWildCardTy`` and ``XBndrWildCard``. This provides more information for exact +printing of infix holes. +} ===================================== compiler/GHC/Hs/Expr.hs-boot ===================================== @@ -54,3 +54,5 @@ data HsUntypedSpliceResult thing type HsMatchContextRn = HsMatchContext (LIdP GhcRn) type HsStmtContextRn = HsStmtContext (LIdP GhcRn) + +data HoleKind ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -55,7 +55,7 @@ module GHC.Hs.Type ( OpName(..), - mkAnonWildCardTy, pprAnonWildCard, + pprAnonWildCard, hsOuterTyVarNames, hsOuterExplicitBndrs, mapHsOuterImplicit, mkHsOuterImplicit, mkHsOuterExplicit, @@ -93,7 +93,7 @@ import GHC.Prelude import Language.Haskell.Syntax.Type -import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) ) +import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..), HoleKind ) import Language.Haskell.Syntax.Extension import GHC.Core.DataCon ( SrcStrictness(..), SrcUnpackedness(..) @@ -342,8 +342,8 @@ type instance XXBndrKind (GhcPass p) = DataConCantHappen type instance XBndrVar (GhcPass p) = NoExtField -type instance XBndrWildCard GhcPs = EpToken "_" -type instance XBndrWildCard GhcRn = NoExtField +type instance XBndrWildCard GhcPs = HoleKind +type instance XBndrWildCard GhcRn = HoleKind type instance XBndrWildCard GhcTc = NoExtField type instance XXBndrVar (GhcPass p) = DataConCantHappen @@ -476,8 +476,8 @@ type instance XExplicitTupleTy GhcTc = [Kind] type instance XTyLit (GhcPass _) = NoExtField -type instance XWildCardTy GhcPs = EpToken "_" -type instance XWildCardTy GhcRn = NoExtField +type instance XWildCardTy GhcPs = HoleKind +type instance XWildCardTy GhcRn = HoleKind type instance XWildCardTy GhcTc = NoExtField type instance XXType GhcPs = HsTypeGhcPsExt @@ -661,9 +661,6 @@ ignoreParens ty = ty ************************************************************************ -} -mkAnonWildCardTy :: EpToken "_" -> HsType GhcPs -mkAnonWildCardTy tok = HsWildCardTy tok - mkHsOpTy :: (Anno (IdOccGhcP p) ~ EpAnn a) => PromotionFlag -> LHsType (GhcPass p) -> LIdOccP (GhcPass p) ===================================== compiler/GHC/Parser.y ===================================== @@ -2366,13 +2366,13 @@ tyop :: { LHsType GhcPs } | tyvarop { sL1a $1 (HsTyVar noAnn NotPromoted $1) } | SIMPLEQUOTE qconop { sLLa $1 $> (HsTyVar (epTok $1) IsPromoted $2) } | SIMPLEQUOTE varop { sLLa $1 $> (HsTyVar (epTok $1) IsPromoted $2) } - | '`' '_' '`' { sLLa $1 $> (mkAnonWildCardTy (epTok $2)) } -- TODO: reuse hole_op (blocked on #27111) + | hole_op { sLLa $1 $> (HsWildCardTy (HoleVar $1)) } atype :: { LHsType GhcPs } : ntgtycon {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] | tyvar %shift {% amsA' (sL1 $1 (HsTyVar noAnn NotPromoted $1)) } -- (See Note [Unit tuples]) - | '_' %shift { sL1a $1 $ mkAnonWildCardTy (epTok $1) } + | '_' %shift { sL1a $1 $ HsWildCardTy (HoleVar (sL1a $1 unnamedHoleRdrName)) } | '*' {% do { warnStarIsType (getLoc $1) ; return $ sL1a $1 (HsStarTy (epUniTok $1)) } } @@ -2486,7 +2486,7 @@ tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } tyvar_wc :: { Located (HsBndrVar GhcPs) } : tyvar { sL1 $1 (HsBndrVar noExtField $1) } - | '_' { sL1 $1 (HsBndrWildCard (epTok $1)) } + | '_' { sL1 $1 (HsBndrWildCard (HoleVar (sL1a $1 unnamedHoleRdrName))) } fds :: { Located (EpToken "|",[LHsFunDep GhcPs]) } : {- empty -} { noLoc (NoEpTok,[]) } @@ -4021,7 +4021,7 @@ qopm :: { forall b. DisambInfixOp b => PV (LocatedN b) } -- used in section | hole_op { mkHsInfixHolePV $1 } hole_op :: { LocatedN RdrName } -- used in sections -hole_op : '`' '_' '`' {% amsr (sLL $1 $> (mkUnqual varName (fsLit "_"))) +hole_op : '`' '_' '`' {% amsr (sLL $1 $> unnamedHoleRdrName) (NameAnn (NameBackquotes (epTok $1) (epTok $3)) (glR $2) []) } qvarop :: { LocatedN RdrName } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2072,7 +2072,7 @@ instance DisambECP (HsExpr GhcPs) where mkHsQualLitPV (L (EpAnn l an csIn) a) = do !cs <- getCommentsFor (locA l) return $ L (EpAnn l an (cs Semi.<> csIn)) (HsQualLit noExtField a) - mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (HsHole (HoleVar (L (noAnnSrcSpan l) (mkUnqual varName (fsLit "_"))))) + mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (HsHole (HoleVar (L (noAnnSrcSpan l) unnamedHoleRdrName))) mkHsTySigPV l@(EpAnn anc an csIn) a sig anns = do !cs <- getCommentsFor (locA l) return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExprWithTySig anns a (hsTypeToHsSigWcType sig)) ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -235,10 +235,10 @@ rnWcBodyTyKi level ctxt nwc_rdrs hs_ty rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt , hst_body = hs_ty }) | Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt - , L lx (HsWildCardTy _) <- ignoreParens hs_ctxt_last + , L lx (HsWildCardTy h) <- ignoreParens hs_ctxt_last = do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1 ; setSrcSpanA lx $ checkExtraConstraintWildCard env hs_ctxt1 - ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy noExtField)] + ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy h)] ; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty ; return (HsQualTy { hst_xqual = noExtField , hst_ctxt = L cx hs_ctxt' @@ -732,7 +732,7 @@ rnHsTyKi env ty@(XHsType (HsRecTy {})) = do addErr $ TcRnWithHsDocContext (rtke_ctxt env) $ TcRnIllegalRecordSyntax ty - return (HsWildCardTy noExtField, emptyFNs) -- trick to avoid `failWithTc` + return (HsWildCardTy GHC.Hs.HoleError, emptyFNs) -- trick to avoid `failWithTc` rnHsTyKi env ty@(HsExplicitListTy _ ip tys) = do { checkDataKinds env ty @@ -746,9 +746,9 @@ rnHsTyKi env ty@(HsExplicitTupleTy _ ip tys) ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys ; return (HsExplicitTupleTy noExtField ip tys', fvs) } -rnHsTyKi env (HsWildCardTy _) +rnHsTyKi env (HsWildCardTy h) = do { checkAnonWildCard env - ; return (HsWildCardTy noExtField, emptyFNs) } + ; return (HsWildCardTy h, emptyFNs) } {- Note [Strict level checks with ExplicitLevelImports] @@ -1039,10 +1039,10 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside get_bndr_loc (L l tvb) = combineSrcSpans (case hsBndrVar tvb of - HsBndrWildCard tok -> - case tok of - NoEpTok -> locA l - EpTok loc -> locA loc + HsBndrWildCard hole -> + case hole of + GHC.Hs.HoleError -> locA l + HoleVar (L loc _) -> locA loc HsBndrVar _ ln -> getLocA ln) (case hsBndrKind tvb of HsBndrNoKind _ -> noSrcSpan @@ -1310,8 +1310,8 @@ bindHsBndrVar mb_assoc (HsBndrVar _ lrdr@(L lv _)) thing_inside = do { tv_nm <- newTyVarNameRn mb_assoc lrdr ; bindLocalNamesFV [tv_nm] $ thing_inside (HsBndrVar noExtField (L lv tv_nm)) } -bindHsBndrVar _ (HsBndrWildCard _) thing_inside - = thing_inside (HsBndrWildCard noExtField) +bindHsBndrVar _ (HsBndrWildCard h) thing_inside + = thing_inside (HsBndrWildCard h) rnHsBndrKind :: HsDocContext -> HsBndrKind GhcPs -> RnM (HsBndrKind GhcRn, FreeNames) rnHsBndrKind _ (HsBndrNoKind _) = return (HsBndrNoKind noExtField, emptyFNs) ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1430,8 +1430,8 @@ rn_ty_pat tyLit@(HsTyLit src lit) = do check_data_kinds tyLit pure (HsTyLit src (convertLit lit)) -rn_ty_pat (HsWildCardTy _) = - pure (HsWildCardTy noExtField) +rn_ty_pat (HsWildCardTy h) = + pure (HsWildCardTy h) rn_ty_pat (HsKindSig an ty ki) = do ctxt <- askDocContext ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -1234,8 +1234,8 @@ expr_to_type earg = ; return (L l (HsSpliceTy splice_result' splice)) } go (L l (HsStar x)) = return (L l (HsStarTy x)) - go (L l (HsHole (HoleVar (L _ rdr)))) - | isUnderscore occ = return (L l (HsWildCardTy noExtField)) + go (L l (HsHole h@(HoleVar (L _ rdr)))) + | isUnderscore occ = return (L l (HsWildCardTy h)) | startsWithUnderscore occ = -- See Note [Wildcards in the T2T translation] do { wildcards_enabled <- xoptM LangExt.NamedWildCards ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -4772,8 +4772,8 @@ tyPatToBndr HsTP{hstp_body = (L _ hs_ty)} = go hs_ty where go_bvar (HsTyVar _ _ tv) | isTyVarName (getName tv) = Just (HsBndrVar noExtField (fmap getName tv)) - go_bvar (HsWildCardTy _) - = Just (HsBndrWildCard noExtField) + go_bvar (HsWildCardTy h) + = Just (HsBndrWildCard h) go_bvar _ = Nothing {- Note [Type patterns: binders and unifiers] ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -515,7 +515,7 @@ pat_to_type (VarPat _ lname) = ; return b } where b = noLocA (HsTyVar noAnn NotPromoted $ fmap noUserRdr lname) pat_to_type (WildPat _) = return b - where b = noLocA (HsWildCardTy noExtField) + where b = noLocA (HsWildCardTy (HoleVar (noLocA unnamedHoleRdrName))) pat_to_type (SigPat _ pat sig_ty) = do { t <- pat_to_type (unLoc pat) ; let { !(HsPS x_hsps k) = sig_ty ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1798,7 +1798,8 @@ cvtTypeKind typeOrKind ty -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys' WildCardT - -> mk_apps (mkAnonWildCardTy noAnn) tys' + -> do { n' <- wrapLN (return unnamedHoleRdrName) + ; mk_apps (HsWildCardTy (HoleVar n')) tys' } InfixT t1 s t2 -> do { s' <- tconName s ===================================== testsuite/tests/ghc-api/T25121_status.stdout ===================================== @@ -20,9 +20,7 @@ X(ExplicitList) mismatch X(ExplicitTuple) mismatch >>> ((EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]),(EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment])) <<< ((EpToken "'"),(EpToken "("),(EpToken ")")) -X(Hole) mismatch - >>> HoleKind - <<< EpToken "_" +X(Hole) match = HoleKind Extension fields @GhcRn ----------------------- @@ -50,9 +48,7 @@ X(UntypedSplice) mismatch <<< HsUntypedSpliceResult (GenLocated (EpAnn AnnListItem) (HsType (GhcPass 'Renamed))) X(ExplicitList) match = NoExtField X(ExplicitTuple) match = NoExtField -X(Hole) mismatch - >>> HoleKind - <<< NoExtField +X(Hole) match = HoleKind Extension fields @GhcTc ----------------------- ===================================== testsuite/tests/printer/Makefile ===================================== @@ -832,6 +832,11 @@ PprLetIn: $(CHECK_PPR) $(LIBDIR) PprLetIn.hs $(CHECK_EXACT) $(LIBDIR) PprLetIn.hs +.PHONY: PprInfixHole +PprInfixHole: + $(CHECK_PPR) $(LIBDIR) PprInfixHole.hs + $(CHECK_EXACT) $(LIBDIR) PprInfixHole.hs + .PHONY: CaseAltComments CaseAltComments: $(CHECK_PPR) $(LIBDIR) CaseAltComments.hs ===================================== testsuite/tests/printer/PprInfixHole.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE PartialTypeSignatures #-} +module PprInfixHole where + +f1 a b = a `_` b +f2 a b = a ` _ ` b + +t1 :: Int `_` Bool +t2 :: Int ` _ ` Bool +t1 = Left 0 +t2 = Left 0 ===================================== testsuite/tests/printer/all.T ===================================== @@ -199,6 +199,7 @@ test('ListTuplePuns', extra_files(['ListTuplePuns.hs']), ghci_script, ['ListTupl test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test, ['AnnotationNoListTuplePuns']) test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533']) test('PprLetIn', [ignore_stderr, req_ppr_deps], makefile_test, ['PprLetIn']) +test('PprInfixHole', [ignore_stderr, req_ppr_deps], makefile_test, ['PprInfixHole']) test('CaseAltComments', [ignore_stderr, req_ppr_deps], makefile_test, ['CaseAltComments']) test('MatchPatComments', [ignore_stderr, req_ppr_deps], makefile_test, ['MatchPatComments']) test('Test24748', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24748']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2844,6 +2844,14 @@ instance ExactPrint (GRHS GhcPs (LocatedA (HsCmd GhcPs))) where -- --------------------------------------------------------------------- +exactHole :: (Monad m, Monoid w) => HoleKind -> EP w m HoleKind +exactHole (HoleVar n) = do + n' <- markAnnotated n + return (HoleVar n') +exactHole HoleError = + -- TODO: Adapt 'HoleError' to include the 'SourceText': + error "Cannot exact print HoleError" + instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry _ = NoEntryVal setAnnotationAnchor a _ _ _s = a @@ -2856,14 +2864,9 @@ instance ExactPrint (HsExpr GhcPs) where then markAnnotated n else return n return (HsVar x n') - exact (HsHole (HoleVar n)) = do - let pun_RDR = "pun-right-hand-side" - n' <- if (showPprUnsafe n /= pun_RDR) - then markAnnotated n - else return n - return (HsHole (HoleVar n')) - -- TODO: Adapt 'HoleError' to include the 'SourceText': - exact (HsHole HoleError) = error "Cannot exact print HoleError" + exact (HsHole h) = do + h' <- exactHole h + return (HsHole h') exact x@(HsOverLabel src l) = do printStringAdvanceA "#" >> return () case src of @@ -3927,9 +3930,9 @@ instance ExactPrint (HsBndrVar GhcPs) where exact (HsBndrVar x n) = do n' <- markAnnotated n return (HsBndrVar x n') - exact (HsBndrWildCard t) = do - t' <- markEpToken t - return (HsBndrWildCard t') + exact (HsBndrWildCard h) = do + h' <- exactHole h + return (HsBndrWildCard h') -- --------------------------------------------------------------------- @@ -4034,7 +4037,9 @@ instance ExactPrint (HsType GhcPs) where exact (HsTyLit an lit) = do lit' <- withPpr lit return (HsTyLit an lit') - exact t@(HsWildCardTy _) = printStringAdvance "_" >> return t + exact (HsWildCardTy h) = do + h' <- exactHole h + return (HsWildCardTy h') exact x = error $ "missing match for HsType:" ++ showAst x -- --------------------------------------------------------------------- ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs ===================================== @@ -320,7 +320,7 @@ ppCtor sDocContext dat subdocs con@ConDeclH98{con_args = con_args'} = tv, tvk :: HsType GhcRn tv = case bvar of HsBndrVar _ n -> HsTyVar noAnn NotPromoted (fmap noUserRdr n) - HsBndrWildCard _ -> HsWildCardTy noExtField + HsBndrWildCard h -> HsWildCardTy h tvk = case bkind of HsBndrNoKind _ -> tv HsBndrKind _ lty -> HsKindSig noAnn (reL tv) lty ===================================== utils/haddock/haddock-api/src/Haddock/Convert.hs ===================================== @@ -122,7 +122,7 @@ tyThingToLHsDecl prr t = case t of cvt' :: HsBndrVar GhcRn -> HsType GhcRn cvt' (HsBndrVar _ nm) = HsTyVar noAnn NotPromoted (fmap noUserRdr nm) - cvt' (HsBndrWildCard _) = HsWildCardTy noExtField + cvt' (HsBndrWildCard h) = HsWildCardTy h -- \| Convert a LHsTyVarBndr to an equivalent LHsType. hsLTyVarBndrToType :: LHsTyVarBndr flag GhcRn -> LHsType GhcRn ===================================== utils/haddock/haddock-api/src/Haddock/GhcUtils.hs ===================================== @@ -326,10 +326,10 @@ addClassContext _ _ sig = sig -- E.g. a MinimalSig is fine lHsQTyVarsToTypes :: LHsQTyVars GhcRn -> [LHsTypeArg GhcRn] lHsQTyVarsToTypes tvs = - [ HsValArg noExtField $ noLocA (case hsLTyVarName tv of - Nothing -> HsWildCardTy noExtField - Just nm -> HsTyVar noAnn NotPromoted (noLocA $ noUserRdr nm)) - | tv <- hsq_explicit tvs + [ HsValArg noExtField $ noLocA (case hsBndrVar (unLoc tvb) of + HsBndrVar _ nm -> HsTyVar noAnn NotPromoted (fmap noUserRdr nm) + HsBndrWildCard h -> HsWildCardTy h) + | tvb <- hsq_explicit tvs ] hsQTvExplicitBinders :: LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df6915631ddf6fb881b8a2e5ccefb41… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df6915631ddf6fb881b8a2e5ccefb41… You're receiving this email because of your account on gitlab.haskell.org.

1 0