[Git][ghc/ghc][master] 3 commits: ipe: Place strings and metadata into specific .ipe section
by Marge Bot (@marge-bot) 08 Aug '25
by Marge Bot (@marge-bot) 08 Aug '25
08 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1903ae35 by Matthew Pickering at 2025-08-07T12:21:10+01:00
ipe: Place strings and metadata into specific .ipe section
By placing the .ipe metadata into a specific section it can be stripped
from the final binary if desired.
```
objcopy --remove-section .ipe <binary>
upx <binary>
```
Towards #21766
- - - - -
c80dd91c by Matthew Pickering at 2025-08-07T12:22:42+01:00
ipe: Place magic word at the start of entries in the .ipe section
The magic word "IPE\nIPE\n" is placed at the start of .ipe sections,
then if the section is stripped, we can check whether the section starts
with the magic word or not to determine whether there is metadata
present or not.
Towards #21766
- - - - -
cab42666 by Matthew Pickering at 2025-08-07T12:22:42+01:00
ipe: Use stable IDs for IPE entries
IPEs have historically been indexed and reported by their address.
This makes it impossible to compare profiles between runs, since the
addresses may change (due to ASLR) and also makes it tricky to separate
out the IPE map from the binary.
This small patch adds a stable identifier for each IPE entry.
The stable identifier is a single 64 bit word. The high-bits are a
per-module identifier and the low bits identify which entry in each
module.
1. When a node is added into the IPE buffer it is assigned a unique
identifier from an incrementing global counter.
2. Each entry already has an index by it's position in the
`IpeBufferListNode`.
The two are combined together by the `IPE_ENTRY_KEY` macro.
Info table profiling uses the stable identifier rather than the address
of the info table.
The benefits of this change are:
* Profiles from different runs can be easily compared
* The metadata can be extracted from the binary (via the eventlog for
example) and then stripped from the executable.
Fixes #21766
- - - - -
12 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- docs/users_guide/debug-info.rst
- rts/IPE.c
- rts/ProfHeap.c
- rts/eventlog/EventLog.c
- rts/include/rts/IPE.h
- testsuite/tests/rts/ipe/ipeMap.c
- testsuite/tests/rts/ipe/ipe_lib.c
Changes:
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -278,6 +278,7 @@ data SectionType
| InitArray -- .init_array on ELF, .ctor on Windows
| FiniArray -- .fini_array on ELF, .dtor on Windows
| CString
+ | IPE
| OtherSection String
deriving (Show)
@@ -298,6 +299,7 @@ sectionProtection (Section t _) = case t of
CString -> ReadOnlySection
Data -> ReadWriteSection
UninitialisedData -> ReadWriteSection
+ IPE -> ReadWriteSection
(OtherSection _) -> ReadWriteSection
{-
@@ -557,4 +559,5 @@ pprSectionType s = doubleQuotes $ case s of
InitArray -> text "initarray"
FiniArray -> text "finiarray"
CString -> text "cstring"
+ IPE -> text "ipe"
OtherSection s' -> text s'
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -285,6 +285,9 @@ pprAlignForSection platform seg = line $
Data
| ppc64 -> text ".align 3"
| otherwise -> text ".align 2"
+ IPE
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
ReadOnlyData
| ppc64 -> text ".align 3"
| otherwise -> text ".align 2"
=====================================
compiler/GHC/CmmToAsm/Ppr.hs
=====================================
@@ -236,6 +236,10 @@ pprGNUSectionHeader config t suffix =
| OSMinGW32 <- platformOS platform
-> text ".rdata"
| otherwise -> text ".rodata.str"
+ IPE
+ | OSMinGW32 <- platformOS platform
+ -> text ".rdata"
+ | otherwise -> text ".ipe"
OtherSection _ ->
panic "PprBase.pprGNUSectionHeader: unknown section type"
flags = case t of
@@ -248,6 +252,10 @@ pprGNUSectionHeader config t suffix =
| OSMinGW32 <- platformOS platform
-> empty
| otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
+ IPE
+ | OSMinGW32 <- platformOS platform
+ -> empty
+ | otherwise -> text ",\"a\"," <> sectionType platform "progbits"
_ -> empty
{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-}
{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
@@ -262,6 +270,7 @@ pprXcoffSectionHeader t = case t of
RelocatableReadOnlyData -> text ".csect .text[PR] # RelocatableReadOnlyData"
CString -> text ".csect .text[PR] # CString"
UninitialisedData -> text ".csect .data[BS]"
+ IPE -> text ".csect .text[PR] #IPE"
_ -> panic "pprXcoffSectionHeader: unknown section type"
{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> SDoc #-}
{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
@@ -276,6 +285,7 @@ pprDarwinSectionHeader t = case t of
InitArray -> text ".section\t__DATA,__mod_init_func,mod_init_funcs"
FiniArray -> panic "pprDarwinSectionHeader: fini not supported"
CString -> text ".section\t__TEXT,__cstring,cstring_literals"
+ IPE -> text ".const"
OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type"
{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> SDoc #-}
{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -145,7 +145,7 @@ llvmSectionType p t = case t of
CString -> case platformOS p of
OSMinGW32 -> fsLit ".rdata$str"
_ -> fsLit ".rodata.str"
-
+ IPE -> fsLit ".ipe"
InitArray -> panic "llvmSectionType: InitArray"
FiniArray -> panic "llvmSectionType: FiniArray"
OtherSection _ -> panic "llvmSectionType: unknown section type"
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -10,6 +10,7 @@ import qualified Data.ByteString.Internal as BSI
import GHC.IO (unsafePerformIO)
#endif
+import Data.Char
import GHC.Prelude
import GHC.Platform
import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
@@ -66,6 +67,28 @@ construction, the 'compressed' field of each IPE buffer list node is examined.
If the field indicates that the data has been compressed, the entry data and
strings table are decompressed before continuing with the normal IPE map
construction.
+
+Note [IPE Stripping and magic words]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+For systems which support ELF executables:
+
+The metadata part of IPE info is placed into a separate ELF section (.ipe).
+This can then be stripped afterwards if you don't require the metadata
+
+```
+-- Remove the section
+objcopy --remove-section .ipe <your-exe>
+-- Repack and compress the executable
+upx <your-exe>
+```
+
+The .ipe section starts with a magic 64-bit word "IPE\0IPE\0`, encoded as ascii.
+
+The RTS checks to see if the .ipe section starts with the magic word. If the
+section has been stripped then it won't start with the magic word and the
+metadata won't be accessible for the info tables.
+
-}
emitIpeBufferListNode ::
@@ -110,7 +133,7 @@ emitIpeBufferListNode this_mod ents dus0 = do
strings_bytes = compress defaultCompressionLevel uncompressed_strings
strings :: [CmmStatic]
- strings = [CmmString strings_bytes]
+ strings = [CmmString (ipe_header `mappend` strings_bytes)]
uncompressed_entries :: BS.ByteString
uncompressed_entries = toIpeBufferEntries (platformByteOrder platform) cg_ipes
@@ -119,16 +142,42 @@ emitIpeBufferListNode this_mod ents dus0 = do
entries_bytes = compress defaultCompressionLevel uncompressed_entries
entries :: [CmmStatic]
- entries = [CmmString entries_bytes]
+ entries = [CmmString (ipe_header `mappend` entries_bytes)]
ipe_buffer_lbl :: CLabel
ipe_buffer_lbl = mkIPELabel this_mod
+ -- A string which fits into one 64-bit word.
+ ipe_header_word :: Word64
+ ipe_header_word = stringToWord64BE "IPE\0IPE\0"
+
+ -- Convert 8 bytes to Word64 using big-endian interpretation
+ stringToWord64BE :: String -> Word64
+ stringToWord64BE = foldl' (\acc b -> GHC.Prelude.shiftL acc 8 .|. fromIntegral (ord b)) 0
+
+ -- A magic word we can use to see if the IPE information has been stripped
+ -- or not
+ -- See Note [IPE Stripping and magic words]
+ -- When read then literally the string should read IPE\0IPE\0 in hex dumps.
+ --
+ -- There is some complexity here to turn this into a ByteString rather than
+ -- a simpler CmmStaticLit, since the unregistered backend does not cope well
+ -- with CmmStaticsRaw being a mixure of CmmStaticLit and CmmString.
+ ipe_header :: BS.ByteString
+ ipe_header = BSL.toStrict . BSB.toLazyByteString $
+ case platformByteOrder platform of
+ LittleEndian -> BSB.word64LE ipe_header_word
+ BigEndian -> BSB.word64BE ipe_header_word
+
+
ipe_buffer_node :: [CmmStatic]
ipe_buffer_node = map CmmStaticLit
[ -- 'next' field
zeroCLit platform
+ -- 'node_id' field
+ , zeroCLit platform
+
-- 'compressed' field
, int do_compress
@@ -164,12 +213,12 @@ emitIpeBufferListNode this_mod ents dus0 = do
-- Emit the strings table
emitDecl $ CmmData
- (Section Data strings_lbl)
+ (Section IPE strings_lbl)
(CmmStaticsRaw strings_lbl strings)
-- Emit the list of IPE buffer entries
emitDecl $ CmmData
- (Section Data entries_lbl)
+ (Section IPE entries_lbl)
(CmmStaticsRaw entries_lbl entries)
-- Emit the IPE buffer list node
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -391,6 +391,17 @@ to a source location. This lookup table is generated by using the ``-finfo-table
In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map`
enabled build results was reduced by over 20% when compression was enabled.
+ The metadata for ``-finfo-table-map`` is stored in the ``.ipe`` section on
+ ELF platforms. The ``.ipe`` section can be removed from the binary after compilation::
+
+ objcopy --remove-section .ipe <binary>
+ upx <binary>
+
+ You can first compile your application with ``-finfo-table-map``, extract
+ the contents of the map (by using the eventlog), strip the ``.ipe`` section
+ and then use the extracted data to interpret a ``-hi`` profile from the stripped
+ binary.
+
:since: 9.10
:implies: :ghc-flag:`-finfo-table-map-with-stack`
:implies: :ghc-flag:`-finfo-table-map-with-fallback`
=====================================
rts/IPE.c
=====================================
@@ -62,6 +62,22 @@ entry's containing IpeBufferListNode and its index in that node.
When the user looks up an IPE entry, we convert it to the user-facing
InfoProvEnt representation.
+Note [Stable identifiers for IPE entries]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Each IPE entry is given a stable identifier which remains the same across
+different runs of the executable (unlike the address of the info table).
+
+The identifier is a 64-bit word which consists of two parts.
+
+* The high 32-bits are a per-node identifier.
+* The low 32-bits are the index of the entry in the node.
+
+When a node is queued in the pending list by `registerInfoProvList` it is
+given a unique identifier from an incrementing global variable.
+
+The unique key can be computed by using the `IPE_ENTRY_KEY` macro.
+
*/
typedef struct {
@@ -69,6 +85,13 @@ typedef struct {
uint32_t idx;
} IpeMapEntry;
+// See Note [Stable identifiers for IPE entries]
+#define IPE_ENTRY_KEY(entry) \
+ MAKE_IPE_KEY((entry).node->node_id, (entry).idx)
+
+#define MAKE_IPE_KEY(module_id, idx) \
+ ((((uint64_t)(module_id)) << 32) | ((uint64_t)(idx)))
+
#if defined(THREADED_RTS)
static Mutex ipeMapLock;
#endif
@@ -78,9 +101,22 @@ static HashTable *ipeMap = NULL;
// Accessed atomically
static IpeBufferListNode *ipeBufferList = NULL;
+// A global counter which is used to give an IPE entry a unique value across runs.
+static StgWord next_module_id = 1; // Start at 1 to reserve 0 as "invalid"
+
static void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*);
static void updateIpeMap(void);
+// Check whether the IpeBufferListNode has the relevant magic words.
+// See Note [IPE Stripping and magic words]
+static inline bool ipe_node_valid(const IpeBufferListNode *node) {
+ return node &&
+ node->entries_block &&
+ node->string_table_block &&
+ node->entries_block->magic == IPE_MAGIC_WORD &&
+ node->string_table_block->magic == IPE_MAGIC_WORD;
+}
+
#if defined(THREADED_RTS)
void initIpe(void) { initMutex(&ipeMapLock); }
@@ -99,11 +135,12 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
{
CHECK(idx < node->count);
CHECK(!node->compressed);
- const char *strings = node->string_table;
- const IpeBufferEntry *ent = &node->entries[idx];
+ const char *strings = node->string_table_block->string_table;
+ const IpeBufferEntry *ent = &node->entries_block->entries[idx];
return (InfoProvEnt) {
.info = node->tables[idx],
.prov = {
+ .info_prov_id = MAKE_IPE_KEY(node->node_id, idx),
.table_name = &strings[ent->table_name],
.closure_desc = ent->closure_desc,
.ty_desc = &strings[ent->ty_desc],
@@ -121,19 +158,23 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
const void *value) {
const IpeMapEntry *map_ent = (const IpeMapEntry *)value;
- const InfoProvEnt ipe = ipeBufferEntryToIpe(map_ent->node, map_ent->idx);
- traceIPE(&ipe);
+ if (ipe_node_valid(map_ent->node)){
+ const InfoProvEnt ipe = ipeBufferEntryToIpe(map_ent->node, map_ent->idx);
+ traceIPE(&ipe);
+ }
}
void dumpIPEToEventLog(void) {
// Dump pending entries
IpeBufferListNode *node = RELAXED_LOAD(&ipeBufferList);
while (node != NULL) {
- decompressIPEBufferListNodeIfCompressed(node);
+ if (ipe_node_valid(node)){
+ decompressIPEBufferListNodeIfCompressed(node);
- for (uint32_t i = 0; i < node->count; i++) {
- const InfoProvEnt ent = ipeBufferEntryToIpe(node, i);
- traceIPE(&ent);
+ for (uint32_t i = 0; i < node->count; i++) {
+ const InfoProvEnt ent = ipeBufferEntryToIpe(node, i);
+ traceIPE(&ent);
+ }
}
node = node->next;
}
@@ -165,11 +206,30 @@ ipeMapLock; we instead use atomic CAS operations to add to the list.
A performance test for IPE registration and lookup can be found here:
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806
+
+Note that IPEs are still regiestered even if the .ipe section is stripped. That's
+because you may still want to query what the unique identifier for an info table is
+so it can be reconciled with previously extracted metadata information. For example,
+when `-hi` profiling or using `whereFrom`.
+
*/
void registerInfoProvList(IpeBufferListNode *node) {
+
+ // Grab a fresh module_id
+ uint32_t module_id;
+ StgWord temp_module_id;
+ while (true) {
+ temp_module_id = next_module_id;
+ if (cas(&next_module_id, temp_module_id, temp_module_id+1) == temp_module_id) {
+ module_id = (uint32_t) temp_module_id;
+ break;
+ }
+
+ }
while (true) {
IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList);
node->next = old;
+ node->node_id = module_id;
if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) {
return;
}
@@ -183,7 +243,7 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf) {
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) {
updateIpeMap();
IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)info);
- if (map_ent) {
+ if (map_ent && ipe_node_valid(map_ent->node)) {
*out = ipeBufferEntryToIpe(map_ent->node, map_ent->idx);
return true;
} else {
@@ -191,6 +251,18 @@ bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) {
}
}
+// Returns 0 when the info table is not present in the info table map.
+// See Note [Stable identifiers for IPE entries]
+uint64_t lookupIPEId(const StgInfoTable *info) {
+ updateIpeMap();
+ IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)(info));
+ if (map_ent){
+ return IPE_ENTRY_KEY(*map_ent);
+ } else {
+ return 0;
+ }
+}
+
void updateIpeMap(void) {
// Check if there's any work at all. If not so, we can circumvent locking,
// which decreases performance.
=====================================
rts/ProfHeap.c
=====================================
@@ -23,6 +23,7 @@
#include "Printer.h"
#include "Trace.h"
#include "sm/GCThread.h"
+#include "IPE.h"
#include <fs_rts.h>
#include <string.h>
@@ -230,9 +231,10 @@ closureIdentity( const StgClosure *p )
return closure_type_names[info->type];
}
}
- case HEAP_BY_INFO_TABLE: {
- return get_itbl(p);
- }
+ case HEAP_BY_INFO_TABLE:
+ {
+ return (void *) (p->header.info);
+ }
default:
barf("closureIdentity");
@@ -853,6 +855,20 @@ aggregateCensusInfo( void )
}
#endif
+static void
+recordIPEHeapSample(FILE *hp_file, uint64_t table_id, size_t count)
+{
+ // Print to heap profile file
+ fprintf(hp_file, "0x%" PRIx64, table_id);
+
+ // Create label string for tracing
+ char str[100];
+ sprintf(str, "0x%" PRIx64, table_id);
+
+ // Emit the profiling sample (convert count to bytes)
+ traceHeapProfSampleString(str, count * sizeof(W_));
+}
+
/* -----------------------------------------------------------------------------
* Print out the results of a heap census.
* -------------------------------------------------------------------------- */
@@ -915,6 +931,11 @@ dumpCensus( Census *census )
}
#endif
+ // Census entries which we need to group together.
+ // Used by IPE profiling to group together bands which don't have IPE information.
+ // Printing at the end in the 0 band
+ uint64_t uncategorised_count = 0;
+
for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
#if defined(PROFILING)
@@ -945,11 +966,15 @@ dumpCensus( Census *census )
count * sizeof(W_));
break;
case HEAP_BY_INFO_TABLE:
- fprintf(hp_file, "%p", ctr->identity);
- char str[100];
- sprintf(str, "%p", ctr->identity);
- traceHeapProfSampleString(str, count * sizeof(W_));
+ {
+ uint64_t table_id = lookupIPEId(ctr->identity);
+ if (! table_id) {
+ uncategorised_count += count;
+ continue;
+ }
+ recordIPEHeapSample(hp_file, table_id, count);
break;
+ }
#if defined(PROFILING)
case HEAP_BY_CCS:
fprint_ccs(hp_file, (CostCentreStack *)ctr->identity,
@@ -1002,6 +1027,16 @@ dumpCensus( Census *census )
fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_));
}
+ // Print the unallocated data into the 0 band for info table profiling.
+ switch (RtsFlags.ProfFlags.doHeapProfile) {
+ case HEAP_BY_INFO_TABLE:
+ recordIPEHeapSample(hp_file, 0, uncategorised_count);
+ break;
+ default:
+ ASSERT(uncategorised_count == 0);
+ break;
+ }
+
traceHeapProfSampleEnd(era);
printSample(false, census->time);
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -1480,7 +1480,7 @@ void postIPE(const InfoProvEnt *ipe)
CHECK(!ensureRoomForVariableEvent(&eventBuf, len));
postEventHeader(&eventBuf, EVENT_IPE);
postPayloadSize(&eventBuf, len);
- postWord64(&eventBuf, (StgWord) INFO_PTR_TO_STRUCT(ipe->info));
+ postWord64(&eventBuf, (StgWord) (ipe->prov.info_prov_id));
postStringLen(&eventBuf, ipe->prov.table_name, table_name_len);
postStringLen(&eventBuf, closure_desc_buf, closure_desc_len);
postStringLen(&eventBuf, ipe->prov.ty_desc, ty_desc_len);
=====================================
rts/include/rts/IPE.h
=====================================
@@ -14,6 +14,7 @@
#pragma once
typedef struct InfoProv_ {
+ uint64_t info_prov_id;
const char *table_name;
uint32_t closure_desc; // closure type
const char *ty_desc;
@@ -63,9 +64,37 @@ typedef struct {
GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof(IpeBufferEntry) must be a multiple of the word size");
+// The magic word is IPE\nIPE\n, which occupies the full 64 bit width of a word.
+// See Note [IPE Stripping and magic words]
+#define IPE_MAGIC_WORD 0x4950450049504500UL
+
+// Heap profiling currently requires a 32 bit pointer.. so for now just truncate
+// the key to fit. It should still be big enough.
+#if SIZEOF_VOID_P == 4
+// On 32-bit systems: keep lower 16 bits of module_id and idx
+#define IPE_PROF_KEY(key64) \
+ (uint32_t)((((key64) >> 16) & 0xFFFF0000) | ((key64) & 0x0000FFFF))
+#else
+// On 64-bit systems: use full key
+#define IPE_PROF_KEY(key64) (key64)
+#endif
+
+typedef struct {
+ StgWord64 magic; // Must be IPE_MAGIC_WORD
+ IpeBufferEntry entries[]; // Flexible array member
+} IpeBufferEntryBlock;
+
+typedef struct {
+ StgWord64 magic; // Must be IPE_MAGIC_WORD
+ char string_table[]; // Flexible array member for string table
+} IpeStringTableBlock;
+
typedef struct IpeBufferListNode_ {
struct IpeBufferListNode_ *next;
+ // This field is filled in when the node is registered.
+ uint32_t node_id;
+
// Everything below is read-only and generated by the codegen
// This flag should be treated as a boolean
@@ -76,10 +105,10 @@ typedef struct IpeBufferListNode_ {
// When TNTC is enabled, these will point to the entry code
// not the info table itself.
const StgInfoTable **tables;
- IpeBufferEntry *entries;
+ IpeBufferEntryBlock *entries_block;
StgWord entries_size; // decompressed size
- const char *string_table;
+ const IpeStringTableBlock *string_table_block;
StgWord string_table_size; // decompressed size
// Shared by all entries
@@ -98,6 +127,8 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf);
// Returns true on success, initializes `out`.
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out);
+uint64_t lookupIPEId(const StgInfoTable *info);
+
#if defined(DEBUG)
void printIPE(const StgInfoTable *info);
#endif
=====================================
testsuite/tests/rts/ipe/ipeMap.c
=====================================
@@ -48,7 +48,8 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
// Allocate buffers for IPE buffer list node
IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
node->tables = malloc(sizeof(StgInfoTable *));
- node->entries = malloc(sizeof(IpeBufferEntry));
+ node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry));
+ node->entries_block->magic = IPE_MAGIC_WORD;
StringTable st;
init_string_table(&st);
@@ -61,9 +62,13 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
node->compressed = 0;
node->count = 1;
node->tables[0] = get_itbl(fortyTwo);
- node->entries[0] = makeAnyProvEntry(cap, &st, 42);
+ node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 42);
node->entries_size = sizeof(IpeBufferEntry);
- node->string_table = st.buffer;
+
+ IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size);
+ string_table_block->magic = IPE_MAGIC_WORD;
+ memcpy(string_table_block->string_table, st.buffer, st.size);
+ node->string_table_block = string_table_block;
node->string_table_size = st.size;
registerInfoProvList(node);
@@ -90,7 +95,8 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
// Allocate buffers for IPE buffer list node
IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
node->tables = malloc(sizeof(StgInfoTable *));
- node->entries = malloc(sizeof(IpeBufferEntry));
+ node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry));
+ node->entries_block->magic = IPE_MAGIC_WORD;
StringTable st;
init_string_table(&st);
@@ -103,9 +109,12 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
node->compressed = 0;
node->count = 1;
node->tables[0] = get_itbl(twentyThree);
- node->entries[0] = makeAnyProvEntry(cap, &st, 23);
+ node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 23);
node->entries_size = sizeof(IpeBufferEntry);
- node->string_table = st.buffer;
+ IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size);
+ string_table_block->magic = IPE_MAGIC_WORD;
+ memcpy(string_table_block->string_table, st.buffer, st.size);
+ node->string_table_block = string_table_block;
node->string_table_size = st.size;
registerInfoProvList(node);
@@ -121,7 +130,8 @@ void shouldFindTwoFromTheSameList(Capability *cap) {
// Allocate buffers for IPE buffer list node
IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
node->tables = malloc(sizeof(StgInfoTable *) * 2);
- node->entries = malloc(sizeof(IpeBufferEntry) * 2);
+ node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry) * 2);
+ node->entries_block->magic = IPE_MAGIC_WORD;
StringTable st;
init_string_table(&st);
@@ -133,10 +143,13 @@ void shouldFindTwoFromTheSameList(Capability *cap) {
node->count = 2;
node->tables[0] = get_itbl(one);
node->tables[1] = get_itbl(two);
- node->entries[0] = makeAnyProvEntry(cap, &st, 1);
- node->entries[1] = makeAnyProvEntry(cap, &st, 2);
+ node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 1);
+ node->entries_block->entries[1] = makeAnyProvEntry(cap, &st, 2);
node->entries_size = sizeof(IpeBufferEntry) * 2;
- node->string_table = st.buffer;
+ IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size);
+ string_table_block->magic = IPE_MAGIC_WORD;
+ memcpy(string_table_block->string_table, st.buffer, st.size);
+ node->string_table_block = string_table_block;
node->string_table_size = st.size;
registerInfoProvList(node);
@@ -152,7 +165,11 @@ void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) {
IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
node->count = 0;
node->next = NULL;
- node->string_table = "";
+ IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64));
+ string_table_block->magic = IPE_MAGIC_WORD;
+
+ node->entries_block = malloc(sizeof(StgWord64));
+ node->entries_block->magic = IPE_MAGIC_WORD;
registerInfoProvList(node);
=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -64,7 +64,8 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) {
// Allocate buffers for IpeBufferListNode
IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode));
node->tables = malloc(sizeof(StgInfoTable *) * n);
- node->entries = malloc(sizeof(IpeBufferEntry) * n);
+ node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry) * n);
+ node->entries_block->magic = IPE_MAGIC_WORD;
StringTable st;
init_string_table(&st);
@@ -83,14 +84,19 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) {
for (int i=start; i < end; i++) {
HaskellObj closure = rts_mkInt(cap, 42);
node->tables[i] = get_itbl(closure);
- node->entries[i] = makeAnyProvEntry(cap, &st, i);
+ node->entries_block->entries[i] = makeAnyProvEntry(cap, &st, i);
}
// Set the rest of the fields
node->next = NULL;
node->compressed = 0;
node->count = n;
- node->string_table = st.buffer;
+
+ IpeStringTableBlock *string_table_block =
+ malloc(sizeof(StgWord64) + st.size);
+ string_table_block->magic = IPE_MAGIC_WORD;
+ memcpy(string_table_block->string_table, st.buffer, st.size);
+ node->string_table_block = string_table_block;
return node;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/358bc4fc8324a0685f336142d0d608…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/358bc4fc8324a0685f336142d0d608…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T23162-spj] Kill off kickOutAfterUnification
by Simon Peyton Jones (@simonpj) 07 Aug '25
by Simon Peyton Jones (@simonpj) 07 Aug '25
07 Aug '25
Simon Peyton Jones pushed to branch wip/T23162-spj at Glasgow Haskell Compiler / GHC
Commits:
a5170b29 by Simon Peyton Jones at 2025-08-08T00:44:10+01:00
Kill off kickOutAfterUnification
- - - - -
4 changed files:
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -395,9 +395,9 @@ tryConstraintDefaulting wc
| isEmptyWC wc
= return wc
| otherwise
- = do { (n_unifs, better_wc) <- reportUnifications (go_wc wc)
+ = do { (unif_happened, better_wc) <- reportUnifications (go_wc wc)
-- We may have done unifications; so solve again
- ; solveAgainIf (n_unifs > 0) better_wc }
+ ; solveAgainIf unif_happened better_wc }
where
go_wc :: WantedConstraints -> TcS WantedConstraints
go_wc wc@(WC { wc_simple = simples, wc_impl = implics })
=====================================
compiler/GHC/Tc/Solver/FunDeps.hs
=====================================
@@ -397,12 +397,12 @@ doDictFunDepImprovementTop dict_ct@(DictCt { di_ev = ev, di_cls = cls, di_tys =
new_orig = FunDepOrigin2 dict_pred dict_origin
inst_pred inst_loc
-
solveFunDeps :: TcS Cts -> TcS Bool
solveFunDeps generate_eqs
- = nestFunDepsTcS $
- do { eqs <- generate_eqs
- ; solveSimpleWanteds eqs }
+ = do { (unif_happened, _res) <- nestFunDepsTcS $
+ do { eqs <- generate_eqs
+ ; solveSimpleWanteds eqs }
+ ; return unif_happened }
{- Note [No Given/Given fundeps]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -451,9 +451,14 @@ kickOutRewritable ko_spec new_fr
, text "Residual inerts =" <+> ppr ics' ]) } }
kickOutAfterUnification :: [TcTyVar] -> TcS ()
-kickOutAfterUnification tv_list = case nonEmpty tv_list of
- Nothing -> return ()
- Just tvs -> do
+kickOutAfterUnification tv_list
+ = case nonEmpty tv_list of
+ Nothing -> return ()
+ Just tvs -> setUnificationFlagTo min_tv_lvl
+ where
+ min_tv_lvl = foldr1 minTcLevel (NE.map tcTyVarLevel tvs)
+
+{-
{ let tv_set = mkVarSet tv_list
; n_kicked <- kickOutRewritable (KOAfterUnify tv_set) (Given, NomEq)
@@ -469,6 +474,7 @@ kickOutAfterUnification tv_list = case nonEmpty tv_list of
; traceTcS "kickOutAfterUnification" (ppr tvs $$ text "n_kicked =" <+> ppr n_kicked)
; return n_kicked }
+-}
kickOutAfterFillingCoercionHole :: CoercionHole -> TcS ()
-- See Wrinkle (URW2) in Note [Unify only if the rewriter set is empty]
@@ -1286,43 +1292,23 @@ tryTcS (TcS thing_inside)
; return True } }
-nestFunDepsTcS :: TcS a -> TcS Bool
+nestFunDepsTcS :: TcS a -> TcS (Bool, a)
nestFunDepsTcS (TcS thing_inside)
- = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var
- , tcs_unif_lvl = unif_lvl_var }) ->
+ = reportUnifications $
+ TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) ->
+ TcM.pushTcLevelM_ $
+ -- pushTcLevelTcM: increase the level so that unification variables
+ -- allocated by the fundep-creation itself don't count as useful unifications
do { inerts <- TcM.readTcRef inerts_var
; new_inert_var <- TcM.newTcRef inerts
; new_wl_var <- TcM.newTcRef emptyWorkList
- ; new_unif_lvl_var <- TcM.newTcRef Nothing
; let nest_env = env { tcs_inerts = new_inert_var
- , tcs_worklist = new_wl_var
- , tcs_unif_lvl = new_unif_lvl_var }
+ , tcs_worklist = new_wl_var }
; TcM.traceTc "nestFunDepsTcS {" empty
- ; (inner_lvl, _res) <- TcM.pushTcLevelM $
- thing_inside nest_env
- -- Increase the level so that unification variables allocated by
- -- the fundep-creation itself don't count as useful unifications
+ ; res <- thing_inside nest_env
; TcM.traceTc "nestFunDepsTcS }" empty
-
- -- Figure out whether the fundeps did any useful unifications,
- -- and if so update the tcs_unif_lvl
- ; mb_new_lvl <- TcM.readTcRef new_unif_lvl_var
- ; case mb_new_lvl of
- Just unif_lvl
- | inner_lvl `deeperThanOrSame` unif_lvl
- -> -- Some useful unifications took place
- do { mb_old_lvl <- TcM.readTcRef unif_lvl_var
- ; case mb_old_lvl of
- Just old_lvl | unif_lvl `deeperThanOrSame` old_lvl
- -> return ()
- _ -> TcM.writeTcRef unif_lvl_var (Just unif_lvl)
- ; return True }
-
- _ -> return False -- No unifications (except of vars
- -- generated in the fundep stuff itself)
- }
-
+ ; return res }
updateInertsWith :: InertSet -> InertSet -> InertSet
-- Update the current inert set with bits from a nested solve,
@@ -1403,30 +1389,6 @@ setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcS ()
setTcEvBindsMap ev_binds_var binds
= wrapTcS $ TcM.setTcEvBindsMap ev_binds_var binds
-unifyTyVar :: TcTyVar -> TcType -> TcS ()
--- Unify a meta-tyvar with a type
--- We keep track of how many unifications have happened in tcs_unified,
---
--- We should never unify the same variable twice!
-unifyTyVar tv ty
- = assertPpr (isMetaTyVar tv) (ppr tv) $
- TcS $ \ env ->
- do { TcM.traceTc "unifyTyVar" (ppr tv <+> text ":=" <+> ppr ty)
- ; TcM.liftZonkM $ TcM.writeMetaTyVar tv ty
- ; TcM.updTcRef (tcs_unified env) (+1) }
-
-reportUnifications :: TcS a -> TcS (Int, a)
--- Record how many unifications are done by thing_inside
--- We could return a Bool instead of an Int;
--- all that matters is whether it is no-zero
-reportUnifications (TcS thing_inside)
- = TcS $ \ env ->
- do { inner_unified <- TcM.newTcRef 0
- ; res <- thing_inside (env { tcs_unified = inner_unified })
- ; n_unifs <- TcM.readTcRef inner_unified
- ; TcM.updTcRef (tcs_unified env) (+ n_unifs)
- ; return (n_unifs, res) }
-
getDefaultInfo :: TcS (DefaultEnv, Bool)
getDefaultInfo = wrapTcS TcM.tcGetDefaultTys
@@ -1844,6 +1806,43 @@ produced the same Derived constraint.)
-}
+unifyTyVar :: TcTyVar -> TcType -> TcS ()
+-- Unify a meta-tyvar with a type
+-- We keep track of how many unifications have happened in tcs_unified,
+--
+-- We should never unify the same variable twice!
+unifyTyVar tv ty
+ = assertPpr (isMetaTyVar tv) (ppr tv) $
+ do { liftZonkTcS (TcM.writeMetaTyVar tv ty) -- Produces a trace message
+ ; setUnificationFlagTo (tcTyVarLevel tv) }
+
+reportUnifications :: TcS a -> TcS (Bool, a)
+-- Record whether any unifications are done by thing_inside
+-- Remember to propagate the information to the enclosing context
+reportUnifications (TcS thing_inside)
+ = TcS $ \ env@(TcSEnv { tcs_unif_lvl = outer_ul_var }) ->
+ do { inner_ul_var <- TcM.newTcRef Nothing
+
+ ; res <- thing_inside (env { tcs_unif_lvl = inner_ul_var })
+
+ ; ambient_lvl <- TcM.getTcLevel
+ ; mb_inner_lvl <- TcM.readTcRef inner_ul_var
+
+ ; case mb_inner_lvl of
+ Just unif_lvl
+ | ambient_lvl `deeperThanOrSame` unif_lvl
+ -> -- Some useful unifications took place
+ do { mb_outer_lvl <- TcM.readTcRef outer_ul_var
+ ; case mb_outer_lvl of
+ Just outer_unif_lvl | outer_unif_lvl `strictlyDeeperThan` unif_lvl
+ -> -- Update, because outer_unif_lv > unif_lvl
+ TcM.writeTcRef outer_ul_var (Just unif_lvl)
+ _ -> return ()
+ ; return (True, res) }
+
+ _ -> -- No useful unifications
+ return (False, res) }
+
getUnificationFlag :: TcS Bool
-- We are at ambient level i
-- If the unification flag = Just i, reset it to Nothing and return True
@@ -2226,7 +2225,7 @@ unifyForAllBody ev role unify_body
= do { (res, cts, unified) <- wrapUnifierX ev role unify_body
-- Kick out any inert constraint that we have unified
- ; _ <- kickOutAfterUnification unified
+ ; kickOutAfterUnification unified
; return (res, cts) }
@@ -2255,7 +2254,7 @@ wrapUnifierTcS ev role do_unifications
updWorkListTcS (extendWorkListChildEqs ev cts)
-- And kick out any inert constraint that we have unified
- ; _ <- kickOutAfterUnification unified
+ ; kickOutAfterUnification unified
; return (res, cts, unified) }
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -120,13 +120,13 @@ simplify_loop n limit definitely_redo_implications
, int (lengthBag simples) <+> text "simples to solve" ])
; traceTcS "simplify_loop: wc =" (ppr wc)
- ; (n_unifs1, simples1) <- reportUnifications $ -- See Note [Superclass iteration]
- solveSimpleWanteds simples
+ ; (unif_happened, simples1) <- reportUnifications $ -- See Note [Superclass iteration]
+ solveSimpleWanteds simples
-- Any insoluble constraints are in 'simples' and so get rewritten
-- See Note [Rewrite insolubles] in GHC.Tc.Solver.InertSet
- ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration]
- && n_unifs1 == 0 -- for this conditional
+ ; wc2 <- if not (definitely_redo_implications -- See Note [Superclass iteration]
+ || unif_happened) -- for this conditional
then return (wc { wc_simple = simples1 }) -- Short cut
else do { implics1 <- solveNestedImplications implics
; return (wc { wc_simple = simples1
@@ -1063,15 +1063,16 @@ solveSimpleWanteds simples
simples limit (emptyWC { wc_simple = wc })
| otherwise
= do { -- Solve
- wc1 <- solve_simple_wanteds wc
+ (unif_happened, wc1) <- reportUnifications $
+ solve_simple_wanteds wc
-- Run plugins
-- NB: runTcPluginsWanted has a fast path for empty wc1,
-- which is the common case
; (rerun_plugin, wc2) <- runTcPluginsWanted wc1
- ; if rerun_plugin
- then do { traceTcS "solveSimple going round again:" (ppr rerun_plugin)
+ ; if unif_happened || rerun_plugin
+ then do { traceTcS "solveSimple going round again:" empty
; go (n+1) limit wc2 } -- Loop
else return (n, wc2) } -- Done
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5170b29fdc328a3b9325cc4bfa1610…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5170b29fdc328a3b9325cc4bfa1610…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/enable-poly-spec] compiler: Enable polymorphic-specialisation
by Ben Gamari (@bgamari) 07 Aug '25
by Ben Gamari (@bgamari) 07 Aug '25
07 Aug '25
Ben Gamari pushed to branch wip/enable-poly-spec at Glasgow Haskell Compiler / GHC
Commits:
b73e66fb by Ben Gamari at 2025-08-07T19:35:29-04:00
compiler: Enable polymorphic-specialisation
The remaining hazards to soundness should be addressed
by #23109.
- - - - -
3 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- docs/users_guide/using-optimisation.rst
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -1250,6 +1250,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
, ([1,2], Opt_CfgBlocklayout) -- Experimental
, ([1,2], Opt_Specialise)
+ , ([1,2], Opt_PolymorphicSpecialisation)
, ([1,2], Opt_CrossModuleSpecialise)
, ([1,2], Opt_InlineGenerics)
, ([1,2], Opt_Strictness)
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -907,6 +907,7 @@ optimisationFlags = EnumSet.fromList
, Opt_SpecialiseAggressively
, Opt_CrossModuleSpecialise
, Opt_StaticArgumentTransformation
+ , Opt_PolymorphicSpecialisation
, Opt_CSE
, Opt_StgCSE
, Opt_StgLiftLams
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1325,10 +1325,7 @@ as such you shouldn't need to set any of them explicitly. A flag
:reverse: -fno-polymorphic-specialisation
:category:
- :default: off
-
- Warning, this feature is highly experimental and may lead to incorrect runtime
- results. Use at your own risk (:ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`).
+ :default: on
Enable specialisation of function calls to known dictionaries with free type variables.
The created specialisation will abstract over the type variables free in the dictionary.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b73e66fbcca239c37ea8d07120bc729…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b73e66fbcca239c37ea8d07120bc729…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/warning-for-last-and-init] 8 commits: CODEOWNERS: add CLC as codeowner of base
by Bodigrim (@Bodigrim) 07 Aug '25
by Bodigrim (@Bodigrim) 07 Aug '25
07 Aug '25
Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC
Commits:
95231c8e by Teo Camarasu at 2025-08-06T08:35:58-04:00
CODEOWNERS: add CLC as codeowner of base
We also remove hvr, since I think he is no longer active
- - - - -
77df0ded by Andrew Lelechenko at 2025-08-06T08:36:39-04:00
Bump submodule text to 2.1.3
- - - - -
8af260d0 by Nikolaos Chatzikonstantinou at 2025-08-06T08:37:23-04:00
docs: fix internal import in getopt examples
This external-facing doc example shouldn't mention GHC internals when
using 'fromMaybe'.
- - - - -
69cc16ca by Marc Scholten at 2025-08-06T15:51:28-04:00
README: Add note on ghc.nix
- - - - -
93a2f450 by Daniel Díaz at 2025-08-06T15:52:14-04:00
Link to the "Strict Bindings" docs from the linear types docs
Strict Bidings are relevant for the kinds of multiplicity annotations
linear lets support.
- - - - -
246b7853 by Matthew Pickering at 2025-08-07T06:58:30-04:00
level imports: Check the level of exported identifiers
The level imports specification states that exported identifiers have to
be at level 0. This patch adds the requird level checks that all
explicitly mentioned identifiers occur at level 0.
For implicit export specifications (T(..) and module B), only level 0
identifiers are selected for re-export.
ghc-proposal: https://github.com/ghc-proposals/ghc-proposals/pull/705
Fixes #26090
- - - - -
358bc4fc by fendor at 2025-08-07T06:59:12-04:00
Bump GHC on darwin CI to 9.10.1
- - - - -
f477db57 by Mike Pilgrem at 2025-08-08T00:03:24+01:00
Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`).
In module `Settings.Warnings`, applies `-Wno-unrecognised-warning-flags` `-Wno-x-partial` to the `Cabal`, `filepath`, `hsc2hs`, `hpc`, `parsec`, `text` and `time` packages (outside GHC's repository).
- - - - -
48 changed files:
- .gitlab/darwin/toolchain.nix
- CODEOWNERS
- README.md
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Types/Name/Reader.hs
- docs/users_guide/exts/linear_types.rst
- docs/users_guide/exts/strict.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/src/Settings/Warnings.hs
- libraries/Cabal
- libraries/base/src/System/Console/GetOpt.hs
- libraries/filepath
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
- libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
- libraries/text
- testsuite/tests/driver/j-space/jspace.hs
- testsuite/tests/rts/KeepCafsBase.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.stderr
- + testsuite/tests/splice-imports/DodgyLevelExportA.hs
- + testsuite/tests/splice-imports/LevelImportExports.hs
- + testsuite/tests/splice-imports/LevelImportExports.stdout
- + testsuite/tests/splice-imports/LevelImportExportsA.hs
- testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/ModuleExport.hs
- + testsuite/tests/splice-imports/ModuleExport.stderr
- + testsuite/tests/splice-imports/ModuleExportA.hs
- + testsuite/tests/splice-imports/ModuleExportB.hs
- + testsuite/tests/splice-imports/T26090.hs
- + testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26090A.hs
- testsuite/tests/splice-imports/all.T
- utils/check-exact/Utils.hs
- utils/ghc-pkg/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/hpc
- utils/hsc2hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d79bc71314ef2ab6db26d581ea28af…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d79bc71314ef2ab6db26d581ea28af…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fix-26109] Correcting new test case 'T20645'
by recursion-ninja (@recursion-ninja) 07 Aug '25
by recursion-ninja (@recursion-ninja) 07 Aug '25
07 Aug '25
recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC
Commits:
224fb5bd by Recursion Ninja at 2025-08-07T18:52:16-04:00
Correcting new test case 'T20645'
- - - - -
1 changed file:
- testsuite/tests/llvm/should_run/T20645.hs
Changes:
=====================================
testsuite/tests/llvm/should_run/T20645.hs
=====================================
@@ -12,6 +12,7 @@ opaqueInt8# x = x
main :: IO ()
main = let !x = opaqueInt8# 109#Int8
!y = opaqueInt8# 1#Int8
- in putStrLn . flip showHex "" . W# $ pext8#
+ in putStrLn $ flip showHex "" (W# ( pext8#
(word8ToWord# (int8ToWord8# (0#Int8 `subInt8#` x )))
(word8ToWord# (int8ToWord8# (y `subInt8#` 4#Int8)))
+ ))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/224fb5bd5e724226e1f9a2783cbf1c7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/224fb5bd5e724226e1f9a2783cbf1c7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
07 Aug '25
Ben Gamari pushed new branch wip/enable-poly-spec at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/enable-poly-spec
You're receiving this email because of your account on gitlab.haskell.org.
1
0
07 Aug '25
Teo Camarasu pushed to branch wip/teo/MR12072 at Glasgow Haskell Compiler / GHC
Commits:
c1dc3b81 by David Feuer at 2025-08-07T20:11:15+01:00
Add default QuasiQuoters
Add `defaultQuasiQuoter` and `namedDefaultQuasiQuoter` to make it easier
to write `QuasiQuoters` that give helpful error messages when they're
used in inappropriate contexts.
Closes #24434.
- - - - -
4 changed files:
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/changelog.md
- testsuite/tests/interface-stability/template-haskell-exports.stdout
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
=====================================
@@ -26,10 +26,10 @@ import GHC.Internal.Base hiding (Type)
-- | The 'QuasiQuoter' type, a value @q@ of this type can be used
-- in the syntax @[q| ... string to parse ...|]@. In fact, for
-- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters
--- to be used in different splice contexts; if you are only interested
--- in defining a quasiquoter to be used for expressions, you would
--- define a 'QuasiQuoter' with only 'quoteExp', and leave the other
--- fields stubbed out with errors.
+-- to be used in different splice contexts. In the usual case of a
+-- @QuasiQuoter@ that is only intended to be used in certain splice
+-- contexts, the unused fields should just 'fail'. This is most easily
+-- accomplished using 'namedefaultQuasiQuoter' or 'defaultQuasiQuoter'.
data QuasiQuoter = QuasiQuoter {
-- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@
quoteExp :: String -> Q Exp,
=====================================
libraries/template-haskell/Language/Haskell/TH/Quote.hs
=====================================
@@ -16,6 +16,8 @@ that is up to you.
module Language.Haskell.TH.Quote
( QuasiQuoter(..)
, quoteFile
+ , namedDefaultQuasiQuoter
+ , defaultQuasiQuoter
-- * For backwards compatibility
,dataToQa, dataToExpQ, dataToPatQ
) where
@@ -39,3 +41,54 @@ quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec
get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
; addDependentFile file_name
; old_quoter file_cts }
+
+-- | A 'QuasiQuoter' that fails with a helpful error message in every
+-- context. It is intended to be modified to create a 'QuasiQuoter' that
+-- fails in all inappropriate contexts.
+--
+-- For example, you could write
+--
+-- @
+-- myPatQQ = (namedDefaultQuasiQuoter "myPatQQ")
+-- { quotePat = ... }
+-- @
+--
+-- If 'myPatQQ' is used in an expression context, the compiler will report
+-- that, naming 'myPatQQ'.
+--
+-- See also 'defaultQuasiQuoter', which does not name the 'QuasiQuoter' in
+-- the error message, and might therefore be more appropriate when
+-- the users of a particular 'QuasiQuoter' tend to define local \"synonyms\"
+-- for it.
+namedDefaultQuasiQuoter :: String -> QuasiQuoter
+namedDefaultQuasiQuoter name = QuasiQuoter
+ { quoteExp = f "use in expression contexts."
+ , quotePat = f "use in pattern contexts."
+ , quoteType = f "use in types."
+ , quoteDec = f "creating declarations."
+ }
+ where
+ f m _ = fail $ "The " ++ name ++ " quasiquoter is not for " ++ m
+
+-- | A 'QuasiQuoter' that fails with a helpful error message in every
+-- context. It is intended to be modified to create a 'QuasiQuoter' that
+-- fails in all inappropriate contexts.
+--
+-- For example, you could write
+--
+-- @
+-- myExpressionQQ = defaultQuasiQuoter
+-- { quoteExp = ... }
+-- @
+--
+-- See also 'namedDefaultQuasiQuoter', which names the 'QuasiQuoter' in the
+-- error messages.
+defaultQuasiQuoter :: QuasiQuoter
+defaultQuasiQuoter = QuasiQuoter
+ { quoteExp = f "use in expression contexts."
+ , quotePat = f "use in pattern contexts."
+ , quoteType = f "use in types."
+ , quoteDec = f "creating declarations."
+ }
+ where
+ f m _ = fail $ "This quasiquoter is not for " ++ m
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -1,5 +1,8 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
+## 2.25.0.0
+ * Introduce `namedDefaultQuasiQuoter` and `defaultQuasiQuoter`, which fail with a helpful error when used in an inappropriate context.
+
## 2.24.0.0
* Introduce `dataToCodeQ` and `liftDataTyped`, typed variants of `dataToExpQ` and `liftData` respectively.
=====================================
testsuite/tests/interface-stability/template-haskell-exports.stdout
=====================================
@@ -1370,6 +1370,8 @@ module Language.Haskell.TH.Quote where
dataToExpQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Exp)) -> a -> m GHC.Internal.TH.Syntax.Exp
dataToPatQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Pat)) -> a -> m GHC.Internal.TH.Syntax.Pat
dataToQa :: forall (m :: * -> *) a k q. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (GHC.Internal.TH.Syntax.Name -> k) -> (GHC.Internal.TH.Syntax.Lit -> m q) -> (k -> [m q] -> m q) -> (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m q)) -> a -> m q
+ defaultQuasiQuoter :: QuasiQuoter
+ namedDefaultQuasiQuoter :: GHC.Internal.Base.String -> QuasiQuoter
quoteFile :: QuasiQuoter -> QuasiQuoter
module Language.Haskell.TH.Syntax where
@@ -1720,8 +1722,8 @@ module Language.Haskell.TH.Syntax where
qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m ()
qAddModFinalizer :: Q () -> m ()
qAddCorePlugin :: GHC.Internal.Base.String -> m ()
- qGetQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a)
- qPutQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m ()
+ qGetQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a)
+ qPutQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m ()
qIsExtEnabled :: Extension -> m GHC.Internal.Types.Bool
qExtsEnabled :: m [Extension]
qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m ()
@@ -1802,7 +1804,7 @@ module Language.Haskell.TH.Syntax where
falseName :: Name
getDoc :: DocLoc -> Q (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
getPackageRoot :: Q GHC.Internal.IO.FilePath
- getQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a)
+ getQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a)
get_cons_names :: Con -> [Name]
hoistCode :: forall (m :: * -> *) (n :: * -> *) (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r). GHC.Internal.Base.Monad m => (forall x. m x -> n x) -> Code m a -> Code n a
isExtEnabled :: Extension -> Q GHC.Internal.Types.Bool
@@ -1849,7 +1851,7 @@ module Language.Haskell.TH.Syntax where
oneName :: Name
pkgString :: PkgName -> GHC.Internal.Base.String
putDoc :: DocLoc -> GHC.Internal.Base.String -> Q ()
- putQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q ()
+ putQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q ()
recover :: forall a. Q a -> Q a -> Q a
reify :: Name -> Q Info
reifyAnnotations :: forall a. GHC.Internal.Data.Data.Data a => AnnLookup -> Q [a]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1dc3b81815d903969ee6d8129f93a6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1dc3b81815d903969ee6d8129f93a6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Teo Camarasu pushed new branch wip/teo/MR12072 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/teo/MR12072
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fix-26109] 5 commits: README: Add note on ghc.nix
by recursion-ninja (@recursion-ninja) 07 Aug '25
by recursion-ninja (@recursion-ninja) 07 Aug '25
07 Aug '25
recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC
Commits:
69cc16ca by Marc Scholten at 2025-08-06T15:51:28-04:00
README: Add note on ghc.nix
- - - - -
93a2f450 by Daniel Díaz at 2025-08-06T15:52:14-04:00
Link to the "Strict Bindings" docs from the linear types docs
Strict Bidings are relevant for the kinds of multiplicity annotations
linear lets support.
- - - - -
246b7853 by Matthew Pickering at 2025-08-07T06:58:30-04:00
level imports: Check the level of exported identifiers
The level imports specification states that exported identifiers have to
be at level 0. This patch adds the requird level checks that all
explicitly mentioned identifiers occur at level 0.
For implicit export specifications (T(..) and module B), only level 0
identifiers are selected for re-export.
ghc-proposal: https://github.com/ghc-proposals/ghc-proposals/pull/705
Fixes #26090
- - - - -
358bc4fc by fendor at 2025-08-07T06:59:12-04:00
Bump GHC on darwin CI to 9.10.1
- - - - -
71f622b5 by Recursion Ninja at 2025-08-07T13:14:29-04:00
Resolving issues #20645 and #26109
Correctly sign extending and casting smaller bit width types for LLVM operations:
- bitReverse8#
- bitReverse16#
- bitReverse32#
- byteSwap16#
- byteSwap32#
- pdep8#
- pdep16#
- pext8#
- pext16#
- - - - -
26 changed files:
- .gitlab/darwin/toolchain.nix
- README.md
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Types/Name/Reader.hs
- docs/users_guide/exts/linear_types.rst
- docs/users_guide/exts/strict.rst
- + testsuite/tests/llvm/should_run/T20645.hs
- + testsuite/tests/llvm/should_run/T20645.stdout
- testsuite/tests/llvm/should_run/all.T
- testsuite/tests/numeric/should_run/foundation.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.stderr
- + testsuite/tests/splice-imports/DodgyLevelExportA.hs
- + testsuite/tests/splice-imports/LevelImportExports.hs
- + testsuite/tests/splice-imports/LevelImportExports.stdout
- + testsuite/tests/splice-imports/LevelImportExportsA.hs
- testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/ModuleExport.hs
- + testsuite/tests/splice-imports/ModuleExport.stderr
- + testsuite/tests/splice-imports/ModuleExportA.hs
- + testsuite/tests/splice-imports/ModuleExportB.hs
- + testsuite/tests/splice-imports/T26090.hs
- + testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26090A.hs
- testsuite/tests/splice-imports/all.T
Changes:
=====================================
.gitlab/darwin/toolchain.nix
=====================================
@@ -16,18 +16,17 @@ let
ghcBindists = let version = ghc.version; in {
aarch64-darwin = hostPkgs.fetchurl {
url = "https://downloads.haskell.org/ghc/${version}/ghc-${version}-aarch64-apple-d…";
- sha256 = "sha256-c1GTMJf3/yiW/t4QL532EswD5JVlgA4getkfsxj4TaA=";
+ sha256 = "sha256-/6+DtdeossBJIMbjkJwL4h3eJ7rzgNCV+ifoQKOi6AQ=";
};
x86_64-darwin = hostPkgs.fetchurl {
url = "https://downloads.haskell.org/ghc/${version}/ghc-${version}-x86_64-apple-da…";
- sha256 = "sha256-LrYniMG0phsvyW6dhQC+3ompvzcxnwAe6GezEqqzoTQ=";
+ sha256 = "sha256-jPIhiJMOENesUnDUJeIaPatgavc6ZVSTY5NFIAxlC+k=";
};
};
ghc = pkgs.stdenv.mkDerivation rec {
- # Using 9.6.2 because of #24050
- version = "9.6.2";
+ version = "9.10.1";
name = "ghc";
src = ghcBindists.${pkgs.stdenv.hostPlatform.system};
configureFlags = [
=====================================
README.md
=====================================
@@ -81,6 +81,10 @@ These steps give you the default build, which includes everything
optimised and built in various ways (eg. profiling libs are built).
It can take a long time. To customise the build, see the file `HACKING.md`.
+## Nix
+
+If you are looking to use nix to develop on GHC, [check out the wiki for instructions](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/preparati….
+
Filing bugs and feature requests
================================
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -230,23 +230,25 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args
statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) []
| otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt)
--- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg
--- and return types
-genCall t@(PrimTarget (MO_PopCnt w)) dsts args =
- genCallSimpleCast w t dsts args
-
-genCall t@(PrimTarget (MO_Pdep w)) dsts args =
- genCallSimpleCast2 w t dsts args
-genCall t@(PrimTarget (MO_Pext w)) dsts args =
- genCallSimpleCast2 w t dsts args
-genCall t@(PrimTarget (MO_Clz w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_Ctz w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_BSwap w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_BRev w)) dsts args =
- genCallSimpleCast w t dsts args
+-- Handle PopCnt, Clz, Ctz, BRev, and BSwap that need to only convert arg and return types
+genCall (PrimTarget op@(MO_PopCnt w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Clz w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Ctz w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_BRev w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_BSwap w)) [dst] args =
+ genCallSimpleCast w op dst args
+
+-- Handle Pdep and Pext that (may) require using a type with a larger bit-width
+-- than the specified but width. This register width-extension is particualarly
+-- necessary for W8 and W16.
+genCall (PrimTarget op@(MO_Pdep w)) [dst] args =
+ genCallCastWithMinWidthOf W32 w op dst args
+genCall (PrimTarget op@(MO_Pext w)) [dst] args =
+ genCallCastWithMinWidthOf W32 w op dst args
genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
addrVar <- exprToVarW addr
@@ -640,63 +642,35 @@ genCallExtract _ _ _ _ =
-- since GHC only really has i32 and i64 types and things like Word8 are backed
-- by an i32 and just present a logical i8 range. So we must handle conversions
-- from i32 to i8 explicitly as LLVM is strict about types.
-genCallSimpleCast :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
- -> LlvmM StmtData
-genCallSimpleCast w t@(PrimTarget op) [dst] args = do
- let width = widthToLlvmInt w
- dstTy = cmmToLlvmType $ localRegType dst
-
- fname <- cmmPrimOpFunctions op
- (fptr, _, top3) <- getInstrinct fname width [width]
-
- (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
-
- let (_, arg_hints) = foreignTargetHints t
- let args_hints = zip args arg_hints
- (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
- (argsV', stmts4) <- castVars Signed $ zip argsV [width]
- (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
- (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
- let retV' = singletonPanic "genCallSimpleCast" retVs'
- let s2 = Store retV' dstV Nothing []
-
- let stmts = stmts2 `appOL` stmts4 `snocOL`
- s1 `appOL` stmts5 `snocOL` s2
+genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]
+ -> LlvmM StmtData
+genCallSimpleCast w = genCallCastWithMinWidthOf w w
+
+-- Handle extension case that the element should be extend to a larger bit-width
+-- for the operation and subsequently truncated, of the form:
+-- extend arg >>= \a -> call(a) >>= truncate
+genCallCastWithMinWidthOf :: Width -> Width -> CallishMachOp -> CmmFormal
+ -> [CmmActual] -> LlvmM StmtData
+genCallCastWithMinWidthOf minW specW op dst args = do
+ let width = widthToLlvmInt $ max minW specW
+ argsW = const width <$> args
+ dstType = cmmToLlvmType $ localRegType dst
+ signage = cmmPrimOpRetValSignage op
+
+ fname <- cmmPrimOpFunctions op
+ (fptr, _, top3) <- getInstrinct fname width argsW
+ (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
+ let (_, arg_hints) = foreignTargetHints $ PrimTarget op
+ let args_hints = zip args arg_hints
+ (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
+ (argsV', stmts4) <- castVars signage $ zip argsV argsW
+ (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
+ (retV', stmts5) <- castVar signage retV dstType
+ let s2 = Store retV' dstV Nothing []
+
+ let stmts = stmts2 `appOL` stmts4 `snocOL` s1 `snocOL`
+ stmts5 `snocOL` s2
return (stmts, top2 ++ top3)
-genCallSimpleCast _ _ dsts _ =
- panic ("genCallSimpleCast: " ++ show (length dsts) ++ " dsts")
-
--- Handle simple function call that only need simple type casting, of the form:
--- truncate arg >>= \a -> call(a) >>= zext
---
--- since GHC only really has i32 and i64 types and things like Word8 are backed
--- by an i32 and just present a logical i8 range. So we must handle conversions
--- from i32 to i8 explicitly as LLVM is strict about types.
-genCallSimpleCast2 :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
- -> LlvmM StmtData
-genCallSimpleCast2 w t@(PrimTarget op) [dst] args = do
- let width = widthToLlvmInt w
- dstTy = cmmToLlvmType $ localRegType dst
-
- fname <- cmmPrimOpFunctions op
- (fptr, _, top3) <- getInstrinct fname width (const width <$> args)
-
- (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
-
- let (_, arg_hints) = foreignTargetHints t
- let args_hints = zip args arg_hints
- (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
- (argsV', stmts4) <- castVars Signed $ zip argsV (const width <$> argsV)
- (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
- (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
- let retV' = singletonPanic "genCallSimpleCast2" retVs'
- let s2 = Store retV' dstV Nothing []
-
- let stmts = stmts2 `appOL` stmts4 `snocOL`
- s1 `appOL` stmts5 `snocOL` s2
- return (stmts, top2 ++ top3)
-genCallSimpleCast2 _ _ dsts _ =
- panic ("genCallSimpleCast2: " ++ show (length dsts) ++ " dsts")
-- | Create a function pointer from a target.
getFunPtrW :: (LMString -> LlvmType) -> ForeignTarget
@@ -811,11 +785,42 @@ castVar signage v t | getVarType v == t
Signed -> LM_Sext
Unsigned -> LM_Zext
-
cmmPrimOpRetValSignage :: CallishMachOp -> Signage
cmmPrimOpRetValSignage mop = case mop of
+ -- If the result of a Bit-Reverse is treated as signed,
+ -- an positive input can result in an negative output, i.e.:
+ --
+ -- identity(0x03) = 0x03 = 00000011
+ -- breverse(0x03) = 0xC0 = 11000000
+ --
+ -- Now if an extension is performed after the operation to
+ -- promote a smaller bit-width value into a larger bit-width
+ -- type, it is expected that the /bit-wise/ operations will
+ -- not be treated /numerically/ as signed.
+ --
+ -- To illustrate the difference, consider how a signed extension
+ -- for the type i16 to i32 differs for out values above:
+ -- ext_zeroed(i32, breverse(0x03)) = 0x00C0 = 0000000011000000
+ -- ext_signed(i32, breverse(0x03)) = 0xFFC0 = 1111111111000000
+ --
+ -- Here we can see that the former output is the expected result
+ -- of a bit-wise operation which needs to be promoted to a larger
+ -- bit-width type. The latter output is not desirable when we must
+ -- constraining a value into a range of i16 within an i32 type.
+ --
+ -- Hence we always treat the "signage" as unsigned for Bit-Reverse!
+ MO_BRev _ -> Unsigned
+
+ -- The same reasoning applied to Bit-Reverse above applies to ther other
+ -- bit-wise operations; do not sign extend a possibly negated number!
+ MO_BSwap _ -> Unsigned
+ MO_Clz _ -> Unsigned
+ MO_Ctz _ -> Unsigned
MO_Pdep _ -> Unsigned
MO_Pext _ -> Unsigned
+ MO_PopCnt _ -> Unsigned
+
+ -- All other cases, default to preserving the numeric sign when extending.
_ -> Signed
-- | Decide what C function to use to implement a CallishMachOp
@@ -954,8 +959,25 @@ cmmPrimOpFunctions mop = do
W256 -> fsLit "llvm.x86.bmi.pdep.256"
W512 -> fsLit "llvm.x86.bmi.pdep.512"
| otherwise -> case w of
- W8 -> fsLit "hs_pdep8"
- W16 -> fsLit "hs_pdep16"
+ -- Due to the down-casting and up-casting of the operand before and
+ -- after the Pdep operation, respectively, LLVM will provide a an
+ -- incorrect result after the entire operation is complete.
+ -- This is caused by the definition of hs_pdep64 in "cbits/pdep.c".
+ -- The defined C operation takes a (64-bit) 'StgWord64' as input/output.
+ -- The result will incorrectly consider upper bits when it should not
+ -- because those upper bits are outside the value's "logical range,"
+ -- despite being present in the "actual range."
+ -- The function "hs_pdep32" works correctly for the type 'StgWord'
+ -- as input/output for the logical range of "i32." Attempting to use a
+ -- smaller logical range of "i16" or "i8" will produce incorrect results.
+ -- Hence, the call is made to "hs_pdep32" and truncated afterwards.
+ --
+ -- TODO: Determine if the definition(s) of "hs_pdep8" and "hs_pdep16"
+ -- can be specialized to return the correct results when cast using
+ -- a call to 'genCallSimpleCast', removing the need for the function
+ -- 'genCallCastWithMinWidthOf'.
+ W8 -> fsLit "hs_pdep32"
+ W16 -> fsLit "hs_pdep32"
W32 -> fsLit "hs_pdep32"
W64 -> fsLit "hs_pdep64"
W128 -> fsLit "hs_pdep128"
@@ -971,8 +993,11 @@ cmmPrimOpFunctions mop = do
W256 -> fsLit "llvm.x86.bmi.pext.256"
W512 -> fsLit "llvm.x86.bmi.pext.512"
| otherwise -> case w of
- W8 -> fsLit "hs_pext8"
- W16 -> fsLit "hs_pext16"
+ -- Same issue for "i16" and "i8" values as the Pdep operation above,
+ -- see that commentary for more details as to why "hs_pext32" is called
+ -- for bit-widths of 'W8' and 'W16'.
+ W8 -> fsLit "hs_pext32"
+ W16 -> fsLit "hs_pext32"
W32 -> fsLit "hs_pext32"
W64 -> fsLit "hs_pext64"
W128 -> fsLit "hs_pext128"
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -23,6 +23,7 @@ import GHC.Rename.Module
import GHC.Rename.Names
import GHC.Rename.Env
import GHC.Rename.Unbound ( reportUnboundName )
+import GHC.Rename.Splice
import GHC.Unit.Module
import GHC.Unit.Module.Imported
import GHC.Unit.Module.Warnings
@@ -312,7 +313,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
; addDiagnostic
(TcRnMissingExportList $ moduleName _this_mod)
; let avails =
- map fix_faminst . gresToAvailInfo
+ map fix_faminst . gresToAvailInfo . mapMaybe pickLevelZeroGRE
. filter isLocalGRE . globalRdrEnvElts $ rdr_env
; return (Nothing, emptyDefaultEnv, avails, []) }
where
@@ -384,6 +385,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= do { let { exportValid = (mod `elem` imported_modules)
|| (moduleName this_mod == mod)
; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
+ -- NB: this filters out non level 0 exports
; new_gres = [ gre'
| (gre, _) <- gre_prs
, gre' <- expand_tyty_gre gre ]
@@ -451,6 +453,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
let avail = availFromGRE gre
name = greName gre
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
occs' <- check_occs occs ie [gre]
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -499,6 +502,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
occs' <- check_occs occs ie [gre]
return (Just avail, occs', exp_dflts)
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
dont_warn_export
@@ -526,6 +530,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -563,6 +568,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
all_gres = par : all_kids
all_names = map greName all_gres
+ checkThLocalNameNoLift (ieLWrappedUserRdrName l name)
occs' <- check_occs occs ie all_gres
(export_warn_spans', dont_warn_export', warn_txt_rn)
<- process_warning export_warn_spans
@@ -589,17 +595,19 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt
-> RnM [GlobalRdrElt]
- lookup_ie_kids_all ie (L _ rdr) gre =
+ lookup_ie_kids_all ie (L _loc rdr) gre =
do { let name = greName gre
gres = findChildren kids_env name
- ; addUsedKids (ieWrappedName rdr) gres
- ; when (null gres) $
+ -- We only choose level 0 exports when filling in part of an export list implicitly.
+ ; let kids_0 = mapMaybe pickLevelZeroGRE gres
+ ; addUsedKids (ieWrappedName rdr) kids_0
+ ; when (null kids_0) $
if isTyConName name
then addTcRnDiagnostic (TcRnDodgyExports gre)
else -- This occurs when you export T(..), but
-- only import T abstractly, or T is a synonym.
addErr (TcRnExportHiddenComponents ie)
- ; return gres }
+ ; return kids_0 }
-------------
@@ -696,6 +704,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
addUsedKids parent_rdr kid_gres
= addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres)
+
+ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn
+ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l
+
-- | In what namespaces should we go looking for an import/export item
-- that is out of scope, for suggestions in error messages?
ieWrappedNameWhatLooking :: IEWrappedName GhcPs -> WhatLooking
@@ -800,6 +812,7 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items
; return (L l (IEName noExtField (L (l2l l) ub)), gre)}
FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) ->
do { checkPatSynParent spec_parent par child_nm
+ ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm)
; return (replaceLWrappedName n child_nm, child)
}
IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -69,7 +69,7 @@ module GHC.Types.Name.Reader (
lookupGRE_Name,
lookupGRE_FieldLabel,
getGRE_NameQualifier_maybes,
- transformGREs, pickGREs, pickGREsModExp,
+ transformGREs, pickGREs, pickGREsModExp, pickLevelZeroGRE,
-- * GlobalRdrElts
availFromGRE,
@@ -144,7 +144,7 @@ import GHC.Utils.Panic
import GHC.Utils.Binary
import Control.DeepSeq
-import Control.Monad ( guard )
+import Control.Monad ( guard , (>=>) )
import Data.Data
import Data.List ( sort )
import qualified Data.List.NonEmpty as NE
@@ -641,7 +641,7 @@ greParent = gre_par
greInfo :: GlobalRdrElt -> GREInfo
greInfo = gre_info
-greLevels :: GlobalRdrElt -> Set.Set ImportLevel
+greLevels :: GlobalRdrEltX info -> Set.Set ImportLevel
greLevels g =
if gre_lcl g then Set.singleton NormalLevel
else Set.fromList (bagToList (fmap (is_level . is_decl) (gre_imp g)))
@@ -1604,7 +1604,14 @@ pickGREsModExp :: ModuleName -> [GlobalRdrEltX info] -> [(GlobalRdrEltX info,Glo
--
-- Used only for the 'module M' item in export list;
-- see 'GHC.Tc.Gen.Export.exports_from_avail'
-pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres
+-- This function also only chooses GREs which are at level zero.
+pickGREsModExp mod gres = mapMaybe (pickLevelZeroGRE >=> pickBothGRE mod) gres
+
+pickLevelZeroGRE :: GlobalRdrEltX info -> Maybe (GlobalRdrEltX info)
+pickLevelZeroGRE gre =
+ if NormalLevel `Set.member` greLevels gre
+ then Just gre
+ else Nothing
-- | isBuiltInSyntax filter out names for built-in syntax They
-- just clutter up the environment (esp tuples), and the
=====================================
docs/users_guide/exts/linear_types.rst
=====================================
@@ -213,6 +213,8 @@ With ``-XStrict``::
-- inferred unrestricted
let ~(x, y) = u in …
+(See :ref:`strict-bindings`).
+
Data types
----------
By default, all fields in algebraic data types are linear (even if
=====================================
docs/users_guide/exts/strict.rst
=====================================
@@ -103,6 +103,9 @@ Note the following points:
See `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-w…>`__
for the precise rules.
+
+.. _strict-bindings:
+
Strict bindings
~~~~~~~~~~~~~~~
=====================================
testsuite/tests/llvm/should_run/T20645.hs
=====================================
@@ -0,0 +1,17 @@
+-- Minimal reproducer for https://gitlab.haskell.org/ghc/ghc/-/issues/20645
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ExtendedLiterals #-}
+import GHC.Exts
+import GHC.Word
+import Numeric (showHex)
+
+opaqueInt8# :: Int8# -> Int8#
+opaqueInt8# x = x
+{-# OPAQUE opaqueInt8# #-}
+
+main :: IO ()
+main = let !x = opaqueInt8# 109#Int8
+ !y = opaqueInt8# 1#Int8
+ in putStrLn . flip showHex "" . W# $ pext8#
+ (word8ToWord# (int8ToWord8# (0#Int8 `subInt8#` x )))
+ (word8ToWord# (int8ToWord8# (y `subInt8#` 4#Int8)))
=====================================
testsuite/tests/llvm/should_run/T20645.stdout
=====================================
@@ -0,0 +1 @@
+49
=====================================
testsuite/tests/llvm/should_run/all.T
=====================================
@@ -17,3 +17,4 @@ test('T22487', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a
test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, [''])
test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c'])
# T25730C.c contains Intel instrinsics, so only run this test on x86
+test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])
=====================================
testsuite/tests/numeric/should_run/foundation.hs
=====================================
@@ -24,6 +24,7 @@ module Main
( main
) where
+import Data.Bits (Bits((.&.), bit))
import Data.Word
import Data.Int
import GHC.Natural
@@ -655,8 +656,8 @@ testPrimops = Group "primop"
, testPrimop "ctz32#" Primop.ctz32# Wrapper.ctz32#
, testPrimop "ctz64#" Primop.ctz64# Wrapper.ctz64#
, testPrimop "ctz#" Primop.ctz# Wrapper.ctz#
- , testPrimop "byteSwap16#" Primop.byteSwap16# Wrapper.byteSwap16#
- , testPrimop "byteSwap32#" Primop.byteSwap32# Wrapper.byteSwap32#
+ , testPrimop "byteSwap16#" (16 `LowerBitsAreDefined` Primop.byteSwap16#) (16 `LowerBitsAreDefined` Wrapper.byteSwap16#)
+ , testPrimop "byteSwap32#" (32 `LowerBitsAreDefined` Primop.byteSwap32#) (32 `LowerBitsAreDefined` Wrapper.byteSwap32#)
, testPrimop "byteSwap64#" Primop.byteSwap64# Wrapper.byteSwap64#
, testPrimop "byteSwap#" Primop.byteSwap# Wrapper.byteSwap#
, testPrimop "bitReverse8#" Primop.bitReverse8# Wrapper.bitReverse8#
@@ -672,6 +673,34 @@ testPrimops = Group "primop"
, testPrimop "narrow32Word#" Primop.narrow32Word# Wrapper.narrow32Word#
]
+-- | A special data-type for representing functions where,
+-- since only some number of the lower bits are defined,
+-- testing for strict equality in the undefined upper bits is not appropriate!
+-- Without using this data-type, false-positive failures will be reported
+-- when the undefined bit regions do not match, even though the equality of bits
+-- in this undefined region has no bearing on correctness.
+data LowerBitsAreDefined =
+ LowerBitsAreDefined
+ { definedLowerWidth :: Word
+ -- ^ The (strictly-non-negative) number of least-significant bits
+ -- for which the attached function is defined.
+ , undefinedBehavior :: (Word# -> Word#)
+ -- ^ Function with undefined behavior for some of its most significant bits.
+ }
+
+instance TestPrimop LowerBitsAreDefined where
+ testPrimop s l r = Property s $ \ (uWord#-> x0) ->
+ let -- Create a mask to unset all bits in the undefined area,
+ -- leaving set bits only in the area of defined behavior.
+ -- Since the upper bits are undefined,
+ -- if the function defines behavior for the lower N bits,
+ -- then /only/ the lower N bits are preserved,
+ -- and the upper WORDSIZE - N bits are discarded.
+ mask = bit (fromEnum (definedLowerWidth r)) - 1
+ valL = wWord# (undefinedBehavior l x0) .&. mask
+ valR = wWord# (undefinedBehavior r x0) .&. mask
+ in valL === valR
+
instance TestPrimop (Char# -> Char# -> Int#) where
testPrimop s l r = Property s $ \ (uChar#-> x0) (uChar#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
=====================================
testsuite/tests/splice-imports/DodgyLevelExport.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE ExplicitLevelImports #-}
+module DodgyLevelExport ( T(..) ) where
+
+import quote DodgyLevelExportA
+import DodgyLevelExportA (T)
=====================================
testsuite/tests/splice-imports/DodgyLevelExport.stderr
=====================================
@@ -0,0 +1,4 @@
+DodgyLevelExport.hs:2:27: warning: [GHC-75356] [-Wdodgy-exports (in -Wextra)]
+ The export item ‘T(..)’ suggests that
+ ‘T’ has (in-scope) constructors or record fields, but it has none
+
=====================================
testsuite/tests/splice-imports/DodgyLevelExportA.hs
=====================================
@@ -0,0 +1,3 @@
+module DodgyLevelExportA where
+
+data T = T { a :: Int }
=====================================
testsuite/tests/splice-imports/LevelImportExports.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE ExplicitLevelImports #-}
+module LevelImportExports ( module LevelImportExportsA, T(..) ) where
+
+import quote LevelImportExportsA
+import splice LevelImportExportsA
+import LevelImportExportsA(a, T)
=====================================
testsuite/tests/splice-imports/LevelImportExports.stdout
=====================================
@@ -0,0 +1,6 @@
+[1 of 2] Compiling LevelImportExportsA ( LevelImportExportsA.hs, LevelImportExportsA.o )
+[2 of 2] Compiling LevelImportExports ( LevelImportExports.hs, LevelImportExports.o )
+exports:
+ LevelImportExportsA.a
+ LevelImportExportsA.T
+defaults:
=====================================
testsuite/tests/splice-imports/LevelImportExportsA.hs
=====================================
@@ -0,0 +1,6 @@
+module LevelImportExportsA where
+
+a = 100
+b = 100
+
+data T = T { c :: Int }
=====================================
testsuite/tests/splice-imports/Makefile
=====================================
@@ -24,5 +24,9 @@ SI10_oneshot:
"$(TEST_HC)" $(TEST_HC_OPTS) -c InstanceA.hs
"$(TEST_HC)" $(TEST_HC_OPTS) -c SI10.hs
+LevelImportExports:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -haddock LevelImportExports.hs
+ "$(TEST_HC)" --show-iface LevelImportExports.hi | grep -A3 "^exports:"
+
clean:
rm -f *.o *.hi
=====================================
testsuite/tests/splice-imports/ModuleExport.hs
=====================================
@@ -0,0 +1,4 @@
+module ModuleExport where
+
+-- Should fail
+import ModuleExportA (a)
=====================================
testsuite/tests/splice-imports/ModuleExport.stderr
=====================================
@@ -0,0 +1,3 @@
+ModuleExport.hs:4:23: error: [GHC-61689]
+ Module ‘ModuleExportA’ does not export ‘a’.
+
=====================================
testsuite/tests/splice-imports/ModuleExportA.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE ExplicitLevelImports #-}
+-- Module export only exports level 0 things (b)
+module ModuleExportA (module ModuleExportB) where
+
+-- Everything at level 1
+import quote ModuleExportB
+-- Only b at level 0
+import ModuleExportB (b)
=====================================
testsuite/tests/splice-imports/ModuleExportB.hs
=====================================
@@ -0,0 +1,6 @@
+module ModuleExportB where
+
+a = ()
+b = ()
+
+
=====================================
testsuite/tests/splice-imports/T26090.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
+module T26090 ( a --varaible
+ , T(..) -- WithAll
+ , S(s) -- With
+ , R -- Abs
+ ) where
+
+import quote T26090A
+import T26090A (T(T), S)
+
=====================================
testsuite/tests/splice-imports/T26090.stderr
=====================================
@@ -0,0 +1,16 @@
+T26090.hs:2:17: error: [GHC-28914]
+ • Level error: ‘a’ is bound at level 1 but used at level 0
+ • Available from the imports:
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+
+T26090.hs:4:17: error: [GHC-28914]
+ • Level error: ‘s’ is bound at level 1 but used at level 0
+ • Available from the imports:
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+ • In the export: S(s)
+
+T26090.hs:5:17: error: [GHC-28914]
+ • Level error: ‘R’ is bound at level 1 but used at level 0
+ • Available from the imports:
+ • imported from ‘T26090A’ at 1 at T26090.hs:8:1-20
+
=====================================
testsuite/tests/splice-imports/T26090A.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
+module T26090A where
+
+import Language.Haskell.TH
+
+a :: Q Exp
+a = [| True |]
+
+data T = T { t :: () }
+
+data S = S { s :: () }
+
+data R = R { r :: () }
+
=====================================
testsuite/tests/splice-imports/all.T
=====================================
@@ -48,3 +48,7 @@ test('SI35',
test('SI36', [extra_files(["SI36_A.hs", "SI36_B1.hs", "SI36_B2.hs", "SI36_B3.hs", "SI36_C1.hs", "SI36_C2.hs", "SI36_C3.hs"])], multimod_compile_fail, ['SI36', '-v0'])
test('T26087', [], multimod_compile_fail, ['T26087A', ''])
test('T26088', [], multimod_compile_fail, ['T26088A', '-v0'])
+test('T26090', [], multimod_compile_fail, ['T26090', '-v0'])
+test('ModuleExport', [], multimod_compile_fail, ['ModuleExport', '-v0'])
+test('LevelImportExports', [], makefile_test, [])
+test('DodgyLevelExport', [], multimod_compile, ['DodgyLevelExport', '-v0 -Wdodgy-exports'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fbadea8fb900c08c812a29716c3c4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fbadea8fb900c08c812a29716c3c4…
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: level imports: Check the level of exported identifiers
by Marge Bot (@marge-bot) 07 Aug '25
by Marge Bot (@marge-bot) 07 Aug '25
07 Aug '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
246b7853 by Matthew Pickering at 2025-08-07T06:58:30-04:00
level imports: Check the level of exported identifiers
The level imports specification states that exported identifiers have to
be at level 0. This patch adds the requird level checks that all
explicitly mentioned identifiers occur at level 0.
For implicit export specifications (T(..) and module B), only level 0
identifiers are selected for re-export.
ghc-proposal: https://github.com/ghc-proposals/ghc-proposals/pull/705
Fixes #26090
- - - - -
358bc4fc by fendor at 2025-08-07T06:59:12-04:00
Bump GHC on darwin CI to 9.10.1
- - - - -
1903ae35 by Matthew Pickering at 2025-08-07T12:21:10+01:00
ipe: Place strings and metadata into specific .ipe section
By placing the .ipe metadata into a specific section it can be stripped
from the final binary if desired.
```
objcopy --remove-section .ipe <binary>
upx <binary>
```
Towards #21766
- - - - -
c80dd91c by Matthew Pickering at 2025-08-07T12:22:42+01:00
ipe: Place magic word at the start of entries in the .ipe section
The magic word "IPE\nIPE\n" is placed at the start of .ipe sections,
then if the section is stripped, we can check whether the section starts
with the magic word or not to determine whether there is metadata
present or not.
Towards #21766
- - - - -
cab42666 by Matthew Pickering at 2025-08-07T12:22:42+01:00
ipe: Use stable IDs for IPE entries
IPEs have historically been indexed and reported by their address.
This makes it impossible to compare profiles between runs, since the
addresses may change (due to ASLR) and also makes it tricky to separate
out the IPE map from the binary.
This small patch adds a stable identifier for each IPE entry.
The stable identifier is a single 64 bit word. The high-bits are a
per-module identifier and the low bits identify which entry in each
module.
1. When a node is added into the IPE buffer it is assigned a unique
identifier from an incrementing global counter.
2. Each entry already has an index by it's position in the
`IpeBufferListNode`.
The two are combined together by the `IPE_ENTRY_KEY` macro.
Info table profiling uses the stable identifier rather than the address
of the info table.
The benefits of this change are:
* Profiles from different runs can be easily compared
* The metadata can be extracted from the binary (via the eventlog for
example) and then stripped from the executable.
Fixes #21766
- - - - -
c7cf0aa9 by Simon Peyton Jones at 2025-08-07T13:08:08-04:00
In TcSShortCut, typechecker plugins should get empty Givens
Solving in TcShortCut mode means /ignoring the Givens/. So we
should not pass them to typechecker plugins!
Fixes #26258.
This is a fixup to the earlier MR:
commit 1bd12371feacc52394a0e660ef9349f9e8ee1c06
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Jul 21 10:04:49 2025 +0100
Improve treatment of SPECIALISE pragmas -- again!
- - - - -
33 changed files:
- .gitlab/darwin/toolchain.nix
- compiler/GHC/Cmm.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Types/Name/Reader.hs
- docs/users_guide/debug-info.rst
- rts/IPE.c
- rts/ProfHeap.c
- rts/eventlog/EventLog.c
- rts/include/rts/IPE.h
- testsuite/tests/rts/ipe/ipeMap.c
- testsuite/tests/rts/ipe/ipe_lib.c
- + testsuite/tests/splice-imports/DodgyLevelExport.hs
- + testsuite/tests/splice-imports/DodgyLevelExport.stderr
- + testsuite/tests/splice-imports/DodgyLevelExportA.hs
- + testsuite/tests/splice-imports/LevelImportExports.hs
- + testsuite/tests/splice-imports/LevelImportExports.stdout
- + testsuite/tests/splice-imports/LevelImportExportsA.hs
- testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/ModuleExport.hs
- + testsuite/tests/splice-imports/ModuleExport.stderr
- + testsuite/tests/splice-imports/ModuleExportA.hs
- + testsuite/tests/splice-imports/ModuleExportB.hs
- + testsuite/tests/splice-imports/T26090.hs
- + testsuite/tests/splice-imports/T26090.stderr
- + testsuite/tests/splice-imports/T26090A.hs
- testsuite/tests/splice-imports/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9988a24115d302ebaa29e6e9a75ab3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9988a24115d302ebaa29e6e9a75ab3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0