- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: rts: Fix lost wakeups in threadPaused for threads blocked on black holes
by Marge Bot (＠marge-bot) 30 Sep '25

30 Sep '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 06108198 by Luite Stegeman at 2025-09-30T14:09:24-04:00 rts: Fix lost wakeups in threadPaused for threads blocked on black holes The lazy blackholing code in threadPaused could overwrite closures that were already eagerly blackholed, and as such wouldn't have a marked update frame. If the black hole was overwritten by its original owner, this would lead to an undetected collision, and the contents of any existing blocking queue being lost. This adds a check for eagerly blackholed closures and avoids overwriting their contents. Fixes #26324 - - - - - 4bb1576e by Luite Stegeman at 2025-09-30T14:09:24-04:00 rts: push the correct update frame in stg_AP_STACK The frame contains an eager black hole (__stg_EAGER_BLACKHOLE_info) so we should push an stg_bh_upd_frame_info instead of an stg_upd_frame_info. - - - - - 9f1423b8 by Cheng Shao at 2025-09-30T14:09:25-04:00 ghci: fix lookupSymbolInDLL behavior on wasm This patch fixes lookupSymbolInDLL behavior on wasm to return Nothing instead of throwing. On wasm, we only have lookupSymbol, and the driver would attempt to call lookupSymbolInDLL first before falling back to lookupSymbol, so lookupSymbolInDLL needs to return Nothing gracefully for the fallback behavior to work. - - - - - 583d3d53 by Cheng Shao at 2025-09-30T14:09:25-04:00 hadrian/compiler: enable internal-interpreter for ghc library in wasm stage1 This commit enables the internal-interpreter flag for ghc library in wasm stage1, as well as other minor adjustments to make it actually possible to launch a ghc api session that makes use of the internal interpreter. Closes #26431 #25400. - - - - - bb886749 by Cheng Shao at 2025-09-30T14:09:25-04:00 testsuite: add T26431 test case This commit adds T26431 to testsuite/tests/ghci-wasm which goes through the complete bytecode compilation/linking/running pipeline in wasm, so to witness that the ghc shared library in wasm have full support for internal-interpreter. - - - - - 74e01719 by Matthew Pickering at 2025-09-30T14:09:26-04:00 driver: Load bytecode static pointer entries during linking Previously the entries were loaded too eagerly, during upsweep, but we should delay loading them until we know that the relevant bytecode object is demanded. Towards #25230 - - - - - 51c7def9 by Cheng Shao at 2025-09-30T14:09:27-04:00 autoconf/ghc-toolchain: remove obsolete C99 check This patch removes obsolete c99 check from autoconf/ghc-toolchain. For all toolchain & platform combination we support, gnu11 or above is already supported without any -std flag required, and our RTS already required C11 quite a few years ago, so the C99 check is completely pointless. - - - - - 21 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter/Types.hs - configure.ac - distrib/configure.ac.in - hadrian/src/Settings/Packages.hs - libraries/ghci/GHCi/ObjLink.hs - m4/fp_cmm_cpp_cmd_with_args.m4 - − m4/fp_set_cflags_c99.m4 - rts/Apply.cmm - rts/ThreadPaused.c - + testsuite/tests/ghci-wasm/T26431.hs - + testsuite/tests/ghci-wasm/T26431.stdout - testsuite/tests/ghci-wasm/all.T - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -716,17 +716,14 @@ setTopSessionDynFlags dflags = do -- see Note [Target code interpreter] interp <- if +#if !defined(wasm32_HOST_ARCH) -- Wasm dynamic linker | ArchWasm32 <- platformArch $ targetPlatform dflags -> do s <- liftIO $ newMVar InterpPending loader <- liftIO Loader.uninitializedLoader dyld <- liftIO $ makeAbsolute $ topDir dflags </> "dyld.mjs" -#if defined(wasm32_HOST_ARCH) - let libdir = sorry "cannot spawn child process on wasm" -#else libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries" -#endif let profiled = ways dflags `hasWay` WayProf way_tag = if profiled then "_p" else "" let cfg = @@ -747,6 +744,7 @@ setTopSessionDynFlags dflags = do wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env } pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache +#endif -- JavaScript interpreter | ArchJavaScript <- platformArch (targetPlatform dflags) ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1321,6 +1321,7 @@ stmtMacros = listToUFM [ ( fsLit "PROF_HEADER_CREATE", \[e] -> profHeaderCreate e ), ( fsLit "PUSH_UPD_FRAME", \[sp,e] -> emitPushUpdateFrame sp e ), + ( fsLit "PUSH_BH_UPD_FRAME", \[sp,e] -> emitPushBHUpdateFrame sp e ), ( fsLit "SET_HDR", \[ptr,info,ccs] -> emitSetDynHdr ptr info ccs ), ( fsLit "TICK_ALLOC_PRIM", \[hdr,goods,slop] -> @@ -1336,6 +1337,10 @@ emitPushUpdateFrame :: CmmExpr -> CmmExpr -> FCode () emitPushUpdateFrame sp e = do emitUpdateFrame sp mkUpdInfoLabel e +emitPushBHUpdateFrame :: CmmExpr -> CmmExpr -> FCode () +emitPushBHUpdateFrame sp e = do + emitUpdateFrame sp mkBHUpdInfoLabel e + pushStackFrame :: [CmmParse CmmExpr] -> CmmParse () -> CmmParse () pushStackFrame fields body = do profile <- getProfile ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Main , dumpIfaceStats , ioMsgMaybe , showModuleIndex - , hscAddSptEntries , writeInterfaceOnlyMode , loadByteCode , genModDetails @@ -2515,9 +2514,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do let src_span = srcLocSpan interactiveSrcLoc _ <- liftIO $ loadDecls interp hsc_env src_span linkable - {- Load static pointer table entries -} - liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg) - let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg) patsyns = mg_patsyns simpl_mg @@ -2539,18 +2535,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do fam_insts defaults fix_env return (new_tythings, new_ictxt) --- | Load the given static-pointer table entries into the interpreter. --- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable". -hscAddSptEntries :: HscEnv -> [SptEntry] -> IO () -hscAddSptEntries hsc_env entries = do - let interp = hscInterp hsc_env - let add_spt_entry :: SptEntry -> IO () - add_spt_entry (SptEntry n fpr) = do - -- These are only names from the current module - (val, _, _) <- loadName interp hsc_env n - addSptEntry interp fpr val - mapM_ add_spt_entry entries - {- Note [Fixity declarations in GHCi] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -56,8 +56,6 @@ import GHC.Tc.Utils.Monad ( initIfaceCheck, concatMapM ) import GHC.Runtime.Interpreter import qualified GHC.Linker.Loader as Linker -import GHC.Linker.Types - import GHC.Driver.Config.Diagnostic import GHC.Driver.Pipeline @@ -72,8 +70,6 @@ import GHC.Driver.MakeSem import GHC.Driver.Downsweep import GHC.Driver.MakeAction -import GHC.ByteCode.Types - import GHC.Iface.Load ( cannotFindModule, readIface ) import GHC.IfaceToCore ( typecheckIface ) import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) @@ -1232,31 +1228,9 @@ upsweep_mod :: HscEnv upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods = do hmi <- compileOne' mHscMessage hsc_env summary mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi) - - -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module - -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I - -- am unsure if this is sound (wrt running TH splices for example). - -- This function only does anything if the linkable produced is a BCO, which - -- used to only happen with the bytecode backend, but with - -- @-fprefer-byte-code@, @HomeModInfo@ has bytecode even when generating - -- object code, see #25230. hscInsertHPT hmi hsc_env - addSptEntries (hsc_env) - (homeModInfoByteCode hmi) - return hmi --- | Add the entries from a BCO linkable to the SPT table, see --- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. -addSptEntries :: HscEnv -> Maybe Linkable -> IO () -addSptEntries hsc_env mlinkable = - hscAddSptEntries hsc_env - [ spt - | linkable <- maybeToList mlinkable - , bco <- linkableBCOs linkable - , spt <- bc_spt_entries bco - ] - -- Note [When source is considered modified] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3763,12 +3763,17 @@ makeDynFlagsConsistent dflags -- only supports dynamic code | LinkInMemory <- ghcLink dflags , sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags +#if defined(HAVE_INTERNAL_INTERPRETER) + , not (ways dflags `hasWay` WayDyn) +#else , not (ways dflags `hasWay` WayDyn && gopt Opt_ExternalInterpreter dflags) +#endif = flip loopNoWarn "Forcing dynamic way because target RTS linker only supports dynamic code" $ - -- See checkOptions, -fexternal-interpreter is - -- required when using --interactive with a non-standard - -- way (-prof, -static, or -dynamic). +#if !defined(HAVE_INTERNAL_INTERPRETER) + -- Force -fexternal-interpreter if internal-interpreter is not + -- available at this stage setGeneralFlag' Opt_ExternalInterpreter $ +#endif addWay' WayDyn dflags | LinkInMemory <- ghcLink dflags ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -124,7 +124,7 @@ Here is a running example: * If we are compiling for the byte-code interpreter, we instead explicitly add the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter process' SPT table using the addSptEntry interpreter message. This happens - in upsweep after we have compiled the module (see GHC.Driver.Make.upsweep'). + when the bytecode object is linked in `dynLinkBCOs`. -} import GHC.Prelude ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -718,6 +718,7 @@ loadDecls interp hsc_env span linkable = do let ce2 = extendClosureEnv (closure_env le2) nms_fhvs !pls2 = pls { linker_env = le2 { closure_env = ce2 } , linked_breaks = lb2 } + mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs) return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -951,10 +952,28 @@ dynLinkBCOs interp pls bcos = do -- Wrap finalizers on the ones we want to keep new_binds <- makeForeignNamedHValueRefs interp to_add + let ce2 = extendClosureEnv (closure_env le2) new_binds + + -- Add SPT entries + mapM_ (linkSptEntry interp ce2) (concatMap bc_spt_entries cbcs) + return $! pls1 { linker_env = le2 { closure_env = ce2 } , linked_breaks = lb2 } +-- | Register SPT entries for this module in the interpreter +-- Assumes that the name from the SPT has already been loaded into the interpreter. +linkSptEntry :: Interp -> ClosureEnv -> SptEntry -> IO () +linkSptEntry interp ce (SptEntry name fpr) = do + case lookupNameEnv ce name of + -- The SPT entries only point to locally defined names, which should have already been + -- loaded into the interpreter before this function is called. + Nothing -> pprPanic "linkSptEntry" (ppr name) + Just (_, hval) -> addSptEntry interp fpr hval + + + + -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp -> PkgsLoaded @@ -1614,6 +1633,9 @@ gccSearchDirCache = unsafePerformIO $ newIORef [] -- which dominate a large percentage of startup time on Windows. getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath] getGccSearchDirectory logger dflags key = do +#if defined(wasm32_HOST_ARCH) + pure [] +#else cache <- readIORef gccSearchDirCache case lookup key cache of Just x -> return x @@ -1640,6 +1662,7 @@ getGccSearchDirectory logger dflags key = do x:_ -> case break (=='=') x of (_ , []) -> [] (_, (_:xs)) -> xs +#endif -- | Get a list of system search directories, this to alleviate pressure on -- the findSysDll function. ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -214,7 +214,7 @@ data JSInterpConfig = JSInterpConfig data WasmInterpConfig = WasmInterpConfig { wasmInterpDyLD :: !FilePath -- ^ Location of dyld.mjs script - , wasmInterpLibDir :: FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc + , wasmInterpLibDir :: !FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc , wasmInterpOpts :: ![String] -- ^ Additional command line arguments for iserv -- wasm ghci browser mode ===================================== configure.ac ===================================== @@ -448,11 +448,6 @@ AC_SUBST([CmmCPPCmd]) AC_SUBST([CmmCPPArgs]) AC_SUBST([CmmCPPSupportsG0]) -FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) - dnl ** Do we have a compatible emsdk version? dnl -------------------------------------------------------------- EMSDK_VERSION("3.1.20", "", "") ===================================== distrib/configure.ac.in ===================================== @@ -163,11 +163,6 @@ AC_SUBST([CmmCPPCmd]) AC_SUBST([CmmCPPArgs]) AC_SUBST([CmmCPPSupportsG0]) -FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS]) -dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) - dnl ** Which ld to use? dnl -------------------------------------------------------------- FIND_LD([$target],[GccUseLdOpt]) ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -82,15 +82,18 @@ packageArgs = do ] , builder (Cabal Flags) ? mconcat - -- For the ghc library, internal-interpreter only makes - -- sense when we're not cross compiling. For cross GHC, - -- external interpreter is used for loading target code - -- and internal interpreter is supposed to load native - -- code for plugins (!7377), however it's unfinished work - -- (#14335) and completely untested in CI for cross - -- backends at the moment, so we might as well disable it - -- for cross GHC. - [ andM [expr (ghcWithInterpreter stage), notCross] `cabalFlag` "internal-interpreter" + -- In order to enable internal-interpreter for the ghc + -- library: + -- + -- 1. ghcWithInterpreter must be True ("Use interpreter" = + -- "YES") + -- 2. For non-cross case it can be enabled + -- 3. For cross case, disable for stage0 since that runs + -- on the host and must rely on external interpreter to + -- load target code, otherwise enable for stage1 since + -- that runs on the target and can use target's own + -- ghci object linker + [ andM [expr (ghcWithInterpreter stage), orM [notCross, stage1]] `cabalFlag` "internal-interpreter" , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" ===================================== libraries/ghci/GHCi/ObjLink.hs ===================================== @@ -113,8 +113,7 @@ foreign import javascript unsafe "__ghc_wasm_jsffi_dyld.lookupSymbol($1)" js_lookupSymbol :: JSString -> IO (Ptr a) lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) -lookupSymbolInDLL _ sym = - throwIO $ ErrorCall $ "lookupSymbolInDLL: unsupported on wasm for " <> sym +lookupSymbolInDLL _ _ = pure Nothing resolveObjs :: IO Bool resolveObjs = pure True ===================================== m4/fp_cmm_cpp_cmd_with_args.m4 ===================================== @@ -56,27 +56,6 @@ else AC_MSG_RESULT([no]) fi -AC_MSG_CHECKING([the C-- preprocessor for C99 support]) -cat > conftest.c <<EOF -#include <stdio.h> -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L -# error "Compiler does not advertise C99 conformance" -#endif -EOF -if "$CMM_CPP_CMD" $CMM_CPP_ARGS conftest.c -o conftest -g0 >/dev/null 2>&1; then - AC_MSG_RESULT([yes]) -else - # Try -std=gnu99 - if "$CMM_CPP_CMD" -std=gnu99 $CMM_CPP_ARGS conftest.c -o conftest -g0 >/dev/null 2>&1; then - $3="-std=gnu99 $$3" - AC_MSG_RESULT([needs -std=gnu99]) - else - AC_MSG_ERROR([C99-compatible compiler needed]) - fi -fi -rm -f conftest.c conftest.o conftest - - $2="$CMM_CPP_CMD" $3="$$3 $CMM_CPP_ARGS" @@ -85,4 +64,3 @@ unset CMM_CPP_CMD unset CMM_CPP_ARGS ]) - ===================================== m4/fp_set_cflags_c99.m4 deleted ===================================== @@ -1,38 +0,0 @@ -# FP_SET_CFLAGS_C99 -# ---------------------------------- -# figure out which CFLAGS are needed to place the compiler into C99 mode -# $1 is name of CC variable (unmodified) -# $2 is name of CC flags variable (augmented if needed) -# $3 is name of CPP flags variable (augmented if needed) -AC_DEFUN([FP_SET_CFLAGS_C99], -[ - dnl save current state of AC_PROG_CC_C99 - FP_COPY_SHELLVAR([CC],[fp_save_CC]) - FP_COPY_SHELLVAR([CFLAGS],[fp_save_CFLAGS]) - FP_COPY_SHELLVAR([CPPFLAGS],[fp_save_CPPFLAGS]) - FP_COPY_SHELLVAR([ac_cv_prog_cc_c99],[fp_save_cc_c99]) - dnl set local state - CC="$$1" - CFLAGS="$$2" - CPPFLAGS="$$3" - unset ac_cv_prog_cc_c99 - dnl perform detection - AC_PROG_CC_C99 - fp_cc_c99="$ac_cv_prog_cc_c99" - case "x$ac_cv_prog_cc_c99" in - x) ;; # noop - xno) AC_MSG_ERROR([C99-compatible compiler needed]) ;; - *) $2="$$2 $ac_cv_prog_cc_c99" - $3="$$3 $ac_cv_prog_cc_c99" - ;; - esac - dnl restore saved state - FP_COPY_SHELLVAR([fp_save_CC],[CC]) - FP_COPY_SHELLVAR([fp_save_CFLAGS],[CFLAGS]) - FP_COPY_SHELLVAR([fp_save_CPPFLAGS],[CPPFLAGS]) - FP_COPY_SHELLVAR([fp_save_cc_c99],[ac_cv_prog_cc_c99]) - dnl cleanup - unset fp_save_CC - unset fp_save_CFLAGS - unset fp_save_cc_c99 -]) ===================================== rts/Apply.cmm ===================================== @@ -699,7 +699,7 @@ INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK") /* ensure there is at least AP_STACK_SPLIM words of headroom available * after unpacking the AP_STACK. See bug #1466 */ - PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); + PUSH_BH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words); TICK_ENT_AP(); ===================================== rts/ThreadPaused.c ===================================== @@ -15,6 +15,7 @@ #include "RaiseAsync.h" #include "Trace.h" #include "Threads.h" +#include "Messages.h" #include "sm/NonMovingMark.h" #include <string.h> // for memmove() @@ -314,52 +315,66 @@ threadPaused(Capability *cap, StgTSO *tso) continue; } - // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a - // BLACKHOLE here. + // If we have a frame that is already eagerly blackholed, we + // shouldn't overwrite its payload: There may already be a blocking + // queue (see #26324). + if(frame_info == &stg_bh_upd_frame_info) { + // eager black hole: we do nothing + + // it should be a black hole that we own + ASSERT(bh_info == &stg_BLACKHOLE_info || + bh_info == &__stg_EAGER_BLACKHOLE_info || + bh_info == &stg_CAF_BLACKHOLE_info); + ASSERT(blackHoleOwner(bh) == tso || blackHoleOwner(bh) == NULL); + } else { + // lazy black hole + #if defined(THREADED_RTS) - // first we turn it into a WHITEHOLE to claim it, and if - // successful we write our TSO and then the BLACKHOLE info pointer. - cur_bh_info = (const StgInfoTable *) - cas((StgVolatilePtr)&bh->header.info, - (StgWord)bh_info, - (StgWord)&stg_WHITEHOLE_info); - - if (cur_bh_info != bh_info) { - bh_info = cur_bh_info; + // first we turn it into a WHITEHOLE to claim it, and if + // successful we write our TSO and then the BLACKHOLE info pointer. + cur_bh_info = (const StgInfoTable *) + cas((StgVolatilePtr)&bh->header.info, + (StgWord)bh_info, + (StgWord)&stg_WHITEHOLE_info); + + if (cur_bh_info != bh_info) { + bh_info = cur_bh_info; #if defined(PROF_SPIN) - NONATOMIC_ADD(&whitehole_threadPaused_spin, 1); + NONATOMIC_ADD(&whitehole_threadPaused_spin, 1); #endif - busy_wait_nop(); - goto retry; - } + busy_wait_nop(); + goto retry; + } #endif - - IF_NONMOVING_WRITE_BARRIER_ENABLED { - if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) { - // We are about to replace a thunk with a blackhole. - // Add the free variables of the closure we are about to - // overwrite to the update remembered set. - // N.B. We caught the WHITEHOLE case above. - updateRemembSetPushThunkEager(cap, - THUNK_INFO_PTR_TO_STRUCT(bh_info), - (StgThunk *) bh); + ASSERT(bh_info != &stg_WHITEHOLE_info); + + IF_NONMOVING_WRITE_BARRIER_ENABLED { + if (ip_THUNK(INFO_PTR_TO_STRUCT(bh_info))) { + // We are about to replace a thunk with a blackhole. + // Add the free variables of the closure we are about to + // overwrite to the update remembered set. + // N.B. We caught the WHITEHOLE case above. + updateRemembSetPushThunkEager(cap, + THUNK_INFO_PTR_TO_STRUCT(bh_info), + (StgThunk *) bh); + } } - } - // zero out the slop so that the sanity checker can tell - // where the next closure is. N.B. We mustn't do this until we have - // pushed the free variables to the update remembered set above. - OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info))); + // zero out the slop so that the sanity checker can tell + // where the next closure is. N.B. We mustn't do this until we have + // pushed the free variables to the update remembered set above. + OVERWRITING_CLOSURE_SIZE(bh, closure_sizeW_(bh, INFO_PTR_TO_STRUCT(bh_info))); - // The payload of the BLACKHOLE points to the TSO - RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso); - SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info); + // The payload of the BLACKHOLE points to the TSO + RELEASE_STORE(&((StgInd *)bh)->indirectee, (StgClosure *)tso); + SET_INFO_RELEASE(bh,&stg_BLACKHOLE_info); - // .. and we need a write barrier, since we just mutated the closure: - recordClosureMutated(cap,bh); + // .. and we need a write barrier, since we just mutated the closure: + recordClosureMutated(cap,bh); - // We pretend that bh has just been created. - LDV_RECORD_CREATE(bh); + // We pretend that bh has just been created. + LDV_RECORD_CREATE(bh); + } frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); if (prev_was_update_frame) { ===================================== testsuite/tests/ghci-wasm/T26431.hs ===================================== @@ -0,0 +1,35 @@ +import Control.Exception +import Control.Monad.IO.Class +import Data.Maybe +import GHC +import GHC.Plugins +import GHC.Runtime.Interpreter +import System.Environment.Blank + +main :: IO () +main = do + [libdir] <- getArgs + defaultErrorHandler defaultFatalMessager defaultFlushOut $ + runGhc (Just libdir) $ + do + dflags0 <- getSessionDynFlags + let dflags1 = + dflags0 + { ghcMode = CompManager, + backend = interpreterBackend, + ghcLink = LinkInMemory + } + logger <- getLogger + (dflags2, _, _) <- + parseDynamicFlags logger dflags1 $ + map noLoc ["-package", "ghc"] + _ <- setSessionDynFlags dflags2 + addTarget =<< guessTarget "hello.hs" Nothing Nothing + _ <- load LoadAllTargets + setContext + [ IIDecl $ simpleImportDecl $ mkModuleName "Prelude", + IIDecl $ simpleImportDecl $ mkModuleName "Main" + ] + hsc_env <- getSession + fhv <- compileExprRemote "main" + liftIO $ evalIO (fromJust $ hsc_interp hsc_env) fhv ===================================== testsuite/tests/ghci-wasm/T26431.stdout ===================================== @@ -0,0 +1 @@ +main = putStrLn "hello world" ===================================== testsuite/tests/ghci-wasm/all.T ===================================== @@ -10,3 +10,11 @@ test('T26430', [ extra_hc_opts('-L. -lT26430B')] , compile_and_run, [''] ) + +test('T26431', [ + extra_files(['../../../.gitlab/hello.hs']), + extra_hc_opts('-package ghc'), + extra_run_opts(f'"{config.libdir}"'), + ignore_stderr] +, compile_and_run, [''] +) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Toolchain.Tools.Cc , compileC , compileAsm , addPlatformDepCcFlags - , checkC99Support ) where import Control.Monad @@ -51,12 +50,8 @@ findCc archOs llvmTarget progOpt = do cc1 <- ignoreUnusedArgs cc0 cc2 <- ccSupportsTarget archOs llvmTarget cc1 checking "whether Cc works" $ checkCcWorks cc2 - cc3 <- oneOf "cc doesn't support C99" $ map checkC99Support - [ cc2 - , cc2 & _ccFlags %++ "-std=gnu99" - ] - checkCcSupportsExtraViaCFlags cc3 - return cc3 + checkCcSupportsExtraViaCFlags cc2 + return cc2 checkCcWorks :: Cc -> M () checkCcWorks cc = withTempDir $ \dir -> do @@ -88,17 +83,6 @@ ccSupportsTarget archOs target cc = checking "whether Cc supports --target" $ supportsTarget archOs _ccProgram checkCcWorks target cc -checkC99Support :: Cc -> M Cc -checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do - let test_o = dir </> "test.o" - compileC cc test_o $ unlines - [ "#include <stdio.h>" - , "#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L" - , "# error \"Compiler does not advertise C99 conformance\"" - , "#endif" - ] - return cc - checkCcSupportsExtraViaCFlags :: Cc -> M () checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c flags" $ withTempDir $ \dir -> do let test_o = dir </> "test.o" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -19,7 +19,7 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.Program import GHC.Toolchain.Tools.Cc -import GHC.Toolchain.Utils (withTempDir, oneOf, expectFileExists) +import GHC.Toolchain.Utils (withTempDir, expectFileExists) newtype Cpp = Cpp { cppProgram :: Program } @@ -160,13 +160,7 @@ findJsCpp progOpt cc = checking "for JavaScript C preprocessor" $ do findCmmCpp :: ProgOpt -> Cc -> M CmmCpp findCmmCpp progOpt cc = checking "for a Cmm preprocessor" $ do -- Use the specified CPP or try to use the c compiler - foundCppProg <- findProgram "Cmm preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) - -- Check whether the C preprocessor needs -std=gnu99 (only very old toolchains need this) - Cc cpp <- oneOf "cc doesn't support C99" $ map checkC99Support - [ Cc foundCppProg - , Cc (foundCppProg & _prgFlags %++ "-std=gnu99") - ] - + cpp <- findProgram "Cmm preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) cmmCppSupportsG0 <- withTempDir $ \dir -> do let conftest = dir </> "conftest.c" writeFile conftest "int main(void) {}" @@ -181,14 +175,9 @@ findCmmCpp progOpt cc = checking "for a Cmm preprocessor" $ do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do -- Use the specified CPP or try to use the c compiler - foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) - -- Check whether the C preprocessor needs -std=gnu99 (only very old toolchains need this) - Cc cpp2 <- oneOf "cc doesn't support C99" $ map checkC99Support - [ Cc foundCppProg - , Cc (foundCppProg & _prgFlags %++ "-std=gnu99") - ] + cpp <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) -- Always add the -E flag to the CPP, regardless of the user options - let cppProgram = addFlagIfNew "-E" cpp2 + let cppProgram = addFlagIfNew "-E" cpp return Cpp{cppProgram} -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81b7bea21aede1409cba6e24b82d16… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81b7bea21aede1409cba6e24b82d16… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/26461
by Rodrigo Mesquita (＠alt-romes) 30 Sep '25

30 Sep '25

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

1 0

[Git][ghc/ghc][wip/T23162-spj] Wibble
by Simon Peyton Jones (＠simonpj) 30 Sep '25

30 Sep '25

Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC Commits: b3c474de by Simon Peyton Jones at 2025-09-30T15:15:47+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -2402,6 +2402,7 @@ recordUnifications (WU_Coarse lvl_ref) tvs recordUnifications (WU_Fine tvs_ref) tvs = updTcRef tvs_ref (`unionVarSet` tvs) + {- %************************************************************************ %* * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3c474de683d11a63da8e910c63846d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3c474de683d11a63da8e910c63846d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/querying-newline-modes] Add an operation `System.IO.hGetNewlineMode`
by Wolfgang Jeltsch (＠jeltsch) 30 Sep '25

30 Sep '25

Wolfgang Jeltsch pushed to branch wip/jeltsch/querying-newline-modes at Glasgow Haskell Compiler / GHC Commits: 42593900 by Wolfgang Jeltsch at 2025-09-30T16:53:30+03:00 Add an operation `System.IO.hGetNewlineMode` This commit also contains some small code and documentation changes for related operations, for the sake of consistency. - - - - - 8 changed files: - libraries/base/changelog.md - libraries/base/src/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/changelog.md ===================================== @@ -10,6 +10,7 @@ * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350)) * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339)) * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335) + * Add `System.IO.hGetNewlineMode` ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/System/IO.hs ===================================== @@ -175,6 +175,7 @@ module System.IO -- Binary-mode 'Handle's do no newline translation at all. hSetNewlineMode, + hGetNewlineMode, Newline(..), nativeNewline, NewlineMode(..), ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs ===================================== @@ -40,7 +40,7 @@ module GHC.Internal.IO.Handle ( hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable, hSetEcho, hGetEcho, hIsTerminalDevice, - hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, + hSetNewlineMode, hGetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, noNewlineTranslation, universalNewlineMode, nativeNewlineMode, hShow, @@ -238,7 +238,7 @@ hSetBuffering handle mode = return Handle__{ haBufferMode = mode,.. } -- ----------------------------------------------------------------------------- --- hSetEncoding +-- Setting and getting the text encoding -- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding -- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is @@ -624,16 +624,22 @@ hSetBinaryMode handle bin = haOutputNL = outputNL nl, .. } -- ----------------------------------------------------------------------------- --- hSetNewlineMode +-- Setting and getting the newline mode --- | Set the 'NewlineMode' on the specified 'Handle'. All buffered +-- | Set the 'NewlineMode' for the specified 'Handle'. All buffered -- data is flushed first. hSetNewlineMode :: Handle -> NewlineMode -> IO () -hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } = +hSetNewlineMode handle NewlineMode{..} = withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{} -> do flushBuffer h_ - return h_{ haInputNL=i, haOutputNL=o } + return h_{ haInputNL = inputNL, haOutputNL = outputNL } + +-- | Return the current 'NewlineMode' for the specified 'Handle'. +hGetNewlineMode :: Handle -> IO NewlineMode +hGetNewlineMode hdl = + withHandle_ "hGetNewlineMode" hdl $ \h_@Handle__{..} -> + return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL } -- ----------------------------------------------------------------------------- -- Duplicating a Handle ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -213,6 +213,7 @@ module GHC.Internal.System.IO ( -- Binary-mode 'Handle's do no newline translation at all. -- hSetNewlineMode, + hGetNewlineMode, Newline(..), nativeNewline, NewlineMode(..), noNewlineTranslation, universalNewlineMode, nativeNewlineMode, ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -10259,6 +10259,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -13305,6 +13305,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -10539,6 +10539,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -10259,6 +10259,7 @@ module System.IO where hGetEcho :: Handle -> IO GHC.Internal.Types.Bool hGetEncoding :: Handle -> IO (GHC.Internal.Maybe.Maybe TextEncoding) hGetLine :: Handle -> IO GHC.Internal.Base.String + hGetNewlineMode :: Handle -> IO NewlineMode hGetPosn :: Handle -> IO HandlePosn hIsClosed :: Handle -> IO GHC.Internal.Types.Bool hIsEOF :: Handle -> IO GHC.Internal.Types.Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/425939009cdc8cda04fe86c2e04a03a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/425939009cdc8cda04fe86c2e04a03a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26457] Fix buglet in GHC.Core.Unify.uVarOrFam
by Simon Peyton Jones (＠simonpj) 30 Sep '25

30 Sep '25

Simon Peyton Jones pushed to branch wip/T26457 at Glasgow Haskell Compiler / GHC Commits: 771aaa74 by Simon Peyton Jones at 2025-09-30T14:35:03+01:00 Fix buglet in GHC.Core.Unify.uVarOrFam We were failing to match two totally-equal types! This led to #26457. - - - - - 3 changed files: - compiler/GHC/Core/Unify.hs - + testsuite/tests/typecheck/should_compile/T26457.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -288,10 +288,11 @@ Wrinkles (ATF3) What about foralls? For example, supppose we are unifying (forall a. F a) -> (forall a. F a) - Those two (F a) types are unrelated, bound by different foralls. + against some other type. Those two (F a) types are unrelated, bound by + different foralls; we cannot extend the um_fam_env with a binding [F a :-> blah] So to keep things simple, the entire family-substitution machinery is used - only if there are no enclosing foralls (see the (um_foralls env)) check in + only if there are no enclosing foralls (see the `under_forall` check in `uSatFamApp`). That's fine, because the apartness business is used only for reducing type-family applications, and class instances, and their arguments can't have foralls anyway. @@ -329,6 +330,8 @@ Wrinkles instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where ... -- The "..." gives rise to [W] Ord (Generically1 f a) + where Rep1 is a type family. + We must use the instance decl (recursively) to simplify the [W] constraint; we do /not/ want to worry that the `[G] Ord (Rep1 f a)` might be an alternative path. So `noMatchableGivenDicts` must return False; @@ -336,6 +339,12 @@ Wrinkles `DontBindMe`, the unifier must return `SurelyApart`, not `MaybeApart`. See `go` in `uVarOrFam` + This looks a bit sketchy, because they aren't SurelyApart, but see + Note [What might equal later?] in GHC.Tc.Utils.Unify, esp "Red Herring". + + If we are under a forall, we return `MaybeApart`; that seems more conservative, + and class constraints are on tau-types so it doesn't matter. + (ATF6) When /matching/ can we ever have a type-family application on the LHS, in the template? You might think not, because type-class-instance and type-family-instance heads can't include type families. E.g. @@ -344,12 +353,12 @@ Wrinkles But you'd be wrong: even when matching, we can see type families in the LHS template: * In `checkValidClass`, in `check_dm` we check that the default method has the right type, using matching, both ways. And that type may have type-family - applications in it. Example in test CoOpt_Singletons. + applications in it. Examples in test CoOpt_Singletons and T26457. * In the specialiser: see the call to `tcMatchTy` in `GHC.Core.Opt.Specialise.beats_or_same` - * With -fpolymorphic-specialsation, we might get a specialiation rule like + * With -fpolymorphic-specialisation, we might get a specialiation rule like RULE forall a (d :: Eq (Maybe (F a))) . f @(Maybe (F a)) d = ... See #25965. @@ -362,7 +371,7 @@ Wrinkles type variables/ that makes the match work. So we simply want to recurse into the arguments of the type family. E.g. Template: forall a. Maybe (F a) - Target: Mabybe (F Int) + Target: Maybe (F Int) We want to succeed with substitution [a :-> Int]. See (ATF9). Conclusion: where we enter via `tcMatchTy`, `tcMatchTys`, `tc_match_tys`, @@ -378,10 +387,10 @@ Wrinkles type family G6 a = r | r -> a type instance G6 [a] = [G a] type instance G6 Bool = Int - and suppose we haev a Wanted constraint + and suppose we have a Wanted constraint [W] G6 alpha ~ [Int] -. According to Section 5.2 of "Injective type families for Haskell", we /match/ - the RHS each type instance [Int]. So we try + According to Section 5.2 of "Injective type families for Haskell", we /match/ + the RHS each of type instance with [Int]. So we try Template: [G a] Target: [Int] and we want to succeed with MaybeApart, so that we can generate the improvement constraint @@ -401,15 +410,21 @@ Wrinkles (ATF9) Decomposition. Consider unifying F a ~ F Int - There is a unifying substitition [a :-> Int], and we want to find it, returning - Unifiable. (Remember, this is the Core unifier -- we are not doing type inference.) - So we should decompose to get (a ~ Int) + when `um_bind_fam_fun` says DontBindMe. There is a unifying substitition [a :-> Int], + and we want to find it, returning Unifiable. Why? + - Remember, this is the Core unifier -- we are not doing type inference + - When we have two equal types, like F a ~ F a, it is ridiculous to say that they + are MaybeApart. Example: the two-way tcMatchTy in `checkValidClass` and #26457. - But consider unifying + (ATF9-1) But consider unifying F Int ~ F Bool - Although Int and Bool are SurelyApart, we must return MaybeApart for the outer - unification. Hence the use of `don'tBeSoSure` in `go_fam_fam`; it leaves Unifiable - alone, but weakens `SurelyApart` to `MaybeApart`. + Although Int and Bool are SurelyApart, we must return MaybeApart for the outer + unification. Hence the use of `don'tBeSoSure` in `go_fam_fam`; it leaves Unifiable + alone, but weakens `SurelyApart` to `MaybeApart`. + + (ATF9-2) We want this decomposition to occur even under a forall (this was #26457). + E.g. (forall a. F Int) -> Int ~ (forall a. F Int) ~ Int + (ATF10) Injectivity. Consider (AFT9) where F is known to be injective. Then if we are unifying @@ -1815,6 +1830,9 @@ uVarOrFam env ty1 ty2 kco -- , text "fam_env" <+> ppr (um_fam_env substs) ]) $ ; go NotSwapped substs ty1 ty2 kco } where + foralld_tvs = um_foralls env + under_forall = not (isEmptyVarSet foralld_tvs) + -- `go` takes two bites at the cherry; if the first one fails -- it swaps the arguments and tries again; and then it fails. -- The SwapFlag argument tells `go` whether it is on the first @@ -1889,7 +1907,6 @@ uVarOrFam env ty1 ty2 kco | otherwise = False - foralld_tvs = um_foralls env occurs_check = um_unif env && uOccursCheck substs foralld_tvs lhs rhs -- Occurs check, only when unifying -- see Note [Infinitary substitutions] @@ -1899,14 +1916,11 @@ uVarOrFam env ty1 ty2 kco -- LHS is a saturated type-family application -- Invariant: ty2 is not a TyVarTy go swapped substs lhs@(TyFamLHS tc1 tys1) ty2 kco - -- If we are under a forall, just give up and return MaybeApart - -- see (ATF3) in Note [Apartness and type families] - | not (isEmptyVarSet (um_foralls env)) - = maybeApart MARTypeFamily - - -- We are not under any foralls, so the RnEnv2 is empty -- Check if we have an existing substitution for the LHS; if so, recurse - | Just ty1' <- lookupFamEnv (um_fam_env substs) tc1 tys1 + -- But not under a forall; see (ATF3) in Note [Apartness and type families] + -- Hence the RnEnv2 is empty + | not under_forall + , Just ty1' <- lookupFamEnv (um_fam_env substs) tc1 tys1 = if | um_unif env -> unify_ty env ty1' ty2 kco -- Below here we are matching -- The return () case deals with: @@ -1917,11 +1931,19 @@ uVarOrFam env ty1 ty2 kco | otherwise -> maybeApart MARTypeFamily -- Check for equality F tys1 ~ F tys2 + -- Very important that this can happen under a forall, so that we + -- successfully match (forall a. F a) ~ (forall b. F b) See (ATF9-2) | Just (tc2, tys2) <- isSatTyFamApp ty2 , tc1 == tc2 = go_fam_fam substs tc1 tys1 tys2 kco + -- If we are under a forall, just give up + -- see (ATF3) and (ATF5) in Note [Apartness and type families] + | under_forall + = maybeApart MARTypeFamily + -- Now check if we can bind the (F tys) to the RHS + -- Again, not under a forall; see (ATF3) -- This can happen even when matching: see (ATF7) | BindMe <- um_bind_fam_fun env tc1 tys1 rhs = if uOccursCheck substs emptyVarSet lhs rhs @@ -1935,6 +1957,7 @@ uVarOrFam env ty1 ty2 kco -- Maybe um_bind_fam_fun is False of (F a b) but true of (G c d e) -- NB: a type family can appear on the template when matching -- see (ATF6) in Note [Apartness and type families] + -- Only worth doing this if we are no under a forall | um_unif env , NotSwapped <- swapped , Just lhs2 <- canEqLHS_maybe ty2 @@ -1949,7 +1972,6 @@ uVarOrFam env ty1 ty2 kco ----------------------------- -- go_fam_fam: LHS and RHS are both saturated type-family applications, -- for the same type-family F - -- Precondition: um_foralls is empty go_fam_fam substs tc tys1 tys2 kco -- Decompose (F tys1 ~ F tys2): (ATF9) -- Use injectivity information of F: (ATF10) @@ -1957,7 +1979,7 @@ uVarOrFam env ty1 ty2 kco = do { bind_fam_if_poss -- (ATF11) ; unify_tys env inj_tys1 inj_tys2 -- (ATF10) ; unless (um_inj_tf env) $ -- (ATF12) - don'tBeSoSure MARTypeFamily $ -- (ATF9) + don'tBeSoSure MARTypeFamily $ -- (ATF9-1) unify_tys env noninj_tys1 noninj_tys2 } where inj = case tyConInjectivityInfo tc of @@ -1970,6 +1992,8 @@ uVarOrFam env ty1 ty2 kco bind_fam_if_poss | not (um_unif env) -- Not when matching (ATF11-1) = return () + | under_forall -- Not under a forall (ATF3) + = return () | BindMe <- um_bind_fam_fun env tc tys1 rhs1 = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys1) rhs1) $ extendFamEnv tc tys1 rhs1 ===================================== testsuite/tests/typecheck/should_compile/T26457.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module T26457 where + +import Data.Kind +import Data.Proxy + +type family FC (be :: Type) (entity :: Type) :: Constraint + +class Database be where + fun :: Proxy be -> (forall tbl. FC be tbl => Proxy tbl -> ()) -> () + default fun :: Proxy be -> (forall tbl. FC be tbl => Proxy tbl -> ()) -> () + fun _ _ = undefined ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -952,4 +952,4 @@ test('T26346', normal, compile, ['']) test('T26358', expect_broken(26358), compile, ['']) test('T26345', normal, compile, ['']) test('T26376', normal, compile, ['']) - +test('T26457', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/771aaa748c4e0118baa8dd1af46a9ed… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/771aaa748c4e0118baa8dd1af46a9ed… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26435] compiler: Warn when -finfo-table-map is used with -fllvm
by Zubin (＠wz1000) 30 Sep '25

30 Sep '25

Zubin pushed to branch wip/26435 at Glasgow Haskell Compiler / GHC Commits: 6277d0e1 by Zubin Duggal at 2025-09-30T17:34:41+05:30 compiler: Warn when -finfo-table-map is used with -fllvm These are currently not supported together. Fixes #26435 - - - - - 5 changed files: - compiler/GHC/Driver/Session.hs - docs/users_guide/debug-info.rst - + testsuite/tests/driver/T26435.hs - + testsuite/tests/driver/T26435.stderr - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3784,6 +3784,11 @@ makeDynFlagsConsistent dflags hostFullWays in dflags_c + | gopt Opt_InfoTableMap dflags + , LlvmCodeOutput <- backendCodeOutput (backend dflags) + = loop (gopt_unset dflags Opt_InfoTableMap) + "-finfo-table-map is incompatible with -fllvm" + | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,6 +370,11 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. + .. note:: + This flag is incompatible with :ghc-flag:`-fllvm`. If both flags are + enabled, GHC will emit a warning and :ghc-flag:`-finfo-table-map` will + have no effect. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite a lot, depending on how big your project is. For compiling a project the size of GHC the overhead was about 200 megabytes. ===================================== testsuite/tests/driver/T26435.hs ===================================== @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "hello world" \ No newline at end of file ===================================== testsuite/tests/driver/T26435.stderr ===================================== @@ -0,0 +1,3 @@ +when making flags consistent: warning: [GHC-74335] [-Winconsistent-flags (in -Wdefault)] + -finfo-table-map is incompatible with -fllvm + ===================================== testsuite/tests/driver/all.T ===================================== @@ -331,3 +331,4 @@ test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) test('T25382', normal, makefile_test, []) test('T26018', req_c, makefile_test, []) +test('T26435', normal, compile, ['-finfo-table-map -fllvm']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6277d0e19c3487d2e538f2685b18cfb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6277d0e19c3487d2e538f2685b18cfb… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26435] compiler: Warn when -finfo-table-map is used with -fllvm
by Zubin (＠wz1000) 30 Sep '25

30 Sep '25

Zubin pushed to branch wip/26435 at Glasgow Haskell Compiler / GHC Commits: 1df941a0 by Zubin Duggal at 2025-09-30T17:34:22+05:30 compiler: Warn when -finfo-table-map is used with -fllvm These are currently not supported together. Fixes #26435 - - - - - 4 changed files: - compiler/GHC/Driver/Session.hs - docs/users_guide/debug-info.rst - + testsuite/tests/driver/T26435.stderr - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3784,6 +3784,11 @@ makeDynFlagsConsistent dflags hostFullWays in dflags_c + | gopt Opt_InfoTableMap dflags + , LlvmCodeOutput <- backendCodeOutput (backend dflags) + = loop (gopt_unset dflags Opt_InfoTableMap) + "-finfo-table-map is incompatible with -fllvm" + | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,6 +370,11 @@ to a source location. This lookup table is generated by using the ``-finfo-table also want more precise information about constructor info tables then you should also use :ghc-flag:`-fdistinct-constructor-tables`. + .. note:: + This flag is incompatible with :ghc-flag:`-fllvm`. If both flags are + enabled, GHC will emit a warning and :ghc-flag:`-finfo-table-map` will + have no effect. + The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite a lot, depending on how big your project is. For compiling a project the size of GHC the overhead was about 200 megabytes. ===================================== testsuite/tests/driver/T26435.stderr ===================================== @@ -0,0 +1,3 @@ +when making flags consistent: warning: [GHC-74335] [-Winconsistent-flags (in -Wdefault)] + -finfo-table-map is incompatible with -fllvm + ===================================== testsuite/tests/driver/all.T ===================================== @@ -331,3 +331,4 @@ test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) test('T25382', normal, makefile_test, []) test('T26018', req_c, makefile_test, []) +test('T26435', normal, compile, ['-finfo-table-map -fllvm']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1df941a0d8fd405ad0d080097f04ffb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1df941a0d8fd405ad0d080097f04ffb… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26435
by Zubin (＠wz1000) 30 Sep '25

30 Sep '25

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

1 0

[Git][ghc/ghc][wip/26432] ghc api: Introduce variants of setSessionDynFlags and setUnitDynFlags that allow reloading
by Zubin (＠wz1000) 30 Sep '25

30 Sep '25

Zubin pushed to branch wip/26432 at Glasgow Haskell Compiler / GHC Commits: 8f8ef3e7 by Zubin Duggal at 2025-09-30T17:04:10+05:30 ghc api: Introduce variants of setSessionDynFlags and setUnitDynFlags that allow reloading the package db. These can be used if you change the package db flags in the DynFlags. Fixes #26423 - - - - - 1 changed file: - compiler/GHC.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -35,8 +35,11 @@ module GHC ( parseDynamicFlags, parseTargetFiles, getSessionDynFlags, setTopSessionDynFlags, + ReloadPkgDb(..), setSessionDynFlags, + setSessionDynFlagsWithPkgDb, setUnitDynFlags, + setUnitDynFlagsWithPkgDb, getProgramDynFlags, setProgramDynFlags, setProgramHUG, setProgramHUG_, getInteractiveDynFlags, setInteractiveDynFlags, @@ -633,18 +636,35 @@ initGhcMonad mb_top_dir = setSession =<< liftIO ( do -- -- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags' -- retrieves the program @DynFlags@ (for backwards compatibility). +-- +-- Neither of these functions --- This is a compatibility function which sets dynflags for the top session --- as well as the unit. +-- | This is a compatibility function which sets dynflags for the top session +-- as well as the unit. Only works if there is exactly one unit. +-- +-- Note that this does not reload the package db if it is already loaded. +-- This means that if you change package flags or the location of the package +-- db before calling this function, these changes may not take effect. +-- See 'setSessionDynFlagsWithPkgDb' to configure this behavior and force +-- reloading of the package database. setSessionDynFlags :: (HasCallStack, GhcMonad m) => DynFlags -> m () -setSessionDynFlags dflags0 = do +setSessionDynFlags = setSessionDynFlagsWithPkgDb UseCachedPkgDb + + +-- | This is a compatibility function which sets dynflags for the top session +-- as well as the unit. Only works if there is exactly one unit. +-- +-- The 'ReloadPkgDb' argument controls if the pacakge database is reload. +-- Set it to 'ReloadPkgDb' if you change package flags, otherwise 'UseCachedPkgDb'. +setSessionDynFlagsWithPkgDb :: (HasCallStack, GhcMonad m) => ReloadPkgDb -> DynFlags -> m () +setSessionDynFlagsWithPkgDb use_cache dflags0 = do hsc_env <- getSession logger <- getLogger dflags <- checkNewDynFlags logger dflags0 let all_uids = hsc_all_home_unit_ids hsc_env case S.toList all_uids of [uid] -> do - setUnitDynFlagsNoCheck uid dflags + setUnitDynFlagsNoCheck use_cache uid dflags modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags)) dflags' <- getDynFlags setTopSessionDynFlags dflags' @@ -652,19 +672,39 @@ setSessionDynFlags dflags0 = do _ -> panic "setSessionDynFlags can only be used with a single home unit" +-- | Set the dynflags for a unit. +-- +-- Note that this does not reload the package db if it is already loaded. +-- This means that if you change package flags or the location of the package +-- db before calling this function, these changes may not take effect. +-- See 'setUnitDynFlagsWithPkgDb' to configure this behavior and force +-- reloading of the package database. setUnitDynFlags :: GhcMonad m => UnitId -> DynFlags -> m () -setUnitDynFlags uid dflags0 = do +setUnitDynFlags = setUnitDynFlagsWithPkgDb UseCachedPkgDb + +-- | Set the dynflags for a unit. +-- +-- The 'ReloadPkgDb' argument controls if the pacakge database is reload. +-- Set it to 'UseCachedPkgDb' if you change package flags. +setUnitDynFlagsWithPkgDb :: GhcMonad m => ReloadPkgDb -> UnitId -> DynFlags -> m () +setUnitDynFlagsWithPkgDb use_cache uid dflags0 = do logger <- getLogger dflags1 <- checkNewDynFlags logger dflags0 - setUnitDynFlagsNoCheck uid dflags1 + setUnitDynFlagsNoCheck use_cache uid dflags1 + +data ReloadPkgDb + = UseCachedPkgDb -- ^ Use the pkg db cached in the hsc env if it exists + | ReloadPkgDb -- ^ Reload the pkg db based on the dynflags -setUnitDynFlagsNoCheck :: GhcMonad m => UnitId -> DynFlags -> m () -setUnitDynFlagsNoCheck uid dflags1 = do +setUnitDynFlagsNoCheck :: GhcMonad m => ReloadPkgDb -> UnitId -> DynFlags -> m () +setUnitDynFlagsNoCheck use_cache uid dflags1 = do logger <- getLogger hsc_env <- getSession let old_hue = ue_findHomeUnitEnv uid (hsc_unit_env hsc_env) - let cached_unit_dbs = homeUnitEnv_unit_dbs old_hue + let cached_unit_dbs = case use_cache of + UseCachedPkgDb -> homeUnitEnv_unit_dbs old_hue + ReloadPkgDb -> Nothing (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 cached_unit_dbs (hsc_all_home_unit_ids hsc_env) updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f8ef3e7a1b039f09cbbc9b77a82120… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f8ef3e7a1b039f09cbbc9b77a82120… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/26432
by Zubin (＠wz1000) 30 Sep '25

30 Sep '25

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

1 0