[Git][ghc/ghc][master] 2 commits: Revert "Add necessary flag for js linking"
by Marge Bot (＠marge-bot) 26 Sep '25
by Marge Bot (＠marge-bot) 26 Sep '25
26 Sep '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c1cab0c3 by Sylvain Henry at 2025-09-26T10:36:30-04:00
Revert "Add necessary flag for js linking"
This reverts commit 84f68e2231b2eddb2e1dc4e90af394ef0f2e803f.
This commit didn't have the expected effect. See discussion in #26290.
Instead we export HEAP8 and HEAPU8 from rts/js/mem.js
- - - - -
0a434a80 by Sylvain Henry at 2025-09-26T10:36:30-04:00
JS: export HEAPU8 (#26290)
This is now required by newer Emscripten versions.
- - - - -
4 changed files:
- m4/fptools_set_c_ld_flags.m4
- rts/js/mem.js
- testsuite/driver/testlib.py
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
Changes:
=====================================
m4/fptools_set_c_ld_flags.m4
=====================================
@@ -109,9 +109,6 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
$2="$$2 -mcmodel=medium"
;;
- javascript*)
- $3="$$3 -sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8"
-
esac
AC_MSG_RESULT([done])
=====================================
rts/js/mem.js
=====================================
@@ -1,5 +1,5 @@
//#OPTIONS:CPP
-//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8
+//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8,HEAPU8
// #define GHCJS_TRACE_META 1
=====================================
testsuite/driver/testlib.py
=====================================
@@ -3005,7 +3005,7 @@ def normalise_errmsg(s: str) -> str:
# Emscripten displays cache info and old emcc doesn't support EMCC_LOGGING=0
s = re.sub('cache:INFO: .*\n', '', s)
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
- s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
+ s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
return s
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -324,10 +324,6 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do
ArchOS ArchPPC OSAIX ->
-- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`.
return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"])
- ArchOS ArchJavaScript OSGhcjs ->
- -- Since https://github.com/emscripten-core/emscripten/blob/main/ChangeLog.md#407---…
- -- the emcc linker does not export the HEAP8 memory view which is used by the js RTS by default anymore.
- return $ ccLink2 & _prgFlags %++ "-sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8"
_ ->
return ccLink2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bf5b309e9d162f187e96562e6432d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bf5b309e9d162f187e96562e6432d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26166] rts: Avoid static symbol references to ghc-internal
by Ben Gamari (＠bgamari) 26 Sep '25
by Ben Gamari (＠bgamari) 26 Sep '25
26 Sep '25
Ben Gamari pushed to branch wip/T26166 at Glasgow Haskell Compiler / GHC
Commits:
25f24794 by Ben Gamari at 2025-09-26T10:36:20-04:00
rts: Avoid static symbol references to ghc-internal
- - - - -
22 changed files:
- compiler/GHC/HsToCore/Foreign/C.hs
- + libraries/ghc-internal/cbits/RtsIface.c
- libraries/ghc-internal/ghc-internal.cabal.in
- + libraries/ghc-internal/include/RtsIfaceSymbols.h
- rts/BuiltinClosures.c
- rts/Compact.cmm
- rts/ContinuationOps.cmm
- rts/Exception.cmm
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/RtsAPI.c
- rts/RtsStartup.c
- + rts/RtsToHsIface.c
- rts/Schedule.c
- rts/StgStdThunks.cmm
- rts/include/Rts.h
- rts/include/RtsAPI.h
- + rts/include/rts/RtsToHsIface.h
- rts/posix/Signals.c
- rts/rts.cabal
- rts/wasm/JSFFI.c
- utils/deriveConstants/Main.hs
Changes:
=====================================
compiler/GHC/HsToCore/Foreign/C.hs
=====================================
@@ -517,8 +517,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
text "rts_apply" <> parens (
cap
<> (if is_IO_res_ty
- then text "runIO_closure"
- else text "runNonIO_closure")
+ then text "ghc_hs_iface->runIO_closure"
+ else text "ghc_hs_iface->runNonIO_closure")
<> comma
<> expr_to_run
) <+> comma
=====================================
libraries/ghc-internal/cbits/RtsIface.c
=====================================
@@ -0,0 +1,42 @@
+/*
+ * (c) The GHC Team, 2025-2026
+ *
+ * RTS/ghc-internal interface
+ *
+ * See Note [RTS/ghc-internal interface].
+ */
+
+#include "Rts.h"
+
+void init_ghc_hs_iface(void) __attribute__((constructor));
+
+#define CLOSURE(module, symbol) \
+ extern StgClosure ghczminternal_##module##_##symbol;
+
+#define UNDEF_CLOSURE(module, symbol)
+
+#define INFO_TBL(module, symbol) \
+ extern StgInfoTable ghczminternal_##module##_##symbol;
+
+#include "RtsIfaceSymbols.h"
+
+#undef CLOSURE
+#undef INFO_TBL
+
+#define CLOSURE(module, symbol) \
+ .symbol = &ghczminternal_##module##_##symbol,
+
+#define UNDEF_CLOSURE(module, symbol) \
+ .symbol = NULL,
+
+#define INFO_TBL(module, symbol) \
+ .symbol = &ghczminternal_##module##_##symbol,
+
+HsIface the_ghc_hs_iface = {
+#include "RtsIfaceSymbols.h"
+};
+
+void init_ghc_hs_iface(void)
+{
+ ghc_hs_iface = &the_ghc_hs_iface;
+}
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -43,6 +43,7 @@ extra-source-files:
include/winio_structs.h
include/WordSize.h
include/HsIntegerGmp.h.in
+ include/RtsIfaceSymbols.h
install-sh
source-repository head
@@ -457,6 +458,7 @@ Library
cbits/vectorQuotRem.c
cbits/word2float.c
cbits/Stack_c.c
+ cbits/RtsIface.c
cmm-sources:
cbits/StackCloningDecoding.cmm
=====================================
libraries/ghc-internal/include/RtsIfaceSymbols.h
=====================================
@@ -0,0 +1,59 @@
+// See Note [RTS/ghc-internal interface].
+
+#if defined(mingw32_HOST_OS)
+CLOSURE(GHCziInternalziEventziWindows, processRemoteCompletion_closure)
+#else
+UNDEF_CLOSURE(GHCziInternalziEventziWindows, processRemoteCompletion_closure)
+#endif
+CLOSURE(GHCziInternalziTopHandler, runIO_closure)
+CLOSURE(GHCziInternalziTopHandler, runNonIO_closure)
+CLOSURE(GHCziInternalziTuple, Z0T_closure)
+CLOSURE(GHCziInternalziTypes, True_closure)
+CLOSURE(GHCziInternalziTypes, False_closure)
+CLOSURE(GHCziInternalziPack, unpackCString_closure)
+CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure)
+CLOSURE(GHCziInternalziIOziException, stackOverflow_closure)
+CLOSURE(GHCziInternalziIOziException, heapOverflow_closure)
+CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure)
+CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)
+CLOSURE(GHCziInternalziIOziException, cannotCompactFunction_closure)
+CLOSURE(GHCziInternalziIOziException, cannotCompactPinned_closure)
+CLOSURE(GHCziInternalziIOziException, cannotCompactMutable_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nonTermination_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, nestedAtomically_closure)
+CLOSURE(GHCziInternalziControlziExceptionziBase, noMatchingContinuationPrompt_closure)
+CLOSURE(GHCziInternalziEventziThread, blockedOnBadFD_closure)
+CLOSURE(GHCziInternalziConcziSync, runSparks_closure)
+CLOSURE(GHCziInternalziConcziIO, ensureIOManagerIsRunning_closure)
+CLOSURE(GHCziInternalziConcziIO, interruptIOManager_closure)
+CLOSURE(GHCziInternalziConcziIO, ioManagerCapabilitiesChanged_closure)
+CLOSURE(GHCziInternalziConcziSignal, runHandlersPtr_closure)
+CLOSURE(GHCziInternalziTopHandler, flushStdHandles_closure)
+CLOSURE(GHCziInternalziTopHandler, runMainIO_closure)
+INFO_TBL(GHCziInternalziTypes, Czh_con_info)
+INFO_TBL(GHCziInternalziTypes, Izh_con_info)
+INFO_TBL(GHCziInternalziTypes, Fzh_con_info)
+INFO_TBL(GHCziInternalziTypes, Dzh_con_info)
+INFO_TBL(GHCziInternalziTypes, Wzh_con_info)
+CLOSURE(GHCziInternalziPrimziPanic, absentSumFieldError_closure)
+CLOSURE(GHCziInternalziAllocationLimitHandler, runAllocationLimitHandler_closure)
+INFO_TBL(GHCziInternalziPtr, Ptr_con_info)
+INFO_TBL(GHCziInternalziPtr, FunPtr_con_info)
+INFO_TBL(GHCziInternalziInt, I8zh_con_info)
+INFO_TBL(GHCziInternalziInt, I16zh_con_info)
+INFO_TBL(GHCziInternalziInt, I32zh_con_info)
+INFO_TBL(GHCziInternalziInt, I64zh_con_info)
+INFO_TBL(GHCziInternalziWord, W8zh_con_info)
+INFO_TBL(GHCziInternalziWord, W16zh_con_info)
+INFO_TBL(GHCziInternalziWord, W32zh_con_info)
+INFO_TBL(GHCziInternalziWord, W64zh_con_info)
+INFO_TBL(GHCziInternalziStable, StablePtr_con_info)
+CLOSURE(GHCziInternalziStackziCloneStack, StackSnapshot_closure)
+CLOSURE(GHCziInternalziExceptionziType, divZZeroException_closure)
+CLOSURE(GHCziInternalziExceptionziType, underflowException_closure)
+CLOSURE(GHCziInternalziExceptionziType, overflowException_closure)
+CLOSURE(GHCziInternalziCString, unpackCStringzh_closure)
+INFO_TBL(GHCziInternalziCString, unpackCStringzh_info)
+INFO_TBL(GHCziInternalziCString, unpackCStringUtf8zh_info)
+
=====================================
rts/BuiltinClosures.c
=====================================
@@ -1,5 +1,4 @@
#include "Rts.h"
-#include "Prelude.h"
#include "BuiltinClosures.h"
/*
@@ -17,14 +16,14 @@ void initBuiltinClosures() {
// INTLIKE closures
for (int i = MIN_INTLIKE; i < MAX_INTLIKE; i++) {
StgIntCharlikeClosure *c = &stg_INTLIKE_closure[i];
- SET_HDR((StgClosure* ) c, Izh_con_info, CCS_SYSTEM_OR_NULL);
+ SET_HDR((StgClosure* ) c, ghc_hs_iface->Izh_con_info, CCS_SYSTEM_OR_NULL);
c->data = MIN_INTLIKE + i;
}
// CHARLIKE closures
for (int i = MIN_CHARLIKE; i < MAX_CHARLIKE; i++) {
StgIntCharlikeClosure *c = &stg_CHARLIKE_closure[i];
- SET_HDR((StgClosure* ) c, Czh_con_info, CCS_SYSTEM_OR_NULL);
+ SET_HDR((StgClosure* ) c, ghc_hs_iface->Czh_con_info, CCS_SYSTEM_OR_NULL);
c->data = MIN_CHARLIKE + i;
}
}
=====================================
rts/Compact.cmm
=====================================
@@ -10,9 +10,6 @@
#include "Cmm.h"
#include "sm/ShouldCompact.h"
-import CLOSURE ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure;
-import CLOSURE ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure;
-import CLOSURE ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure;
#if !defined(UnregisterisedCompiler)
import CLOSURE g0;
import CLOSURE large_alloc_lim;
@@ -124,7 +121,7 @@ eval:
SMALL_MUT_ARR_PTRS_CLEAN,
SMALL_MUT_ARR_PTRS_DIRTY,
COMPACT_NFDATA: {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure);
+ jump stg_raisezh(HsIface_cannotCompactMutable_closure(W_[ghc_hs_iface]));
}
// We shouldn't see any functions, if this data structure was NFData.
@@ -139,7 +136,7 @@ eval:
BCO,
PAP,
CONTINUATION: {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure);
+ jump stg_raisezh(HsIface_cannotCompactFunction_closure(W_[ghc_hs_iface]));
}
case ARR_WORDS: {
@@ -147,7 +144,7 @@ eval:
(should) = ccall shouldCompact(compact "ptr", p "ptr");
if (should == SHOULDCOMPACT_IN_CNF) { P_[pp] = p; return(); }
if (should == SHOULDCOMPACT_PINNED) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure);
+ jump stg_raisezh(HsIface_cannotCompactPinned_closure(W_[ghc_hs_iface]));
}
CHECK_HASH();
=====================================
rts/ContinuationOps.cmm
=====================================
@@ -12,7 +12,6 @@
#include "Cmm.h"
-import CLOSURE ghczminternal_GHCziInternalziControlziExceptionziBase_noMatchingContinuationPrompt_closure;
#if !defined(UnregisterisedCompiler)
import CLOSURE ALLOC_RTS_ctr;
import CLOSURE ALLOC_RTS_tot;
@@ -104,7 +103,7 @@ stg_control0zh_ll // explicit stack
// see Note [When capturing the continuation fails] in Continuation.c
if (cont == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziControlziExceptionziBase_noMatchingContinuationPrompt_closure);
+ jump stg_raisezh(HsIface_noMatchingContinuationPrompt_closure(W_[ghc_hs_iface]));
}
W_ apply_mask_frame;
=====================================
rts/Exception.cmm
=====================================
@@ -13,10 +13,6 @@
#include "Cmm.h"
#include "RaiseAsync.h"
-import CLOSURE ghczminternal_GHCziInternalziTypes_True_closure;
-import CLOSURE ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure;
-import CLOSURE ghczminternal_GHCziInternalziExceptionziType_underflowException_closure;
-import CLOSURE ghczminternal_GHCziInternalziExceptionziType_overflowException_closure;
#if !defined(UnregisterisedCompiler)
import CLOSURE CATCHF_PUSHED_ctr;
import CLOSURE RtsFlags;
@@ -539,7 +535,7 @@ retry_pop_stack:
Sp(10) = exception;
Sp(9) = stg_raise_ret_info;
Sp(8) = exception;
- Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(7) = HsIface_True_closure(W_[ghc_hs_iface]); // True <=> an exception
Sp(6) = stg_ap_ppv_info;
Sp(5) = 0;
Sp(4) = stg_ap_n_info;
@@ -650,17 +646,17 @@ stg_raiseIOzh (P_ exception)
stg_raiseDivZZerozh ()
{
- jump stg_raisezh(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure);
+ jump stg_raisezh(HsIface_divZZeroException_closure(W_[ghc_hs_iface]));
}
stg_raiseUnderflowzh ()
{
- jump stg_raisezh(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure);
+ jump stg_raisezh(HsIface_underflowException_closure(W_[ghc_hs_iface]));
}
stg_raiseOverflowzh ()
{
- jump stg_raisezh(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure);
+ jump stg_raisezh(HsIface_overflowException_closure(W_[ghc_hs_iface]));
}
/* The FFI doesn't support variadic C functions so we can't directly expose
=====================================
rts/Prelude.h
=====================================
@@ -19,126 +19,69 @@
#define PRELUDE_CLOSURE(i) extern StgClosure (i)
#endif
-/* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure);
/* Define canonical names so we can abstract away from the actual
* modules these names are defined in.
*/
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziTuple_Z0T_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziTypes_True_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziTypes_False_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziPack_unpackCString_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziPack_unpackCStringUtf8_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziWeak_runFinalizzerBatch_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure);
-
#if defined(IN_STG_CODE)
extern W_ ZCMain_main_closure[];
#else
extern StgClosure ZCMain_main_closure;
#endif
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure);
-
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziConcziSync_runSparks_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure);
-#if defined(mingw32_HOST_OS)
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure);
-#endif
-
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure);
-
-PRELUDE_INFO(ghczminternal_GHCziInternalziCString_unpackCStringzh_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziTypes_Czh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziTypes_Izh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziTypes_Fzh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziTypes_Dzh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziTypes_Wzh_con_info);
-
-PRELUDE_INFO(ghczminternal_GHCziInternalziPtr_Ptr_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziPtr_FunPtr_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziInt_I8zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziInt_I16zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziInt_I32zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziInt_I64zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W8zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W16zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W32zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W64zh_con_info);
-PRELUDE_INFO(ghczminternal_GHCziInternalziStable_StablePtr_con_info);
-
-#define Unit_closure (&(ghczminternal_GHCziInternalziTuple_Z0T_closure))
-#define True_closure (&(ghczminternal_GHCziInternalziTypes_True_closure))
-#define False_closure (&(ghczminternal_GHCziInternalziTypes_False_closure))
-#define unpackCString_closure (&(ghczminternal_GHCziInternalziPack_unpackCString_closure))
-#define runFinalizerBatch_closure (&(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure))
+#define Unit_closure ghc_hs_iface->Z0T_closure
+#define True_closure ghc_hs_iface->True_closure
+#define False_closure ghc_hs_iface->False_closure
+#define unpackCString_closure ghc_hs_iface->unpackCString_closure
+#define runFinalizerBatch_closure ghc_hs_iface->runFinalizzerBatch_closure
#define mainIO_closure (&ZCMain_main_closure)
-#define runSparks_closure (&(ghczminternal_GHCziInternalziConcziSync_runSparks_closure))
-#define ensureIOManagerIsRunning_closure (&(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure))
-#define interruptIOManager_closure (&(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure))
-#define ioManagerCapabilitiesChanged_closure (&(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure))
-#define runHandlersPtr_closure (&(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure))
+#define runSparks_closure ghc_hs_iface->runSparks_closure
+#define ensureIOManagerIsRunning_closure ghc_hs_iface->ensureIOManagerIsRunning_closure
+#define interruptIOManager_closure ghc_hs_iface->interruptIOManager_closure
+#define ioManagerCapabilitiesChanged_closure ghc_hs_iface->ioManagerCapabilitiesChanged_closure
+#define runHandlersPtr_closure ghc_hs_iface->runHandlersPtr_closure
#if defined(mingw32_HOST_OS)
-#define processRemoteCompletion_closure (&(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure))
+#define processRemoteCompletion_closure ghc_hs_iface->processRemoteCompletion_closure
#endif
-#define runAllocationLimitHandler_closure (&(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure))
-
-#define flushStdHandles_closure (&(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure))
-#define runMainIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure))
-
-#define stackOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure))
-#define heapOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure))
-#define allocationLimitExceeded_closure (&(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure))
-#define blockedIndefinitelyOnMVar_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure))
-#define blockedIndefinitelyOnSTM_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure))
-#define cannotCompactFunction_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure))
-#define cannotCompactPinned_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure))
-#define cannotCompactMutable_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure))
-#define nonTermination_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure))
-#define nestedAtomically_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure))
-#define absentSumFieldError_closure (&(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure))
-#define underflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure))
-#define overflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure))
-#define divZeroException_closure (&(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure))
-
-#define blockedOnBadFD_closure (&(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure))
-
-#define Czh_con_info (&(ghczminternal_GHCziInternalziTypes_Czh_con_info))
-#define Izh_con_info (&(ghczminternal_GHCziInternalziTypes_Izh_con_info))
-#define Fzh_con_info (&(ghczminternal_GHCziInternalziTypes_Fzh_con_info))
-#define Dzh_con_info (&(ghczminternal_GHCziInternalziTypes_Dzh_con_info))
-#define Wzh_con_info (&(ghczminternal_GHCziInternalziTypes_Wzh_con_info))
-#define W8zh_con_info (&(ghczminternal_GHCziInternalziWord_W8zh_con_info))
-#define W16zh_con_info (&(ghczminternal_GHCziInternalziWord_W16zh_con_info))
-#define W32zh_con_info (&(ghczminternal_GHCziInternalziWord_W32zh_con_info))
-#define W64zh_con_info (&(ghczminternal_GHCziInternalziWord_W64zh_con_info))
-#define I8zh_con_info (&(ghczminternal_GHCziInternalziInt_I8zh_con_info))
-#define I16zh_con_info (&(ghczminternal_GHCziInternalziInt_I16zh_con_info))
-#define I32zh_con_info (&(ghczminternal_GHCziInternalziInt_I32zh_con_info))
-#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
-#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
-#define Ptr_con_info (&(ghczminternal_GHCziInternalziPtr_Ptr_con_info))
-#define FunPtr_con_info (&(ghczminternal_GHCziInternalziPtr_FunPtr_con_info))
-#define StablePtr_static_info (&(ghczminternal_GHCziInternalziStable_StablePtr_static_info))
-#define StablePtr_con_info (&(ghczminternal_GHCziInternalziStable_StablePtr_con_info))
+#define runAllocationLimitHandler_closure ghc_hs_iface->runAllocationLimitHandler_closure
+
+#define flushStdHandles_closure ghc_hs_iface->flushStdHandles_closure
+#define runMainIO_closure ghc_hs_iface->runMainIO_closure
+
+#define stackOverflow_closure ghc_hs_iface->stackOverflow_closure
+#define heapOverflow_closure ghc_hs_iface->heapOverflow_closure
+#define allocationLimitExceeded_closure ghc_hs_iface->allocationLimitExceeded_closure
+#define blockedIndefinitelyOnMVar_closure ghc_hs_iface->blockedIndefinitelyOnMVar_closure
+#define blockedIndefinitelyOnSTM_closure ghc_hs_iface->blockedIndefinitelyOnSTM_closure
+#define cannotCompactFunction_closure ghc_hs_iface->cannotCompactFunction_closure
+#define cannotCompactPinned_closure ghc_hs_iface->cannotCompactPinned_closure
+#define cannotCompactMutable_closure ghc_hs_iface->cannotCompactMutable_closure
+#define nonTermination_closure ghc_hs_iface->nonTermination_closure
+#define nestedAtomically_closure ghc_hs_iface->nestedAtomically_closure
+#define absentSumFieldError_closure ghc_hs_iface->absentSumFieldError_closure
+#define underflowException_closure ghc_hs_iface->underflowException_closure
+#define overflowException_closure ghc_hs_iface->overflowException_closure
+#define divZeroException_closure ghc_hs_iface->divZZeroException_closure
+
+#define blockedOnBadFD_closure ghc_hs_iface->blockedOnBadFD_closure
+
+#define Czh_con_info ghc_hs_iface->Czh_con_info
+#define Izh_con_info ghc_hs_iface->Izh_con_info
+#define Fzh_con_info ghc_hs_iface->Fzh_con_info
+#define Dzh_con_info ghc_hs_iface->Dzh_con_info
+#define Wzh_con_info ghc_hs_iface->Wzh_con_info
+#define W8zh_con_info ghc_hs_iface->W8zh_con_info
+#define W16zh_con_info ghc_hs_iface->W16zh_con_info
+#define W32zh_con_info ghc_hs_iface->W32zh_con_info
+#define W64zh_con_info ghc_hs_iface->W64zh_con_info
+#define I8zh_con_info ghc_hs_iface->I8zh_con_info
+#define I16zh_con_info ghc_hs_iface->I16zh_con_info
+#define I32zh_con_info ghc_hs_iface->I32zh_con_info
+#define I64zh_con_info ghc_hs_iface->I64zh_con_info
+#define I64zh_con_info ghc_hs_iface->I64zh_con_info
+#define Ptr_con_info ghc_hs_iface->Ptr_con_info
+#define FunPtr_con_info ghc_hs_iface->FunPtr_con_info
+#define StablePtr_static_info ghc_hs_iface->StablePtr_static_info
+#define StablePtr_con_info ghc_hs_iface->StablePtr_con_info
=====================================
rts/PrimOps.cmm
=====================================
@@ -25,12 +25,8 @@
#include "MachDeps.h"
#include "SMPClosureOps.h"
-import CLOSURE ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure;
-import CLOSURE ghczminternal_GHCziInternalziIOziException_heapOverflow_closure;
-import CLOSURE ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure;
import AcquireSRWLockExclusive;
import ReleaseSRWLockExclusive;
-import CLOSURE ghczminternal_GHCziInternalziTypes_False_closure;
#if defined(PROFILING)
import CLOSURE CCS_MAIN;
#endif
@@ -118,7 +114,7 @@ stg_newByteArrayzh ( W_ n )
("ptr" p) = ccall allocateArrBytes(MyCapability() "ptr", n, CCCS);
if (p == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
return (p);
}
@@ -135,7 +131,7 @@ stg_newPinnedByteArrayzh ( W_ n )
("ptr" p) = ccall allocateArrBytesPinned(MyCapability() "ptr", n,
BA_ALIGN, CCCS);
if (p == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
return (p);
}
@@ -149,7 +145,7 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
("ptr" p) = ccall allocateArrBytesPinned(MyCapability() "ptr", n,
alignment, CCCS);
if (p == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
return (p);
}
@@ -364,7 +360,7 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
("ptr" arr) = ccall allocateMutArrPtrs(MyCapability() "ptr", n, CCCS);
if (arr == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
// Initialise all elements of the array with the value init
@@ -474,7 +470,7 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
("ptr" arr) = ccall allocateSmallMutArrPtrs(MyCapability() "ptr", n, CCCS);
if (arr == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
// Initialise all elements of the array with the value init
@@ -1090,7 +1086,7 @@ stg_listThreadszh ()
("ptr" arr) = ccall listThreads(MyCapability() "ptr");
if (arr == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
return (arr);
@@ -1360,7 +1356,7 @@ stg_atomicallyzh (P_ stm)
/* Nested transactions are not allowed; raise an exception */
if (old_trec != NO_TREC) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure);
+ jump stg_raisezh(HsIface_nestedAtomically_closure(W_[ghc_hs_iface]));
}
code = stm;
@@ -2231,7 +2227,7 @@ stg_unpackClosurezh ( P_ closure )
dat_arr_sz = SIZEOF_StgArrBytes + WDS(len);
("ptr" dat_arr) = ccall allocateMightFail(MyCapability() "ptr", BYTES_TO_WDS(dat_arr_sz));
if (dat_arr == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
TICK_ALLOC_PRIM(SIZEOF_StgArrBytes, WDS(len), 0);
@@ -2251,7 +2247,7 @@ for:
("ptr" ptrArray) = foreign "C" heap_view_closurePtrs(MyCapability() "ptr", clos "ptr");
if (ptrArray == NULL) (likely: False) {
- jump stg_raisezh(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure);
+ jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
return (info, dat_arr, ptrArray);
@@ -2518,13 +2514,13 @@ stg_getSparkzh ()
W_ spark;
#if !defined(THREADED_RTS)
- return (0,ghczminternal_GHCziInternalziTypes_False_closure);
+ return (0,HsIface_False_closure(W_[ghc_hs_iface]));
#else
("ptr" spark) = ccall findSpark(MyCapability() "ptr");
if (spark != 0) {
return (1,spark);
} else {
- return (0,ghczminternal_GHCziInternalziTypes_False_closure);
+ return (0,HsIface_False_closure(W_[ghc_hs_iface]));
}
#endif
}
=====================================
rts/RtsAPI.c
=====================================
@@ -509,7 +509,7 @@ void rts_evalStableIOMain(/* inout */ Capability **cap,
SchedulerStatus stat;
p = (StgClosure *)deRefStablePtr(s);
- w = rts_apply(*cap, &ghczminternal_GHCziInternalziTopHandler_runMainIO_closure, p);
+ w = rts_apply(*cap, runMainIO_closure, p);
tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, w);
// async exceptions are always blocked by default in the created
// thread. See #1048.
@@ -961,7 +961,7 @@ void rts_done (void)
void hs_try_putmvar (/* in */ int capability,
/* in */ HsStablePtr mvar)
{
- hs_try_putmvar_with_value(capability, mvar, TAG_CLOSURE(1, Unit_closure));
+ hs_try_putmvar_with_value(capability, mvar, TAG_CLOSURE(1, ghc_hs_iface->Z0T_closure));
}
void hs_try_putmvar_with_value (/* in */ int capability,
=====================================
rts/RtsStartup.c
=====================================
@@ -183,8 +183,8 @@ static void initBuiltinGcRoots(void)
* these closures `Id`s of these can be safely marked as non-CAFFY
* in the compiler.
*/
- getStablePtr((StgPtr)runIO_closure);
- getStablePtr((StgPtr)runNonIO_closure);
+ getStablePtr((StgPtr)ghc_hs_iface->runIO_closure);
+ getStablePtr((StgPtr)ghc_hs_iface->runNonIO_closure);
getStablePtr((StgPtr)flushStdHandles_closure);
getStablePtr((StgPtr)runFinalizerBatch_closure);
@@ -263,6 +263,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
setlocale(LC_CTYPE,"");
+ if (ghc_hs_iface == NULL) {
+ errorBelch("hs_init_ghc: ghc_hs_iface is uninitialized");
+ stg_exit(1);
+ }
+
+
initBuiltinClosures();
/* Initialise the stats department, phase 0 */
=====================================
rts/RtsToHsIface.c
=====================================
@@ -0,0 +1,13 @@
+/*
+ * (c) The GHC Team, 2025-2026
+ *
+ * RTS/ghc-internal interface
+ *
+ * See Note [RTS/ghc-internal interface].
+ */
+
+#include "Rts.h"
+
+// This captures the symbols provided by ghc-internal which
+// are needed by the RTS.
+const HsIface *ghc_hs_iface = NULL;
=====================================
rts/Schedule.c
=====================================
@@ -1053,7 +1053,7 @@ scheduleProcessInbox (Capability **pcap USED_IF_THREADS)
while (p != NULL) {
pnext = p->link;
performTryPutMVar(cap, (StgMVar*)deRefStablePtr(p->mvar),
- Unit_closure);
+ ghc_hs_iface->Z0T_closure);
freeStablePtr(p->mvar);
stgFree(p);
p = pnext;
=====================================
rts/StgStdThunks.cmm
=====================================
@@ -13,8 +13,6 @@
#include "Cmm.h"
#include "Updates.h"
-import CLOSURE ghczminternal_GHCziInternalziCString_unpackCStringzh_info;
-import CLOSURE ghczminternal_GHCziInternalziCString_unpackCStringUtf8zh_info;
#if !defined(UnregisterisedCompiler)
import CLOSURE STK_CHK_ctr;
import CLOSURE stg_bh_upd_frame_info;
@@ -348,7 +346,7 @@ stg_do_unpack_cstring(P_ node, P_ newCAF_ret) {
W_ str;
str = StgThunk_payload(node, 2);
push (UPDATE_FRAME_FIELDS(,,stg_bh_upd_frame_info, CCCS, 0, newCAF_ret)) {
- jump %ENTRY_CODE(ghczminternal_GHCziInternalziCString_unpackCStringzh_info)(node, str);
+ jump %ENTRY_CODE(HsIface_unpackCStringzh_info(W_[ghc_hs_iface]))(node, str);
}
}
@@ -372,7 +370,7 @@ stg_do_unpack_cstring_utf8(P_ node, P_ newCAF_ret) {
W_ str;
str = StgThunk_payload(node, 2);
push (UPDATE_FRAME_FIELDS(,,stg_bh_upd_frame_info, CCCS, 0, newCAF_ret)) {
- jump %ENTRY_CODE(ghczminternal_GHCziInternalziCString_unpackCStringUtf8zh_info)(node, str);
+ jump %ENTRY_CODE(HsIface_unpackCStringUtf8zh_info(W_[ghc_hs_iface]))(node, str);
}
}
=====================================
rts/include/Rts.h
=====================================
@@ -229,6 +229,7 @@ void _warnFail(const char *filename, unsigned int linenum);
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/TSO.h"
#include "stg/MiscClosures.h" /* InfoTables, closures etc. defined in the RTS */
+
#include "rts/storage/Block.h"
#include "rts/storage/ClosureMacros.h"
#include "rts/storage/MBlock.h"
=====================================
rts/include/RtsAPI.h
=====================================
@@ -18,6 +18,7 @@ extern "C" {
#include "HsFFI.h"
#include "rts/Time.h"
#include "rts/Types.h"
+#include "rts/RtsToHsIface.h"
/*
* Running the scheduler
@@ -584,11 +585,6 @@ void rts_done (void);
// Note that RtsAPI.h is also included by foreign export stubs in
// the base package itself.
//
-extern StgClosure ghczminternal_GHCziInternalziTopHandler_runIO_closure;
-extern StgClosure ghczminternal_GHCziInternalziTopHandler_runNonIO_closure;
-
-#define runIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runIO_closure))
-#define runNonIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure))
/* ------------------------------------------------------------------------ */
=====================================
rts/include/rts/RtsToHsIface.h
=====================================
@@ -0,0 +1,64 @@
+/*
+ * (c) The GHC Team, 2025-2026
+ *
+ * RTS/ghc-internal interface
+ *
+ * See Note [RTS/ghc-internal interface].
+ */
+
+typedef struct {
+ StgClosure *processRemoteCompletion_closure; // GHC.Internal.Event.Windows.processRemoteCompletion_closure
+ StgClosure *runIO_closure; // GHC.Internal.TopHandler.runIO_closure
+ StgClosure *runNonIO_closure; // GHC.Internal.TopHandler.runNonIO_closure
+ StgClosure *Z0T_closure; // GHC.Internal.Tuple.Z0T_closure
+ StgClosure *True_closure; // GHC.Internal.Types.True_closure
+ StgClosure *False_closure; // GHC.Internal.Types.False_closure
+ StgClosure *unpackCString_closure; // GHC.Internal.Pack.unpackCString_closure
+ StgClosure *runFinalizzerBatch_closure; // GHC.Internal.Weak.Finalizze.runFinalizzerBatch_closure
+ StgClosure *stackOverflow_closure; // GHC.Internal.IO.Exception.stackOverflow_closure
+ StgClosure *heapOverflow_closure; // GHC.Internal.IO.Exception.heapOverflow_closure
+ StgClosure *allocationLimitExceeded_closure; // GHC.Internal.IO.Exception.allocationLimitExceeded_closure
+ StgClosure *blockedIndefinitelyOnMVar_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnMVar_closure
+ StgClosure *blockedIndefinitelyOnSTM_closure; // GHC.Internal.IO.Exception.blockedIndefinitelyOnSTM_closure
+ StgClosure *cannotCompactFunction_closure; // GHC.Internal.IO.Exception.cannotCompactFunction_closure
+ StgClosure *cannotCompactPinned_closure; // GHC.Internal.IO.Exception.cannotCompactPinned_closure
+ StgClosure *cannotCompactMutable_closure; // GHC.Internal.IO.Exception.cannotCompactMutable_closure
+ StgClosure *nonTermination_closure; // GHC.Internal.Control.Exception.Base.nonTermination_closure
+ StgClosure *nestedAtomically_closure; // GHC.Internal.Control.Exception.Base.nestedAtomically_closure
+ StgClosure *noMatchingContinuationPrompt_closure; // GHC.Internal.Control.Exception.Base.noMatchingContinuationPrompt_closure
+ StgClosure *blockedOnBadFD_closure; // GHC.Internal.Event.Thread.blockedOnBadFD_closure
+ StgClosure *runSparks_closure; // GHC.Internal.Conc.Sync.runSparks_closure
+ StgClosure *ensureIOManagerIsRunning_closure; // GHC.Internal.Conc.IO.ensureIOManagerIsRunning_closure
+ StgClosure *interruptIOManager_closure; // GHC.Internal.Conc.IO.interruptIOManager_closure
+ StgClosure *ioManagerCapabilitiesChanged_closure; // GHC.Internal.Conc.IO.ioManagerCapabilitiesChanged_closure
+ StgClosure *runHandlersPtr_closure; // GHC.Internal.Conc.Signal.runHandlersPtr_closure
+ StgClosure *flushStdHandles_closure; // GHC.Internal.TopHandler.flushStdHandles_closure
+ StgClosure *runMainIO_closure; // GHC.Internal.TopHandler.runMainIO_closure
+ StgInfoTable *Czh_con_info; // GHC.Internal.Types.Czh_con_info
+ StgInfoTable *Izh_con_info; // GHC.Internal.Types.Izh_con_info
+ StgInfoTable *Fzh_con_info; // GHC.Internal.Types.Fzh_con_info
+ StgInfoTable *Dzh_con_info; // GHC.Internal.Types.Dzh_con_info
+ StgInfoTable *Wzh_con_info; // GHC.Internal.Types.Wzh_con_info
+ StgClosure *absentSumFieldError_closure; // GHC.Internal.Prim.Panic.absentSumFieldError_closure
+ StgClosure *runAllocationLimitHandler_closure; // GHC.Internal.AllocationLimitHandler.runAllocationLimitHandler_closure
+ StgInfoTable *Ptr_con_info; // GHC.Internal.Ptr.Ptr_con_info
+ StgInfoTable *FunPtr_con_info; // GHC.Internal.Ptr.FunPtr_con_info
+ StgInfoTable *I8zh_con_info; // GHC.Internal.Int.I8zh_con_info
+ StgInfoTable *I16zh_con_info; // GHC.Internal.Int.I16zh_con_info
+ StgInfoTable *I32zh_con_info; // GHC.Internal.Int.I32zh_con_info
+ StgInfoTable *I64zh_con_info; // GHC.Internal.Int.I64zh_con_info
+ StgInfoTable *W8zh_con_info; // GHC.Internal.Word.W8zh_con_info
+ StgInfoTable *W16zh_con_info; // GHC.Internal.Word.W16zh_con_info
+ StgInfoTable *W32zh_con_info; // GHC.Internal.Word.W32zh_con_info
+ StgInfoTable *W64zh_con_info; // GHC.Internal.Word.W64zh_con_info
+ StgInfoTable *StablePtr_con_info; // GHC.Internal.Stable.StablePtr_con_info
+ StgClosure *StackSnapshot_closure; // GHC.Internal.Stack.CloneStack.StackSnapshot_closure
+ StgClosure *divZZeroException_closure; // GHC.Internal.Exception.Type.divZeroException_closure
+ StgClosure *underflowException_closure; // GHC.Internal.Exception.Type.underflowException_closure
+ StgClosure *overflowException_closure; // GHC.Internal.Exception.Type.overflowException_closure
+ StgClosure *unpackCStringzh_closure; // GHC.Internal.CString.unpackCStringzh_closure
+ StgInfoTable *unpackCStringzh_info; // GHC.Internal.CString.unpackCStringzh_info
+ StgInfoTable *unpackCStringUtf8zh_info; // GHC.Internal.CString.unpackCStringUtf8zh_info
+} HsIface;
+
+extern const HsIface *ghc_hs_iface;
=====================================
rts/posix/Signals.c
=====================================
@@ -222,7 +222,7 @@ ioManagerDie (void)
void
ioManagerStartCap (Capability **cap)
{
- rts_evalIO(cap,&ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure,NULL);
+ rts_evalIO(cap,ensureIOManagerIsRunning_closure,NULL);
}
void
@@ -493,7 +493,7 @@ startSignalHandlers(Capability *cap)
RtsFlags.GcFlags.initialStkSize,
rts_apply(cap,
rts_apply(cap,
- &ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure,
+ runHandlersPtr_closure,
rts_mkPtr(cap, info)),
rts_mkInt(cap, info->si_signo)));
scheduleThread(cap, t);
=====================================
rts/rts.cabal
=====================================
@@ -334,6 +334,7 @@ library
rts/storage/InfoTables.h
rts/storage/MBlock.h
rts/storage/TSO.h
+ rts/RtsToHsIface.h
stg/MachRegs.h
stg/MachRegs/arm32.h
stg/MachRegs/arm64.h
@@ -449,6 +450,7 @@ library
RtsStartup.c
RtsSymbolInfo.c
RtsSymbols.c
+ RtsToHsIface.c
RtsUtils.c
STM.c
Schedule.c
=====================================
rts/wasm/JSFFI.c
=====================================
@@ -23,8 +23,8 @@ int __main_argc_argv(int argc, char *argv[]) {
hs_init_ghc(&argc, &argv, __conf);
// See Note [threadDelay on wasm] for details.
rts_JSFFI_flag = HS_BOOL_TRUE;
- getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure);
- rts_threadDelay_impl = getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure);
+ getStablePtr((StgPtr)ghc_hs_iface->raiseJSException_closure);
+ rts_threadDelay_impl = getStablePtr((StgPtr)ghc_hs_iface->threadDelay_closure);
return 0;
}
@@ -112,7 +112,7 @@ HaskellObj rts_mkJSVal(Capability *cap, HsJSVal v) {
SET_HDR(w, &stg_WEAK_info, CCS_SYSTEM);
w->cfinalizers = (StgClosure *)cfin;
w->key = p;
- w->value = Unit_closure;
+ w->value = ghc_hs_iface->Z0T_closure;
w->finalizer = &stg_NO_FINALIZER_closure;
w->link = cap->weak_ptr_list_hd;
cap->weak_ptr_list_hd = w;
@@ -123,7 +123,7 @@ HaskellObj rts_mkJSVal(Capability *cap, HsJSVal v) {
p->payload[0] = (HaskellObj)w;
HaskellObj box = (HaskellObj)allocate(cap, CONSTR_sizeW(1, 0));
- SET_HDR(box, &ghczminternal_GHCziInternalziWasmziPrimziTypes_JSVal_con_info, CCS_SYSTEM);
+ SET_HDR(box, ghc_hs_iface->JSVal_con_info, CCS_SYSTEM);
box->payload[0] = p;
return TAG_CLOSURE(1, box);
@@ -139,7 +139,7 @@ STATIC_INLINE HsJSVal rts_getJSValzh(HaskellObj p) {
HsJSVal rts_getJSVal(HaskellObj);
HsJSVal rts_getJSVal(HaskellObj box) {
- ASSERT(UNTAG_CLOSURE(box)->header.info == &ghczminternal_GHCziInternalziWasmziPrimziTypes_JSVal_con_info);
+ ASSERT(UNTAG_CLOSURE(box)->header.info == ghc_hs_iface->JSVal_con_info);
return rts_getJSValzh(UNTAG_CLOSURE(box)->payload[0]);
}
@@ -188,7 +188,7 @@ void rts_schedulerLoop(void) {
__attribute__((export_name("rts_promiseResolveUnit")))
void rts_promiseResolveUnit(HsStablePtr);
void rts_promiseResolveUnit(HsStablePtr sp)
- mk_rtsPromiseCallback(TAG_CLOSURE(1, Unit_closure))
+ mk_rtsPromiseCallback(TAG_CLOSURE(1, ghc_hs_iface->Z0T_closure))
mk_rtsPromiseResolve(JSVal)
mk_rtsPromiseResolve(Char)
@@ -212,7 +212,7 @@ mk_rtsPromiseResolve(Bool)
__attribute__((export_name("rts_promiseReject")))
void rts_promiseReject(HsStablePtr, HsJSVal);
void rts_promiseReject(HsStablePtr sp, HsJSVal js_err)
- mk_rtsPromiseCallback(rts_apply(cap, &ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure, rts_mkJSVal(cap, js_err)))
+ mk_rtsPromiseCallback(rts_apply(cap, ghc_hs_iface->raiseJSException_closure, rts_mkJSVal(cap, js_err)))
__attribute__((export_name("rts_promiseThrowTo")))
void rts_promiseThrowTo(HsStablePtr, HsJSVal);
@@ -229,7 +229,7 @@ void rts_promiseThrowTo(HsStablePtr sp, HsJSVal js_err) {
cap, tso,
rts_apply(
cap,
- &ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure,
+ ghc_hs_iface->raiseJSException_closure,
rts_mkJSVal(cap, js_err)));
tryWakeupThread(cap, tso);
rts_schedulerLoop();
=====================================
utils/deriveConstants/Main.hs
=====================================
@@ -667,6 +667,59 @@ wanteds os = concat
,structField C "StgAsyncIOResult" "errCode"]
else []
+ -- struct HsIface
+ ,structField C "HsIface" "processRemoteCompletion_closure"
+ ,structField C "HsIface" "runIO_closure"
+ ,structField C "HsIface" "runNonIO_closure"
+ ,structField C "HsIface" "Z0T_closure"
+ ,structField C "HsIface" "True_closure"
+ ,structField C "HsIface" "False_closure"
+ ,structField C "HsIface" "unpackCString_closure"
+ ,structField C "HsIface" "runFinalizzerBatch_closure"
+ ,structField C "HsIface" "stackOverflow_closure"
+ ,structField C "HsIface" "heapOverflow_closure"
+ ,structField C "HsIface" "allocationLimitExceeded_closure"
+ ,structField C "HsIface" "blockedIndefinitelyOnMVar_closure"
+ ,structField C "HsIface" "blockedIndefinitelyOnSTM_closure"
+ ,structField C "HsIface" "cannotCompactFunction_closure"
+ ,structField C "HsIface" "cannotCompactPinned_closure"
+ ,structField C "HsIface" "cannotCompactMutable_closure"
+ ,structField C "HsIface" "nonTermination_closure"
+ ,structField C "HsIface" "nestedAtomically_closure"
+ ,structField C "HsIface" "noMatchingContinuationPrompt_closure"
+ ,structField C "HsIface" "blockedOnBadFD_closure"
+ ,structField C "HsIface" "runSparks_closure"
+ ,structField C "HsIface" "ensureIOManagerIsRunning_closure"
+ ,structField C "HsIface" "interruptIOManager_closure"
+ ,structField C "HsIface" "ioManagerCapabilitiesChanged_closure"
+ ,structField C "HsIface" "runHandlersPtr_closure"
+ ,structField C "HsIface" "flushStdHandles_closure"
+ ,structField C "HsIface" "runMainIO_closure"
+ ,structField C "HsIface" "Czh_con_info"
+ ,structField C "HsIface" "Izh_con_info"
+ ,structField C "HsIface" "Fzh_con_info"
+ ,structField C "HsIface" "Dzh_con_info"
+ ,structField C "HsIface" "Wzh_con_info"
+ ,structField C "HsIface" "runAllocationLimitHandler_closure"
+ ,structField C "HsIface" "Ptr_con_info"
+ ,structField C "HsIface" "FunPtr_con_info"
+ ,structField C "HsIface" "I8zh_con_info"
+ ,structField C "HsIface" "I16zh_con_info"
+ ,structField C "HsIface" "I32zh_con_info"
+ ,structField C "HsIface" "I64zh_con_info"
+ ,structField C "HsIface" "W8zh_con_info"
+ ,structField C "HsIface" "W16zh_con_info"
+ ,structField C "HsIface" "W32zh_con_info"
+ ,structField C "HsIface" "W64zh_con_info"
+ ,structField C "HsIface" "StablePtr_con_info"
+ ,structField C "HsIface" "StackSnapshot_closure"
+ ,structField C "HsIface" "divZZeroException_closure"
+ ,structField C "HsIface" "underflowException_closure"
+ ,structField C "HsIface" "overflowException_closure"
+ ,structField C "HsIface" "unpackCStringzh_closure"
+ ,structField C "HsIface" "unpackCStringzh_info"
+ ,structField C "HsIface" "unpackCStringUtf8zh_info"
+
-- pre-compiled thunk types
,constantWord Haskell "MAX_SPEC_SELECTEE_SIZE" "MAX_SPEC_SELECTEE_SIZE"
,constantWord Haskell "MAX_SPEC_AP_SIZE" "MAX_SPEC_AP_SIZE"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f24794255333130290c9c83225ab5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f24794255333130290c9c83225ab5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/T26166 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26166
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/supersven/test-master-full-ci] Some silly change
by Sven Tennie (＠supersven) 26 Sep '25
by Sven Tennie (＠supersven) 26 Sep '25
26 Sep '25
Sven Tennie pushed to branch wip/supersven/test-master-full-ci at Glasgow Haskell Compiler / GHC
Commits:
a43a238b by Sven Tennie at 2025-09-26T13:46:51+02:00
Some silly change
- - - - -
1 changed file:
- + some-silly-change
Changes:
=====================================
some-silly-change
=====================================
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a43a238b23c9fa4dd2214f034532681…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a43a238b23c9fa4dd2214f034532681…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/supersven/test-master-full-ci
by Sven Tennie (＠supersven) 26 Sep '25
by Sven Tennie (＠supersven) 26 Sep '25
26 Sep '25
Sven Tennie pushed new branch wip/supersven/test-master-full-ci at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/test-master-full-ci
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/bomb_out] exprSize: Accumulate size as we go to allow early bomb out.
by Andreas Klebinger (＠AndreasK) 26 Sep '25
by Andreas Klebinger (＠AndreasK) 26 Sep '25
26 Sep '25
Andreas Klebinger pushed to branch wip/andreask/bomb_out at Glasgow Haskell Compiler / GHC
Commits:
3e795969 by Andreas Klebinger at 2025-09-26T13:13:31+02:00
exprSize: Accumulate size as we go to allow early bomb out.
When dealing with branches in the AST we now accumulate
expr size across branches, rather than computing both
branches before adding them up.
This way we can abort early when it's clear an expression
is too large to be useful.
This fixes an issue I observed in #26425 where we sometimes
spent a significant amount of time computing unfolding sizes
in deeply nested but branching rhss.
Speedup is on the order of ~1%-4% depending on the program we
are compiling.
- - - - -
1 changed file:
- compiler/GHC/Core/Unfold.hs
Changes:
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -567,43 +567,46 @@ sizeExpr :: UnfoldingOpts
-- Forcing bOMB_OUT_SIZE early prevents repeated
-- unboxing of the Int argument.
sizeExpr opts !bOMB_OUT_SIZE top_args expr
- = size_up expr
+ = size_up sizeZero expr
where
- size_up (Cast e _) = size_up e
- size_up (Tick _ e) = size_up e
- size_up (Type _) = sizeZero -- Types cost nothing
- size_up (Coercion _) = sizeZero
- size_up (Lit lit) = sizeN (litSize lit)
- size_up (Var f) | isZeroBitId f = sizeZero
- -- Make sure we get constructor discounts even
- -- on nullary constructors
- | otherwise = size_up_call f [] 0
-
- size_up (App fun arg)
- | isTyCoArg arg = size_up fun
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun [arg] (if isZeroBitExpr arg then 1 else 0)
-
- size_up (Lam b e)
- | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up e `addSizeN` 10)
- | otherwise = size_up e
-
- size_up (Let (NonRec binder rhs) body)
- = size_up_rhs (binder, rhs) `addSizeNSD`
- size_up body `addSizeN`
- size_up_alloc binder
-
- size_up (Let (Rec pairs) body)
- = foldr (addSizeNSD . size_up_rhs)
- (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs))
- pairs
-
- size_up (Case e _ _ alts) = case nonEmpty alts of
- Nothing -> size_up e -- case e of {} never returns, so take size of scrutinee
+ size_up :: ExprSize -> CoreExpr -> ExprSize
+ size_up (TooBig) !_ = TooBig
+ size_up (SizeIs !s _ _) _
+ | s > bOMB_OUT_SIZE = TooBig
+ size_up s (Cast e _) = size_up s e
+ size_up s (Tick _ e) = size_up s e
+ size_up s (Type _) = s -- Types cost nothing
+ size_up s (Coercion _) = s
+ size_up s (Lit lit) = addSizeNSD (sizeN (litSize lit)) s
+ size_up s (Var f) | isZeroBitId f = s
+ -- Make sure we get constructor discounts even
+ -- on nullary constructors
+ | otherwise = size_up_call s f [] 0
+
+ size_up s (App fun arg)
+ | isTyCoArg arg = size_up s fun
+ | otherwise = size_up_app (stripDiscounts $ size_up s arg)
+ fun [arg] (if isZeroBitExpr arg then 1 else 0)
+
+ size_up s (Lam b e)
+ | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up (addSizeN s 10) e)
+ | otherwise = size_up s e
+
+ size_up s (Let (NonRec binder rhs) body)
+ = let rhs_s = size_up_let s (binder, rhs)
+ in size_up (stripDiscounts $ rhs_s) body
+
+
+ size_up s (Let (Rec pairs) body)
+ = size_up (stripDiscounts (foldr (flip size_up_let) s pairs))
+ body
+
+ size_up s (Case e _ _ alts) = case nonEmpty alts of
+ Nothing -> size_up s e -- case e of {} never returns, so take size of scrutinee
Just alts
| Just v <- is_top_arg e -> -- We are scrutinising an argument variable
let
- alt_sizes = NE.map size_up_alt alts
+ alt_sizes = NE.map (size_up_alt s) alts
-- alts_size tries to compute a good discount for
-- the case when we are scrutinising an argument variable
@@ -625,21 +628,24 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
alts_size tot_size _ = tot_size
in
- alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
- (foldr1 maxSize alt_sizes)
+ s `addSizeNSD` alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
+ (foldr1 maxSize alt_sizes)
-- Good to inline if an arg is scrutinised, because
-- that may eliminate allocation in the caller
-- And it eliminates the case itself
- | otherwise -> size_up e `addSizeNSD`
- foldr (addAltSize . size_up_alt) case_size alts
+ | otherwise -> foldr (addAltSize . size_up_alt s)
+ (size_up s e `addSizeNSD` case_size)
+ alts
where
is_top_arg (Var v) | v `elem` top_args = Just v
is_top_arg (Cast e _) = is_top_arg e
+ is_top_arg (Tick _t e) = is_top_arg e
is_top_arg _ = Nothing
where
+
case_size
| is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
| otherwise = sizeZero
@@ -675,48 +681,61 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
| otherwise
= False
- size_up_rhs (bndr, rhs)
+ size_up_let :: ExprSize -> (Id, CoreExpr) -> ExprSize
+ size_up_let s (bndr, rhs)
| JoinPoint join_arity <- idJoinPointHood bndr
-- Skip arguments to join point
, (_bndrs, body) <- collectNBinders join_arity rhs
- = size_up body
+ = size_up s body
| otherwise
- = size_up rhs
+ = size_up s rhs `addSizeN` size_up_alloc bndr
------------
-- size_up_app is used when there's ONE OR MORE value args
- size_up_app (App fun arg) args voids
- | isTyCoArg arg = size_up_app fun args voids
- | isZeroBitExpr arg = size_up_app fun (arg:args) (voids + 1)
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun (arg:args) voids
- size_up_app (Var fun) args voids = size_up_call fun args voids
- size_up_app (Tick _ expr) args voids = size_up_app expr args voids
- size_up_app (Cast expr _) args voids = size_up_app expr args voids
- size_up_app other args voids = size_up other `addSizeN`
- callSize (length args) voids
+ size_up_app :: ExprSize -> CoreExpr -> [CoreExpr] -> Int -> ExprSize
+ size_up_app s (App fun arg) args voids
+ | isTyCoArg arg = size_up_app s fun args voids
+ | isZeroBitExpr arg = size_up_app s fun (arg:args) (voids + 1)
+ | otherwise = let arg_size = stripDiscounts $ size_up s arg
+ in size_up_app arg_size fun (arg:args) voids
+ size_up_app s (Var fun) args voids = size_up_call s fun args voids
+ size_up_app s (Tick _ expr) args voids = size_up_app s expr args voids
+ size_up_app s (Cast expr _) args voids = size_up_app s expr args voids
+ size_up_app s other args voids = size_up (s `addSizeN` callSize (length args) voids) other
+
-- if the lhs is not an App or a Var, or an invisible thing like a
-- Tick or Cast, then we should charge for a complete call plus the
-- size of the lhs itself.
------------
- size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
- size_up_call fun val_args voids
- = case idDetails fun of
- FCallId _ -> sizeN (callSize (length val_args) voids)
- DataConWorkId dc -> conSize dc (length val_args)
- PrimOpId op _ -> primOpSize op (length val_args)
- ClassOpId cls _ -> classOpSize opts cls top_args val_args
- _ | fun `hasKey` buildIdKey -> buildSize
- | fun `hasKey` augmentIdKey -> augmentSize
- | otherwise -> funSize opts top_args fun (length val_args) voids
+ size_up_call :: ExprSize -> Id -> [CoreExpr] -> Int -> ExprSize
+ size_up_call !s fun val_args voids
+ = let !n_args = length val_args
+ call_size = case idDetails fun of
+ FCallId _ -> sizeN (callSize n_args voids)
+ DataConWorkId dc -> conSize dc n_args
+ PrimOpId op _ -> primOpSize op n_args
+ ClassOpId cls _ -> classOpSize opts cls top_args val_args
+ _ | fun `hasKey` buildIdKey -> buildSize
+ | fun `hasKey` augmentIdKey -> augmentSize
+ | otherwise -> funSize opts top_args fun n_args voids
+ in s `addSizeNSD` call_size
------------
- size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10
+ -- size_up_alt returns on the alternatives size, not counting the accumulated
+ -- size passed in unless we reach TooBig. This is to facility better discount
+ -- calculation based on the size of only the alternative.
+ size_up_alt TooBig _ = TooBig
+ size_up_alt (SizeIs {_es_size_is=s}) (Alt _con _bndrs rhs) =
+ size_up (sizeN s) rhs
+ -- Why add and then subtract s?
+ -- If the expression large enough this will ensure we bomb out early.
+ `addSizeN` (10 -s)
+
-- Don't charge for args, so that wrappers look cheap
-- (See comments about wrappers with Case)
--
- -- IMPORTANT: *do* charge 1 for the alternative, else we
+ -- IMPORTANT: *do* charge 10 for the alternative, else we
-- find that giant case nests are treated as practically free
-- A good example is Foreign.C.Error.errnoToIOError
@@ -753,6 +772,14 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
(xs `unionBags` ys)
d2 -- Ignore d1
+ -- Throw away the discount for scrutinizing the expression.
+ -- Used for things like `let x = rhs in body` where we only consider
+ -- this benefit for the body.
+ -- Why? `x` is visible to `body` either way, so it really should not
+ -- affect our inlining decision either way.
+ stripDiscounts TooBig = TooBig
+ stripDiscounts (SizeIs n xs _) = (SizeIs n xs 0)
+
-- don't count expressions such as State# RealWorld
-- exclude join points, because they can be rep-polymorphic
-- and typePrimRep will crash
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e7959697150cef223cf3f206d0c907…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e7959697150cef223cf3f206d0c907…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/bomb_out] exprSize: Accumulate size as we go to allow early bomb out.
by Andreas Klebinger (＠AndreasK) 26 Sep '25
by Andreas Klebinger (＠AndreasK) 26 Sep '25
26 Sep '25
Andreas Klebinger pushed to branch wip/andreask/bomb_out at Glasgow Haskell Compiler / GHC
Commits:
66c56b5f by Andreas Klebinger at 2025-09-26T13:12:52+02:00
exprSize: Accumulate size as we go to allow early bomb out.
When dealing with branches in the AST we now accumulate
expr size across branches, rather than computing both
branches before adding them up.
This way we can abort early when it's clear an expression
is too large to be useful.
This fixes an issue I observed in #26425 where we sometimes
spent a significant amount of time computing unfolding sizes
in deeply nested but branching rhss.
Speedup is on the order of ~1%-4% depending on the program we
are compiling.
- - - - -
1 changed file:
- compiler/GHC/Core/Unfold.hs
Changes:
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -566,44 +566,48 @@ sizeExpr :: UnfoldingOpts
-- Forcing bOMB_OUT_SIZE early prevents repeated
-- unboxing of the Int argument.
+-- {-# NOINLINE sizeExpr #-}
sizeExpr opts !bOMB_OUT_SIZE top_args expr
- = size_up expr
+ = size_up sizeZero expr
where
- size_up (Cast e _) = size_up e
- size_up (Tick _ e) = size_up e
- size_up (Type _) = sizeZero -- Types cost nothing
- size_up (Coercion _) = sizeZero
- size_up (Lit lit) = sizeN (litSize lit)
- size_up (Var f) | isZeroBitId f = sizeZero
- -- Make sure we get constructor discounts even
- -- on nullary constructors
- | otherwise = size_up_call f [] 0
-
- size_up (App fun arg)
- | isTyCoArg arg = size_up fun
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun [arg] (if isZeroBitExpr arg then 1 else 0)
-
- size_up (Lam b e)
- | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up e `addSizeN` 10)
- | otherwise = size_up e
-
- size_up (Let (NonRec binder rhs) body)
- = size_up_rhs (binder, rhs) `addSizeNSD`
- size_up body `addSizeN`
- size_up_alloc binder
-
- size_up (Let (Rec pairs) body)
- = foldr (addSizeNSD . size_up_rhs)
- (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs))
- pairs
-
- size_up (Case e _ _ alts) = case nonEmpty alts of
- Nothing -> size_up e -- case e of {} never returns, so take size of scrutinee
+ size_up :: ExprSize -> CoreExpr -> ExprSize
+ size_up (TooBig) !_ = TooBig
+ size_up (SizeIs !s _ _) _
+ | s > bOMB_OUT_SIZE = TooBig
+ size_up s (Cast e _) = size_up s e
+ size_up s (Tick _ e) = size_up s e
+ size_up s (Type _) = s -- Types cost nothing
+ size_up s (Coercion _) = s
+ size_up s (Lit lit) = addSizeNSD (sizeN (litSize lit)) s
+ size_up s (Var f) | isZeroBitId f = s
+ -- Make sure we get constructor discounts even
+ -- on nullary constructors
+ | otherwise = size_up_call s f [] 0
+
+ size_up s (App fun arg)
+ | isTyCoArg arg = size_up s fun
+ | otherwise = size_up_app (stripDiscounts $ size_up s arg)
+ fun [arg] (if isZeroBitExpr arg then 1 else 0)
+
+ size_up s (Lam b e)
+ | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up (addSizeN s 10) e)
+ | otherwise = size_up s e
+
+ size_up s (Let (NonRec binder rhs) body)
+ = let rhs_s = size_up_let s (binder, rhs)
+ in size_up (stripDiscounts $ rhs_s) body
+
+
+ size_up s (Let (Rec pairs) body)
+ = size_up (stripDiscounts (foldr (flip size_up_let) s pairs))
+ body
+
+ size_up s (Case e _ _ alts) = case nonEmpty alts of
+ Nothing -> size_up s e -- case e of {} never returns, so take size of scrutinee
Just alts
| Just v <- is_top_arg e -> -- We are scrutinising an argument variable
let
- alt_sizes = NE.map size_up_alt alts
+ alt_sizes = NE.map (size_up_alt s) alts
-- alts_size tries to compute a good discount for
-- the case when we are scrutinising an argument variable
@@ -625,21 +629,24 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
alts_size tot_size _ = tot_size
in
- alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
- (foldr1 maxSize alt_sizes)
+ s `addSizeNSD` alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
+ (foldr1 maxSize alt_sizes)
-- Good to inline if an arg is scrutinised, because
-- that may eliminate allocation in the caller
-- And it eliminates the case itself
- | otherwise -> size_up e `addSizeNSD`
- foldr (addAltSize . size_up_alt) case_size alts
+ | otherwise -> foldr (addAltSize . size_up_alt s)
+ (size_up s e `addSizeNSD` case_size)
+ alts
where
is_top_arg (Var v) | v `elem` top_args = Just v
is_top_arg (Cast e _) = is_top_arg e
+ is_top_arg (Tick _t e) = is_top_arg e
is_top_arg _ = Nothing
where
+
case_size
| is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
| otherwise = sizeZero
@@ -675,48 +682,61 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
| otherwise
= False
- size_up_rhs (bndr, rhs)
+ size_up_let :: ExprSize -> (Id, CoreExpr) -> ExprSize
+ size_up_let s (bndr, rhs)
| JoinPoint join_arity <- idJoinPointHood bndr
-- Skip arguments to join point
, (_bndrs, body) <- collectNBinders join_arity rhs
- = size_up body
+ = size_up s body
| otherwise
- = size_up rhs
+ = size_up s rhs `addSizeN` size_up_alloc bndr
------------
-- size_up_app is used when there's ONE OR MORE value args
- size_up_app (App fun arg) args voids
- | isTyCoArg arg = size_up_app fun args voids
- | isZeroBitExpr arg = size_up_app fun (arg:args) (voids + 1)
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun (arg:args) voids
- size_up_app (Var fun) args voids = size_up_call fun args voids
- size_up_app (Tick _ expr) args voids = size_up_app expr args voids
- size_up_app (Cast expr _) args voids = size_up_app expr args voids
- size_up_app other args voids = size_up other `addSizeN`
- callSize (length args) voids
+ size_up_app :: ExprSize -> CoreExpr -> [CoreExpr] -> Int -> ExprSize
+ size_up_app s (App fun arg) args voids
+ | isTyCoArg arg = size_up_app s fun args voids
+ | isZeroBitExpr arg = size_up_app s fun (arg:args) (voids + 1)
+ | otherwise = let arg_size = stripDiscounts $ size_up s arg
+ in size_up_app arg_size fun (arg:args) voids
+ size_up_app s (Var fun) args voids = size_up_call s fun args voids
+ size_up_app s (Tick _ expr) args voids = size_up_app s expr args voids
+ size_up_app s (Cast expr _) args voids = size_up_app s expr args voids
+ size_up_app s other args voids = size_up (s `addSizeN` callSize (length args) voids) other
+
-- if the lhs is not an App or a Var, or an invisible thing like a
-- Tick or Cast, then we should charge for a complete call plus the
-- size of the lhs itself.
------------
- size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
- size_up_call fun val_args voids
- = case idDetails fun of
- FCallId _ -> sizeN (callSize (length val_args) voids)
- DataConWorkId dc -> conSize dc (length val_args)
- PrimOpId op _ -> primOpSize op (length val_args)
- ClassOpId cls _ -> classOpSize opts cls top_args val_args
- _ | fun `hasKey` buildIdKey -> buildSize
- | fun `hasKey` augmentIdKey -> augmentSize
- | otherwise -> funSize opts top_args fun (length val_args) voids
+ size_up_call :: ExprSize -> Id -> [CoreExpr] -> Int -> ExprSize
+ size_up_call !s fun val_args voids
+ = let !n_args = length val_args
+ call_size = case idDetails fun of
+ FCallId _ -> sizeN (callSize n_args voids)
+ DataConWorkId dc -> conSize dc n_args
+ PrimOpId op _ -> primOpSize op n_args
+ ClassOpId cls _ -> classOpSize opts cls top_args val_args
+ _ | fun `hasKey` buildIdKey -> buildSize
+ | fun `hasKey` augmentIdKey -> augmentSize
+ | otherwise -> funSize opts top_args fun n_args voids
+ in s `addSizeNSD` call_size
------------
- size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10
+ -- size_up_alt returns on the alternatives size, not counting the accumulated
+ -- size passed in unless we reach TooBig. This is to facility better discount
+ -- calculation based on the size of only the alternative.
+ size_up_alt TooBig _ = TooBig
+ size_up_alt (SizeIs {_es_size_is=s}) (Alt _con _bndrs rhs) =
+ size_up (sizeN s) rhs
+ -- Why add and then subtract s?
+ -- If the expression large enough this will ensure we bomb out early.
+ `addSizeN` (10 -s)
+
-- Don't charge for args, so that wrappers look cheap
-- (See comments about wrappers with Case)
--
- -- IMPORTANT: *do* charge 1 for the alternative, else we
+ -- IMPORTANT: *do* charge 10 for the alternative, else we
-- find that giant case nests are treated as practically free
-- A good example is Foreign.C.Error.errnoToIOError
@@ -753,6 +773,14 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
(xs `unionBags` ys)
d2 -- Ignore d1
+ -- Throw away the discount for scrutinizing the expression.
+ -- Used for things like `let x = rhs in body` where we only consider
+ -- this benefit for the body.
+ -- Why? `x` is visible to `body` either way, so it really should not
+ -- affect our inlining decision either way.
+ stripDiscounts TooBig = TooBig
+ stripDiscounts (SizeIs n xs _) = (SizeIs n xs 0)
+
-- don't count expressions such as State# RealWorld
-- exclude join points, because they can be rep-polymorphic
-- and typePrimRep will crash
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c56b5fcd8bfb9eafce80f204ce093…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c56b5fcd8bfb9eafce80f204ce093…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/bomb_out] exprSize: Accumulate size as we go to allow early bomb out.
by Andreas Klebinger (＠AndreasK) 26 Sep '25
by Andreas Klebinger (＠AndreasK) 26 Sep '25
26 Sep '25
Andreas Klebinger pushed to branch wip/andreask/bomb_out at Glasgow Haskell Compiler / GHC
Commits:
0b0df4b7 by Andreas Klebinger at 2025-09-26T13:06:54+02:00
exprSize: Accumulate size as we go to allow early bomb out.
When dealing with branches in the AST we now accumulate
expr size across branches, rather than computing both
branches before adding them up.
This way we can abort early when it's clear an expression
is too large to be useful.
This fixes an issue I observed in #26425 where we sometimes
spent a significant amount of time computing unfolding sizes
in deeply nested but branching rhss.
Speedup is on the order of ~1%-4% depending on the program we
are compiling.
- - - - -
1 changed file:
- compiler/GHC/Core/Unfold.hs
Changes:
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -335,6 +335,7 @@ isValFun (Lam b e) | isRuntimeVar b = True
| otherwise = isValFun e
isValFun _ = False
+{-# NOINLINE calcUnfoldingGuidance #-}
calcUnfoldingGuidance
:: UnfoldingOpts
-> Bool -- Definitely a top-level, bottoming binding
@@ -566,44 +567,48 @@ sizeExpr :: UnfoldingOpts
-- Forcing bOMB_OUT_SIZE early prevents repeated
-- unboxing of the Int argument.
+-- {-# NOINLINE sizeExpr #-}
sizeExpr opts !bOMB_OUT_SIZE top_args expr
- = size_up expr
+ = size_up sizeZero expr
where
- size_up (Cast e _) = size_up e
- size_up (Tick _ e) = size_up e
- size_up (Type _) = sizeZero -- Types cost nothing
- size_up (Coercion _) = sizeZero
- size_up (Lit lit) = sizeN (litSize lit)
- size_up (Var f) | isZeroBitId f = sizeZero
- -- Make sure we get constructor discounts even
- -- on nullary constructors
- | otherwise = size_up_call f [] 0
-
- size_up (App fun arg)
- | isTyCoArg arg = size_up fun
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun [arg] (if isZeroBitExpr arg then 1 else 0)
-
- size_up (Lam b e)
- | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up e `addSizeN` 10)
- | otherwise = size_up e
-
- size_up (Let (NonRec binder rhs) body)
- = size_up_rhs (binder, rhs) `addSizeNSD`
- size_up body `addSizeN`
- size_up_alloc binder
-
- size_up (Let (Rec pairs) body)
- = foldr (addSizeNSD . size_up_rhs)
- (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs))
- pairs
-
- size_up (Case e _ _ alts) = case nonEmpty alts of
- Nothing -> size_up e -- case e of {} never returns, so take size of scrutinee
+ size_up :: ExprSize -> CoreExpr -> ExprSize
+ size_up (TooBig) !_ = TooBig
+ size_up (SizeIs !s _ _) _
+ | s > bOMB_OUT_SIZE = TooBig
+ size_up s (Cast e _) = size_up s e
+ size_up s (Tick _ e) = size_up s e
+ size_up s (Type _) = s -- Types cost nothing
+ size_up s (Coercion _) = s
+ size_up s (Lit lit) = addSizeNSD (sizeN (litSize lit)) s
+ size_up s (Var f) | isZeroBitId f = s
+ -- Make sure we get constructor discounts even
+ -- on nullary constructors
+ | otherwise = size_up_call s f [] 0
+
+ size_up s (App fun arg)
+ | isTyCoArg arg = size_up s fun
+ | otherwise = size_up_app (stripDiscounts $ size_up s arg)
+ fun [arg] (if isZeroBitExpr arg then 1 else 0)
+
+ size_up s (Lam b e)
+ | isId b && not (isZeroBitId b) = lamScrutDiscount opts (size_up (addSizeN s 10) e)
+ | otherwise = size_up s e
+
+ size_up s (Let (NonRec binder rhs) body)
+ = let rhs_s = size_up_let s (binder, rhs)
+ in size_up (stripDiscounts $ rhs_s) body
+
+
+ size_up s (Let (Rec pairs) body)
+ = size_up (stripDiscounts (foldr (flip size_up_let) s pairs))
+ body
+
+ size_up s (Case e _ _ alts) = case nonEmpty alts of
+ Nothing -> size_up s e -- case e of {} never returns, so take size of scrutinee
Just alts
| Just v <- is_top_arg e -> -- We are scrutinising an argument variable
let
- alt_sizes = NE.map size_up_alt alts
+ alt_sizes = NE.map (size_up_alt s) alts
-- alts_size tries to compute a good discount for
-- the case when we are scrutinising an argument variable
@@ -625,21 +630,24 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
alts_size tot_size _ = tot_size
in
- alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
- (foldr1 maxSize alt_sizes)
+ s `addSizeNSD` alts_size (foldr1 addAltSize alt_sizes) -- alts is non-empty
+ (foldr1 maxSize alt_sizes)
-- Good to inline if an arg is scrutinised, because
-- that may eliminate allocation in the caller
-- And it eliminates the case itself
- | otherwise -> size_up e `addSizeNSD`
- foldr (addAltSize . size_up_alt) case_size alts
+ | otherwise -> foldr (addAltSize . size_up_alt s)
+ (size_up s e `addSizeNSD` case_size)
+ alts
where
is_top_arg (Var v) | v `elem` top_args = Just v
is_top_arg (Cast e _) = is_top_arg e
+ is_top_arg (Tick _t e) = is_top_arg e
is_top_arg _ = Nothing
where
+
case_size
| is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10)
| otherwise = sizeZero
@@ -675,48 +683,61 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
| otherwise
= False
- size_up_rhs (bndr, rhs)
+ size_up_let :: ExprSize -> (Id, CoreExpr) -> ExprSize
+ size_up_let s (bndr, rhs)
| JoinPoint join_arity <- idJoinPointHood bndr
-- Skip arguments to join point
, (_bndrs, body) <- collectNBinders join_arity rhs
- = size_up body
+ = size_up s body
| otherwise
- = size_up rhs
+ = size_up s rhs `addSizeN` size_up_alloc bndr
------------
-- size_up_app is used when there's ONE OR MORE value args
- size_up_app (App fun arg) args voids
- | isTyCoArg arg = size_up_app fun args voids
- | isZeroBitExpr arg = size_up_app fun (arg:args) (voids + 1)
- | otherwise = size_up arg `addSizeNSD`
- size_up_app fun (arg:args) voids
- size_up_app (Var fun) args voids = size_up_call fun args voids
- size_up_app (Tick _ expr) args voids = size_up_app expr args voids
- size_up_app (Cast expr _) args voids = size_up_app expr args voids
- size_up_app other args voids = size_up other `addSizeN`
- callSize (length args) voids
+ size_up_app :: ExprSize -> CoreExpr -> [CoreExpr] -> Int -> ExprSize
+ size_up_app s (App fun arg) args voids
+ | isTyCoArg arg = size_up_app s fun args voids
+ | isZeroBitExpr arg = size_up_app s fun (arg:args) (voids + 1)
+ | otherwise = let arg_size = stripDiscounts $ size_up s arg
+ in size_up_app arg_size fun (arg:args) voids
+ size_up_app s (Var fun) args voids = size_up_call s fun args voids
+ size_up_app s (Tick _ expr) args voids = size_up_app s expr args voids
+ size_up_app s (Cast expr _) args voids = size_up_app s expr args voids
+ size_up_app s other args voids = size_up (s `addSizeN` callSize (length args) voids) other
+
-- if the lhs is not an App or a Var, or an invisible thing like a
-- Tick or Cast, then we should charge for a complete call plus the
-- size of the lhs itself.
------------
- size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize
- size_up_call fun val_args voids
- = case idDetails fun of
- FCallId _ -> sizeN (callSize (length val_args) voids)
- DataConWorkId dc -> conSize dc (length val_args)
- PrimOpId op _ -> primOpSize op (length val_args)
- ClassOpId cls _ -> classOpSize opts cls top_args val_args
- _ | fun `hasKey` buildIdKey -> buildSize
- | fun `hasKey` augmentIdKey -> augmentSize
- | otherwise -> funSize opts top_args fun (length val_args) voids
+ size_up_call :: ExprSize -> Id -> [CoreExpr] -> Int -> ExprSize
+ size_up_call !s fun val_args voids
+ = let !n_args = length val_args
+ call_size = case idDetails fun of
+ FCallId _ -> sizeN (callSize n_args voids)
+ DataConWorkId dc -> conSize dc n_args
+ PrimOpId op _ -> primOpSize op n_args
+ ClassOpId cls _ -> classOpSize opts cls top_args val_args
+ _ | fun `hasKey` buildIdKey -> buildSize
+ | fun `hasKey` augmentIdKey -> augmentSize
+ | otherwise -> funSize opts top_args fun n_args voids
+ in s `addSizeNSD` call_size
------------
- size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10
+ -- size_up_alt returns on the alternatives size, not counting the accumulated
+ -- size passed in unless we reach TooBig. This is to facility better discount
+ -- calculation based on the size of only the alternative.
+ size_up_alt TooBig _ = TooBig
+ size_up_alt (SizeIs {_es_size_is=s}) (Alt _con _bndrs rhs) =
+ size_up (sizeN s) rhs
+ -- Why add and then subtract s?
+ -- If the expression large enough this will ensure we bomb out early.
+ `addSizeN` (10 -s)
+
-- Don't charge for args, so that wrappers look cheap
-- (See comments about wrappers with Case)
--
- -- IMPORTANT: *do* charge 1 for the alternative, else we
+ -- IMPORTANT: *do* charge 10 for the alternative, else we
-- find that giant case nests are treated as practically free
-- A good example is Foreign.C.Error.errnoToIOError
@@ -753,6 +774,14 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
(xs `unionBags` ys)
d2 -- Ignore d1
+ -- Throw away the discount for scrutinizing the expression.
+ -- Used for things like `let x = rhs in body` where we only consider
+ -- this benefit for the body.
+ -- Why? `x` is visible to `body` either way, so it really should not
+ -- affect our inlining decision either way.
+ stripDiscounts TooBig = TooBig
+ stripDiscounts (SizeIs n xs _) = (SizeIs n xs 0)
+
-- don't count expressions such as State# RealWorld
-- exclude join points, because they can be rep-polymorphic
-- and typePrimRep will crash
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b0df4b70c297b296a8dbe711e3baa3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b0df4b70c297b296a8dbe711e3baa3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T23162-spj] Accept error message changes
by Simon Peyton Jones (＠simonpj) 26 Sep '25
by Simon Peyton Jones (＠simonpj) 26 Sep '25
26 Sep '25
Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC
Commits:
e61cec2a by Simon Peyton Jones at 2025-09-26T10:32:06+01:00
Accept error message changes
Plus compile time improvement
Metrics: compile_time/bytes allocated
Baseline
Test value New value Change
---------------------- --------------------------------------
T5030(normal) 173,839,232 148,115,248 -14.8% GOOD
hard_hole_fits(normal) 286,768,048 284,015,416 -1.0%
geo. mean -0.2%
minimum -14.8%
maximum +0.3%
Metric Decrease:
T5030
- - - - -
17 changed files:
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- testsuite/tests/default/default-fail05.stderr
- testsuite/tests/indexed-types/should_fail/T1897b.stderr
- testsuite/tests/indexed-types/should_fail/T9662.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
- testsuite/tests/partial-sigs/should_fail/T14040a.stderr
- testsuite/tests/rep-poly/RepPolyRightSection.stderr
- testsuite/tests/typecheck/no_skolem_info/T14040.stderr
- − testsuite/tests/typecheck/should_compile/T13651.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T8603.stderr
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -778,8 +778,8 @@ Which errors are suppressed?
Historical (SCE2). Fundep constraints never "escape" into the
main solver and so never show up in error messages.
- See Note [Functional dependencies in type inference] inb GHC.Tc.Solver.FunDeps.
- So this wrinkle is now just a historical note.
+ See (SOLVE-FD) in Note [Overview of functional dependencies in type inference]
+ in GHC.Tc.Solver.FunDeps. So this wrinkle is now just a historical note.
Errors which arise from the interaction of two Wanted fun-dep constraints.
Example:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -929,7 +929,7 @@ newFlexiTyVarQL :: QLFlag -> OccName -> MetaInfo -> TcKind -> TcM TcTyVar
newFlexiTyVarQL do_ql occ info kind
= do { lvl <- getTcLevelQL do_ql
; ref <- newMutVar Flexi
- ; name <- newSysName occ -- See Note [Name of an unification variable]
+ ; name <- newSysName occ -- See Note [Name of a unification variable]
-- in GHC.Tc.Utils.TcMType
; let details = MetaTv { mtv_info = info
, mtv_ref = ref
=====================================
compiler/GHC/Tc/Solver/FunDeps.hs
=====================================
@@ -41,33 +41,33 @@ import GHC.Data.Pair
import Data.Maybe( mapMaybe )
-{- Note [Functional dependencies in type inference]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Overview of functional dependencies in type inference]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Here is our plan for dealing with functional dependencies
* When we have failed to solve a Wanted constraint, do this
- 1. Generate any fundep-equalities [FunDepEqns] from that constraint.
- 2. Try to solve that [FunDepEqns]
- 3. If any unifications happened, send the constraint back to the
- start of the pipeline
-
-* Step (1) How we generate those [FunDepEqns] varies:
+ - (GEN-FD) Generate any fundep-equalities [FunDepEqns] from that constraint.
+ - (SOLVE-FD) Try to solve that [FunDepEqns]
+ - (KICK-FD) If any unifications happened,
+ * kick out any inert constraints that mention the unified variables
+ * send the current constraint back to the start of the pipeline;
+ might now be soluble, and it probably isn't inert
+
+* (GEN-FD) How we generate those [FunDepEqns] varies:
- tryDictFunDeps: for class constraints (C t1 .. tn)
we look at top-level instances and inert Givens
- tryEqFunDeps: for type-family equalities (F t1 .. tn ~ ty)
we look at top-level family instances
and inert Given family equalities
-* Step (2). We use `solveFunDeps` to solve the [FunDepEqns] in a nested
+* (SOLVE-FD) We use `solveFunDeps` to solve the [FunDepEqns] in a nested
solver. Key property:
The ONLY effect of `solveFunDeps` is possibly to perform unifications:
-
- It entirely discards any unsolved fundep equalities.
-
- It entirely discards any evidence arising from solving fundep equalities
-* Step (3) if we did any unifications in Step (2), we start again with the
+* (KICK-FD) if we did any unifications in (SOLVE-FD), we start again with the
current unsolved Wanted. It might now be soluble!
* For Given constraints, things are different:
@@ -518,7 +518,8 @@ mkTopUserFamEqFDs fam_tc inj_flags work_args work_rhs
in_scope = mkInScopeSet (tyCoVarsOfType work_rhs)
trim_qtvs :: Subst -> [TcTyVar] -> (Subst,[TcTyVar])
- -- Tricky stuff: see (TF1) in Note [Fundeps and top-level family instances]
+ -- Tricky stuff: see (TIF1) in
+ -- Note [Type inference for type families with injectivity]
trim_qtvs subst [] = (subst, [])
trim_qtvs subst (tv:tvs)
| tv `elemSubst` subst = trim_qtvs subst tvs
@@ -765,7 +766,7 @@ solveFunDeps :: CtEvidence -- The work item
--
-- The returned Bool is True if some unifications happened
--
--- See Note [Overview of fundeps]
+-- See (SOLVE-FD) in Note [Overview of functional dependencies in type inference]
solveFunDeps work_ev fd_eqns
| null fd_eqns
= return False -- Common case no-op
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -1330,7 +1330,7 @@ can't be solved. But not quite all such constraints; see wrinkles.
(IW4) Historical note: we used to have equalities arising from
Wanted/Wanted fundep interactions, which we did not want to treat
as insoluble. But now such fundep constraints never escape.
- See Note [Functional dependencies in type inference]
+ See Note [Overview of functional dependencies in type inference]
Note [Insoluble holes]
~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -598,9 +598,10 @@ data CtOrigin
| ArrowCmdOrigin -- Arising from an arrow command
| AnnOrigin -- An annotation
- | FunDepOrigin -- A functional dependency. We don't need auxiliary info
- -- because fundep constraints never show up in errors
- -- See Note [Functional dependencies in type inference]
+ | FunDepOrigin -- A functional dependency.
+ -- We don't need auxiliary info because fundep constraints
+ -- never show up in errors. See (SOLVE-FD) in
+ -- Note [Overview of functional dependencies in type inference]
| InjTFOrigin1 -- injective type family equation combining
PredType CtOrigin RealSrcSpan -- This constraint arising from ...
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -716,14 +716,14 @@ Proposal 29).
Note [Name of a unification variable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We give unification variables a /System/ Name, which is eagerly elmininated
-the the unifier; see GHC.Tc.Utils.Unify.nicer_to_update_tv1, and
-GHC.Tc.Solver.Equality.canEqTyVarTyVar (nicer_to_update_tv2)
-
-Note [Name of an instantiated type variable]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-At the moment we give a unification variable a System Name, which
-influences the way it is tidied; see TypeRep.tidyTyVarBndr.
+We give unification variables a /System/ Name, which is treated specially
+in two ways
+
+* It is eagerly elmininated the the unifier; see
+ GHC.Tc.Utils.Unify.nicer_to_update_tv1, and
+ GHC.Tc.Solver.Equality.canEqTyVarTyVar (nicer_to_update_tv2)
+
+* It influences the way it is tidied; see TypeRep.tidyTyVarBndr.
-}
newMetaTyVarName :: FastString -> TcM Name
@@ -732,7 +732,7 @@ newMetaTyVarName str
= newSysName (mkTyVarOccFS str)
cloneMetaTyVarName :: Name -> TcM Name
--- See Note [Name of an instantiated type variable]
+-- Makes a /System/ Name; see Note [Name of a unification variable]
cloneMetaTyVarName name
= newSysName (nameOccName name)
=====================================
testsuite/tests/default/default-fail05.stderr
=====================================
@@ -1,7 +1,7 @@
default-fail05.hs:11:10: error: [GHC-39999]
- • Ambiguous type variable ‘t0’ arising from a use of ‘toList’
- prevents the constraint ‘(Foldable t0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘t0’ should be.
+ • Ambiguous type variable ‘f0’ arising from a use of ‘toList’
+ prevents the constraint ‘(Foldable f0)’ from being solved.
+ Probable fix: use a type annotation to specify what ‘f0’ should be.
Potentially matching instances:
instance Foldable (Either a)
-- Defined in ‘GHC.Internal.Data.Foldable’
@@ -14,9 +14,9 @@ default-fail05.hs:11:10: error: [GHC-39999]
In a stmt of a 'do' block: print (toList $ pure 21)
default-fail05.hs:11:19: error: [GHC-39999]
- • Ambiguous type variable ‘t0’ arising from a use of ‘pure’
- prevents the constraint ‘(Applicative t0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘t0’ should be.
+ • Ambiguous type variable ‘f0’ arising from a use of ‘pure’
+ prevents the constraint ‘(Applicative f0)’ from being solved.
+ Probable fix: use a type annotation to specify what ‘f0’ should be.
Potentially matching instances:
instance Applicative IO -- Defined in ‘GHC.Internal.Base’
instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’
@@ -28,11 +28,11 @@ default-fail05.hs:11:19: error: [GHC-39999]
In a stmt of a 'do' block: print (toList $ pure 21)
default-fail05.hs:12:3: error: [GHC-39999]
- • Ambiguous type variable ‘t1’ arising from a use of ‘traverse’
- prevents the constraint ‘(Traversable t1)’ from being solved.
+ • Ambiguous type variable ‘t0’ arising from a use of ‘traverse’
+ prevents the constraint ‘(Traversable t0)’ from being solved.
Relevant bindings include
- main :: IO (t1 ()) (bound at default-fail05.hs:10:1)
- Probable fix: use a type annotation to specify what ‘t1’ should be.
+ main :: IO (t0 ()) (bound at default-fail05.hs:10:1)
+ Probable fix: use a type annotation to specify what ‘t0’ should be.
Potentially matching instances:
instance Traversable (Either a)
-- Defined in ‘GHC.Internal.Data.Traversable’
@@ -51,11 +51,11 @@ default-fail05.hs:12:3: error: [GHC-39999]
traverse print (pure 42)
default-fail05.hs:12:19: error: [GHC-39999]
- • Ambiguous type variable ‘t1’ arising from a use of ‘pure’
- prevents the constraint ‘(Applicative t1)’ from being solved.
+ • Ambiguous type variable ‘t0’ arising from a use of ‘pure’
+ prevents the constraint ‘(Applicative t0)’ from being solved.
Relevant bindings include
- main :: IO (t1 ()) (bound at default-fail05.hs:10:1)
- Probable fix: use a type annotation to specify what ‘t1’ should be.
+ main :: IO (t0 ()) (bound at default-fail05.hs:10:1)
+ Probable fix: use a type annotation to specify what ‘t0’ should be.
Potentially matching instances:
instance Applicative IO -- Defined in ‘GHC.Internal.Base’
instance Applicative Maybe -- Defined in ‘GHC.Internal.Base’
=====================================
testsuite/tests/indexed-types/should_fail/T1897b.stderr
=====================================
@@ -1,14 +1,14 @@
T1897b.hs:16:1: error: [GHC-83865]
- • Couldn't match type: Depend a0
- with: Depend a
- Expected: t (Depend a) -> Bool
- Actual: t (Depend a0) -> Bool
+ • Couldn't match type: Depend b0
+ with: Depend b
+ Expected: t (Depend b) -> Bool
+ Actual: t (Depend b0) -> Bool
Note: ‘Depend’ is a non-injective type family.
- The type variable ‘a0’ is ambiguous
+ The type variable ‘b0’ is ambiguous
• In the ambiguity check for the inferred type for ‘isValid’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
When checking the inferred type
- isValid :: forall {t :: * -> *} {a}.
- (Foldable t, Bug a) =>
- t (Depend a) -> Bool
+ isValid :: forall {t :: * -> *} {b}.
+ (Foldable t, Bug b) =>
+ t (Depend b) -> Bool
=====================================
testsuite/tests/indexed-types/should_fail/T9662.stderr
=====================================
@@ -1,12 +1,12 @@
T9662.hs:49:8: error: [GHC-25897]
- • Couldn't match type ‘k’ with ‘Int’
+ • Couldn't match type ‘n’ with ‘Int’
Expected: Exp (((sh :. k) :. m) :. n)
-> Exp (((sh :. m) :. n) :. k)
Actual: Exp
(Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
-> Exp
(Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
- ‘k’ is a rigid type variable bound by
+ ‘n’ is a rigid type variable bound by
the type signature for:
test :: forall sh k m n.
Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k)
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
=====================================
@@ -1,10 +1,9 @@
-RecordDotSyntaxFail10.hs:40:11: error: [GHC-18872]
- • Couldn't match type ‘Int’ with ‘[Char]’
+RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999]
+ • No instance for ‘HasField "quux" Quux String’
• In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’
In a stmt of a 'do' block: print $ a {foo.bar.baz.quux}
In the expression:
do let a = Foo {foo = ...}
- do let a = ...
let quux = "Expecto patronum!"
print $ a {foo.bar.baz.quux}
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
=====================================
@@ -1,13 +1,10 @@
-RecordDotSyntaxFail13.hs:26:11: error: [GHC-18872]
- • Couldn't match type ‘Int’ with ‘Foo -> Int’
- arising from a functional dependency between:
- constraint ‘HasField "foo" Foo (Foo -> Int)’
- arising from a record update
- instance ‘HasField "foo" Foo Int’
- at RecordDotSyntaxFail13.hs:21:10-31
+RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999]
+ • No instance for ‘HasField "foo" Foo (Foo -> Int)’
+ arising from a record update
+ (maybe you haven't applied a function to enough arguments?)
• In the second argument of ‘($)’, namely ‘a {foo}’
In a stmt of a 'do' block: print $ a {foo}
In the expression:
- do let a = ...
+ do let a = Foo {foo = 12}
print $ a {foo}
=====================================
testsuite/tests/partial-sigs/should_fail/T14040a.stderr
=====================================
@@ -1,6 +1,6 @@
T14040a.hs:26:46: error: [GHC-46956]
- • Couldn't match kind ‘k1’ with ‘WeirdList z’
- Expected kind ‘WeirdList k1’,
+ • Couldn't match kind ‘k0’ with ‘WeirdList z’
+ Expected kind ‘WeirdList k0’,
but ‘xs’ has kind ‘WeirdList (WeirdList z)’
because kind variable ‘z’ would escape its scope
This (rigid, skolem) kind variable is bound by
@@ -24,8 +24,8 @@ T14040a.hs:26:46: error: [GHC-46956]
-> p _ wl
T14040a.hs:27:27: error: [GHC-46956]
- • Couldn't match kind ‘k0’ with ‘z’
- Expected kind ‘WeirdList k0’,
+ • Couldn't match kind ‘k1’ with ‘z’
+ Expected kind ‘WeirdList k1’,
but ‘WeirdCons x xs’ has kind ‘WeirdList z’
because kind variable ‘z’ would escape its scope
This (rigid, skolem) kind variable is bound by
=====================================
testsuite/tests/rep-poly/RepPolyRightSection.stderr
=====================================
@@ -8,6 +8,7 @@ RepPolyRightSection.hs:14:11: error: [GHC-55287]
• *
Cannot unify ‘r’ with the type variable ‘q0’
because the former is not a concrete ‘RuntimeRep’.
- • In the expression: `g` undefined
+ • In the expression: g
+ In the expression: `g` undefined
In an equation for ‘test2’: test2 = (`g` undefined)
=====================================
testsuite/tests/typecheck/no_skolem_info/T14040.stderr
=====================================
@@ -1,6 +1,6 @@
T14040.hs:27:46: error: [GHC-46956]
- • Couldn't match kind ‘k1’ with ‘WeirdList z’
- Expected kind ‘WeirdList k1’,
+ • Couldn't match kind ‘k0’ with ‘WeirdList z’
+ Expected kind ‘WeirdList k0’,
but ‘xs’ has kind ‘WeirdList (WeirdList z)’
because kind variable ‘z’ would escape its scope
This (rigid, skolem) kind variable is bound by
@@ -24,8 +24,8 @@ T14040.hs:27:46: error: [GHC-46956]
-> p _ wl
T14040.hs:28:27: error: [GHC-46956]
- • Couldn't match kind ‘k0’ with ‘z’
- Expected kind ‘WeirdList k0’,
+ • Couldn't match kind ‘k1’ with ‘z’
+ Expected kind ‘WeirdList k1’,
but ‘WeirdCons x xs’ has kind ‘WeirdList z’
because kind variable ‘z’ would escape its scope
This (rigid, skolem) kind variable is bound by
=====================================
testsuite/tests/typecheck/should_compile/T13651.stderr deleted
=====================================
@@ -1,22 +0,0 @@
-
-T13651.hs:12:8: error: [GHC-25897]
- • Could not deduce ‘cr ~ Bar h (Foo r)’
- from the context: (F cr cu ~ Bar h (Bar r u),
- F cu cs ~ Bar (Foo h) (Bar u s))
- bound by the type signature for:
- foo :: forall cr cu h r u cs s.
- (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) =>
- Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
- at T13651.hs:(12,8)-(14,65)
- ‘cr’ is a rigid type variable bound by
- the type signature for:
- foo :: forall cr cu h r u cs s.
- (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) =>
- Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
- at T13651.hs:(12,8)-(14,65)
- • In the ambiguity check for ‘foo’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the type signature:
- foo :: (F cr cu ~ Bar h (Bar r u),
- F cu cs ~ Bar (Foo h) (Bar u s)) =>
- Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -586,7 +586,7 @@ test('T13594', normal, compile_fail, [''])
test('T13603', normal, compile, [''])
test('T13333', normal, compile, [''])
test('T13585', [extra_files(['T13585.hs', 'T13585a.hs', 'T13585b.hs'])], makefile_test, [])
-test('T13651', normal, compile_fail, [''])
+test('T13651', normal, compile, [''])
test('T13651a', normal, compile, [''])
test('T13680', normal, compile, [''])
test('T13785', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_fail/T8603.stderr
=====================================
@@ -3,8 +3,8 @@ T8603.hs:33:17: error: [GHC-18872]
When matching types
m0 :: * -> *
[a2] :: *
- Expected: [a2] -> StateT s RV a0
- Actual: t0 m0 (StateT s RV a0)
+ Expected: [a2] -> StateT s RV a1
+ Actual: t0 m0 (StateT s RV a1)
• The function ‘lift’ is applied to two visible arguments,
but its type ‘(Control.Monad.Trans.Class.MonadTrans t, Monad m) =>
m a -> t m a’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e61cec2ab4aed4b049d29121d8f7dbd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e61cec2ab4aed4b049d29121d8f7dbd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Document etymology of "bind" as the name for `>>=`
by Marge Bot (＠marge-bot) 26 Sep '25
by Marge Bot (＠marge-bot) 26 Sep '25
26 Sep '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
b418408b by Irene Knapp at 2025-09-25T09:47:54-04:00
Document etymology of "bind" as the name for `>>=`
It took me twenty years of contemplation to realize why it's called that.
I therefore feel that it may not be obvious to beginners.
- - - - -
e9c5e46f by Brandon Chinn at 2025-09-25T09:48:36-04:00
Fix tabs in string gaps (#26415)
Tabs in string gaps were broken in bb030d0d because previously, string gaps were manually parsed, but now it's lexed by the usual Alex grammar and post-processed after successful lexing.
It broke because of a discrepancy between GHC's lexer grammar and the Haskell Report. The Haskell Report includes tabs in whitechar:
whitechar → newline | vertab | space | tab | uniWhite
$whitechar used to include tabs until 18 years ago, when it was removed in order to exclude tabs from $white_no_nl in order to warn on tabs: 6e202120. In this MR, I'm adding \t back into $whitechar, and explicitly excluding \t from the $white_no_nl+ rule ignoring all whitespace in source code, which more accurately colocates the "ignore all whitespace except tabs, which is handled in the next line" logic.
As a side effect of this MR, tabs are now allowed in pragmas; currently, a pragma written as {-# \t LANGUAGE ... #-} is interpreted as the tab character being the pragma name, and GHC warns "Unrecognized pragma". With this change, tabs are ignored as whitespace, which more closely matches the Report anyway.
- - - - -
8bf5b309 by Cheng Shao at 2025-09-25T09:49:18-04:00
wasm: remove the --no-turbo-fast-api-calls hack from dynamic linker shebang
This patch removes the `--no-turbo-fast-api-calls` hack from the dyld
script shebang; it was used to workaround v8 fast call coredumps in
nodejs and no longer needed, and comes with a performance penalty,
hence the removal.
- - - - -
35622b41 by Sylvain Henry at 2025-09-26T05:25:33-04:00
Revert "Add necessary flag for js linking"
This reverts commit 84f68e2231b2eddb2e1dc4e90af394ef0f2e803f.
This commit didn't have the expected effect. See discussion in #26290.
Instead we export HEAP8 and HEAPU8 from rts/js/mem.js
- - - - -
179265cd by Sylvain Henry at 2025-09-26T05:25:33-04:00
JS: export HEAPU8 (#26290)
This is now required by newer Emscripten versions.
- - - - -
ad319868 by Andreas Klebinger at 2025-09-26T05:25:34-04:00
sizeExpr: Improve Tick handling.
When determining if we scrutinize a function argument we
now properly look through ticks. Fixes #26444.
- - - - -
12 changed files:
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/Lexer/String.x
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- m4/fptools_set_c_ld_flags.m4
- rts/js/mem.js
- testsuite/driver/testlib.py
- + testsuite/tests/parser/should_run/T26415.hs
- + testsuite/tests/parser/should_run/T26415.stdout
- testsuite/tests/parser/should_run/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
- utils/jsffi/dyld.mjs
Changes:
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -637,6 +637,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
where
is_top_arg (Var v) | v `elem` top_args = Just v
is_top_arg (Cast e _) = is_top_arg e
+ is_top_arg (Tick _t e) = is_top_arg e
is_top_arg _ = Nothing
where
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -145,7 +145,7 @@ import GHC.Parser.String
$unispace = \x05 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
$nl = [\n\r\f]
$space = [\ $unispace]
-$whitechar = [$nl \v $space]
+$whitechar = [$nl \t \v $space]
$white_no_nl = $whitechar # \n -- TODO #8424
$tab = \t
@@ -248,7 +248,7 @@ haskell :-
-- Alex "Rules"
-- everywhere: skip whitespace
-$white_no_nl+ ;
+($white_no_nl # \t)+ ;
$tab { warnTab }
-- Everywhere: deal with nested comments. We explicitly rule out
=====================================
compiler/GHC/Parser/Lexer/String.x
=====================================
@@ -25,7 +25,7 @@ import GHC.Utils.Panic (panic)
$unispace = \x05 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
$nl = [\n\r\f]
$space = [\ $unispace]
-$whitechar = [$nl \v $space]
+$whitechar = [$nl \t \v $space]
$tab = \t
$ascdigit = 0-9
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -1353,9 +1353,9 @@ class Applicative m => Monad m where
-- bs a
-- @
--
- -- An alternative name for this function is \'bind\', but some people
- -- may refer to it as \'flatMap\', which results from it being equivalent
- -- to
+ -- An alternative name for this function is \'bind\', because it
+ -- is used to introduce bindings in monadic contexts, but some people may
+ -- refer to it as \'flatMap\', which results from it being equivalent to
--
-- @\\x f -> 'join' ('fmap' f x) :: Monad m => m a -> (a -> m b) -> m b@
--
=====================================
m4/fptools_set_c_ld_flags.m4
=====================================
@@ -109,9 +109,6 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
$2="$$2 -mcmodel=medium"
;;
- javascript*)
- $3="$$3 -sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8"
-
esac
AC_MSG_RESULT([done])
=====================================
rts/js/mem.js
=====================================
@@ -1,5 +1,5 @@
//#OPTIONS:CPP
-//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8
+//#OPTIONS:EMCC:EXPORTED_RUNTIME_METHODS=addFunction,removeFunction,getEmptyTableSlot,HEAP8,HEAPU8
// #define GHCJS_TRACE_META 1
=====================================
testsuite/driver/testlib.py
=====================================
@@ -3005,7 +3005,7 @@ def normalise_errmsg(s: str) -> str:
# Emscripten displays cache info and old emcc doesn't support EMCC_LOGGING=0
s = re.sub('cache:INFO: .*\n', '', s)
# Old emcc warns when we export HEAP8 but new one requires it (see #26290)
- s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
+ s = s.replace('warning: invalid item in EXPORTED_RUNTIME_METHODS: HEAP8\nwarning: invalid item in EXPORTED_RUNTIME_METHODS: HEAPU8\nemcc: warning: warnings in JS library compilation [-Wjs-compiler]\n','')
return s
=====================================
testsuite/tests/parser/should_run/T26415.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE MultilineStrings #-}
+
+main :: IO ()
+main = do
+ -- The below strings contain the characters ['\\', '\t', '\\']
+ print "\ \"
+ print """\ \"""
=====================================
testsuite/tests/parser/should_run/T26415.stdout
=====================================
@@ -0,0 +1,2 @@
+""
+""
=====================================
testsuite/tests/parser/should_run/all.T
=====================================
@@ -27,6 +27,7 @@ test('RecordDotSyntax4', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compil
test('RecordDotSyntax5', normal, compile_and_run, [''])
test('ListTuplePunsConstraints', extra_files(['ListTuplePunsConstraints.hs']), ghci_script, ['ListTuplePunsConstraints.script'])
test('T25937', normal, compile_and_run, [''])
+test('T26415', normal, compile_and_run, [''])
# Multiline strings
test('MultilineStrings', normal, compile_and_run, [''])
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
=====================================
@@ -324,10 +324,6 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do
ArchOS ArchPPC OSAIX ->
-- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`.
return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"])
- ArchOS ArchJavaScript OSGhcjs ->
- -- Since https://github.com/emscripten-core/emscripten/blob/main/ChangeLog.md#407---…
- -- the emcc linker does not export the HEAP8 memory view which is used by the js RTS by default anymore.
- return $ ccLink2 & _prgFlags %++ "-sEXPORTED_RUNTIME_METHODS=HEAP8,HEAPU8"
_ ->
return ccLink2
=====================================
utils/jsffi/dyld.mjs
=====================================
@@ -1,4 +1,4 @@
-#!/usr/bin/env -S node --disable-warning=ExperimentalWarning --max-old-space-size=65536 --no-turbo-fast-api-calls --wasm-lazy-validation
+#!/usr/bin/env -S node --disable-warning=ExperimentalWarning --max-old-space-size=65536 --wasm-lazy-validation
// Note [The Wasm Dynamic Linker]
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/893a94deae6551baac3b4b3e964046…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/893a94deae6551baac3b4b3e964046…
You're receiving this email because of your account on gitlab.haskell.org.
1
0