[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Document NcgImpl methods

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 9 18:27:58 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
8da0880c by Rodrigo Mesquita at 2024-05-09T14:27:30-04:00
Document NcgImpl methods

Fixes #19914

- - - - -
c8adfbd1 by Zejun Wu at 2024-05-09T14:27:31-04:00
Make renamer to be more flexible with parens in the LHS of the rules

We used to reject LHS like `(f a) b` in RULES and requires it to be written as
`f a b`. It will be handy to allow both as the expression may be more
readable with extra parens in some cases when infix operator is involved.
Espceially when TemplateHaskell is used, extra parens may be added out of
user's control and result in "valid" rules being rejected and there
are not always ways to workaround it.

Fixes #24621

- - - - -
7f6fe46e by Ben Gamari at 2024-05-09T14:27:33-04:00
IPE: Eliminate dependency on Read

Instead of encoding the closure type as decimal string we now simply
represent it as an integer, eliminating the need for `Read` in
`GHC.Internal.InfoProv.Types.peekInfoProv`.

Closes #24504.

-------------------------
Metric Decrease:
    T24602_perf_size
    size_hello_artifact
-------------------------

- - - - -
73194949 by Cheng Shao at 2024-05-09T14:27:36-04:00
testsuite: fix testwsdeque with recent clang

This patch fixes compilation of testwsdeque.c with recent versions of
clang, which will fail with the error below:

```
testwsdeque.c:95:33: error:
     warning: format specifies type 'long' but the argument has type 'void *' [-Wformat]
       95 |         barf("FAIL: %ld %d %d", p, n, val);
          |                     ~~~         ^

testwsdeque.c:95:39: error:
     warning: format specifies type 'int' but the argument has type 'StgWord' (aka 'unsigned long') [-Wformat]
       95 |         barf("FAIL: %ld %d %d", p, n, val);
          |                            ~~         ^~~
          |                            %lu

testwsdeque.c:133:42: error:
     error: incompatible function pointer types passing 'void (void *)' to parameter of type 'OSThreadProc *' (aka 'void *(*)(void *)') [-Wincompatible-function-pointer-types]
      133 |         createOSThread(&ids[n], "thief", thief, (void*)(StgWord)n);
          |                                          ^~~~~

/workspace/ghc/_build/stage1/lib/../lib/x86_64-linux-ghc-9.11.20240502/rts-1.0.2/include/rts/OSThreads.h:193:51: error:
     note: passing argument to parameter 'startProc' here
      193 |                                     OSThreadProc *startProc, void *param);
          |                                                   ^

2 warnings and 1 error generated.
```

- - - - -
ccb7f242 by Rodrigo Mesquita at 2024-05-09T14:27:36-04:00
Rename pre-processor invocation args

Small clean up. Uses proper names for the various groups of arguments
that make up the pre-processor invocation.

- - - - -
9ded5312 by Cheng Shao at 2024-05-09T14:27:36-04:00
ghc-heap: fix typo in ghc-heap cbits

- - - - -


22 changed files:

- compiler/GHC/Cmm.hs
- compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
- compiler/GHC/CmmToAsm/Monad.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/SysTools/Tasks.hs
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- rts/IPE.c
- rts/Trace.c
- rts/eventlog/EventLog.c
- rts/include/rts/Constants.h
- rts/include/rts/IPE.h
- + testsuite/tests/rename/should_compile/T24621_normal.hs
- + testsuite/tests/rename/should_compile/T24621_th.hs
- testsuite/tests/rename/should_compile/all.T
- testsuite/tests/rts/ipe/ipeEventLog.stderr
- testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr
- testsuite/tests/rts/ipe/ipeMap.c
- testsuite/tests/rts/ipe/ipe_lib.c
- testsuite/tests/rts/testwsdeque.c


Changes:

=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -304,7 +304,7 @@ instance Outputable CmmStatic where
   ppr (CmmString _) = text "CmmString"
   ppr (CmmFileEmbed fp _) = text "CmmFileEmbed" <+> text fp
 
--- Static data before SRT generation
+-- | Static data before or after SRT generation
 data GenCmmStatics (rawOnly :: Bool) where
     CmmStatics
       :: CLabel       -- Label of statics


=====================================
compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
=====================================
@@ -14,18 +14,16 @@ data JumpDest = DestBlockId BlockId
 instance Outputable JumpDest where
   ppr (DestBlockId bid) = text "jd<blk>:" <> ppr bid
 
--- TODO: documen what this does. See Ticket 19914
+-- Implementations of the methods of 'NgcImpl'
+
 getJumpDestBlockId :: JumpDest -> Maybe BlockId
 getJumpDestBlockId (DestBlockId bid) = Just bid
 
--- TODO: document what this does. See Ticket 19914
 canShortcut :: Instr -> Maybe JumpDest
 canShortcut _ = Nothing
 
--- TODO: document what this does. See Ticket 19914
 shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
 shortcutStatics _ other_static = other_static
 
--- TODO: document what this does. See Ticket 19914
 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
 shortcutJump _ other = other


=====================================
compiler/GHC/CmmToAsm/Monad.hs
=====================================
@@ -73,20 +73,33 @@ import GHC.Utils.Misc
 import GHC.CmmToAsm.CFG
 import GHC.CmmToAsm.CFG.Weight
 
+-- | A Native Code Generator implementation is parametrised over
+-- * The type of static data (typically related to 'CmmStatics')
+-- * The type of instructions
+-- * The type of jump destinations
 data NcgImpl statics instr jumpDest = NcgImpl {
     ncgConfig                 :: !NCGConfig,
     cmmTopCodeGen             :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
     generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
+    -- | Given a jump destination, if it refers to a block, return the block id of the destination.
     getJumpDestBlockId        :: jumpDest -> Maybe BlockId,
     -- | Does this jump always jump to a single destination and is shortcutable?
     --
-    -- We use this to determine shortcutable instructions - See Note [What is shortcutting]
+    -- We use this to determine whether the given instruction is a shortcutable
+    -- jump to some destination - See Note [supporting shortcutting]
     -- Note that if we return a destination here we *most* support the relevant shortcutting in
     -- shortcutStatics for jump tables and shortcutJump for the instructions itself.
     canShortcut               :: instr -> Maybe jumpDest,
     -- | Replace references to blockIds with other destinations - used to update jump tables.
     shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
     -- | Change the jump destination(s) of an instruction.
+    --
+    -- Rewrites the destination of a jump instruction to another
+    -- destination, if the given function returns a new jump destination for
+    -- the 'BlockId' of the original destination.
+    --
+    -- For instance, for a mapping @block_a -> dest_b@ and a instruction @goto block_a@ we would
+    -- rewrite the instruction to @goto dest_b@
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
     -- | 'Module' is only for printing internal labels. See Note [Internal proc
     -- labels] in CLabel.


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -1033,6 +1033,7 @@ instance Outputable JumpDest where
   ppr (DestBlockId bid) = text "jd<blk>:" <> ppr bid
   ppr (DestImm _imm)    = text "jd<imm>:noShow"
 
+-- Implementations of the methods of 'NgcImpl'
 
 getJumpDestBlockId :: JumpDest -> Maybe BlockId
 getJumpDestBlockId (DestBlockId bid) = Just bid
@@ -1043,7 +1044,6 @@ canShortcut (JXX ALWAYS id)      = Just (DestBlockId id)
 canShortcut (JMP (OpImm imm) _)  = Just (DestImm imm)
 canShortcut _                    = Nothing
 
-
 -- This helper shortcuts a sequence of branches.
 -- The blockset helps avoid following cycles.
 shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1226,6 +1226,15 @@ with LHSs with a complicated desugaring (and hence unlikely to match);
 But there are legitimate non-trivial args ei, like sections and
 lambdas.  So it seems simpler not to check at all, and that is why
 check_e is commented out.
+
+Note [Parens on the LHS of a RULE]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+You may think that no one would write
+
+   {-# RULES "foo" (f True) = blah #-}
+
+with the LHS wrapped in parens. But Template Haskell does (#24621)!
+So we should accommodate them.
 -}
 
 checkValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM ()
@@ -1253,6 +1262,8 @@ validRuleLhs foralls lhs
     check (HsAppType _ e _)               = checkl e
     check (HsVar _ lv)
       | (unLoc lv) `notElem` foralls      = Nothing
+    -- See Note [Parens on the LHS of a RULE]
+    check (HsPar _ e)                     = checkl e
     check other                           = Just other  -- Failure
 
         -- Check an argument


=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -178,7 +178,7 @@ toIpeBufferEntries byte_order cg_ipes =
     to_ipe_buf_ent :: CgInfoProvEnt -> [Word32]
     to_ipe_buf_ent cg_ipe =
       [ ipeTableName cg_ipe
-      , ipeClosureDesc cg_ipe
+      , fromIntegral $ ipeClosureDesc cg_ipe
       , ipeTypeDesc cg_ipe
       , ipeLabel cg_ipe
       , ipeSrcFile cg_ipe
@@ -193,7 +193,6 @@ toIpeBufferEntries byte_order cg_ipes =
 toCgIPE :: Platform -> SDocContext -> InfoProvEnt -> State StringTable CgInfoProvEnt
 toCgIPE platform ctx ipe = do
     table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
-    closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
     type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
     let label_str = maybe "" ((\(LexicalFastString s) -> unpackFS s) . snd) (infoTableProv ipe)
     let (src_loc_file, src_loc_span) =
@@ -208,7 +207,7 @@ toCgIPE platform ctx ipe = do
     src_span <- lookupStringTable $ ST.pack src_loc_span
     return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
                            , ipeTableName = table_name
-                           , ipeClosureDesc = closure_desc
+                           , ipeClosureDesc = fromIntegral (infoProvEntClosureType ipe)
                            , ipeTypeDesc = type_desc
                            , ipeLabel = label
                            , ipeSrcFile = src_file
@@ -218,7 +217,7 @@ toCgIPE platform ctx ipe = do
 data CgInfoProvEnt = CgInfoProvEnt
                                { ipeInfoTablePtr :: !CLabel
                                , ipeTableName :: !StrTabOffset
-                               , ipeClosureDesc :: !StrTabOffset
+                               , ipeClosureDesc :: !Word32
                                , ipeTypeDesc :: !StrTabOffset
                                , ipeLabel :: !StrTabOffset
                                , ipeSrcFile :: !StrTabOffset


=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -131,15 +131,15 @@ runSourceCodePreprocessor
 runSourceCodePreprocessor logger tmpfs dflags preprocessor args =
   traceSystoolCommand logger logger_name $ do
     let
-      (p, args0) = pgm_getter dflags
-      args1 = Option <$> (augmentImports dflags $ getOpts dflags opt_getter)
-      args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
-                ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
-      all_args = args0 ++ args1 ++ args2 ++ args
+      (program, configured_args) = pgm_getter dflags
+      runtime_args = Option <$> (augmentImports dflags $ getOpts dflags opt_getter)
+      extra_warns = [Option "-Werror" | gopt Opt_WarnIsError dflags]
+                    ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
+      all_args = configured_args ++ runtime_args ++ extra_warns ++ args
 
-    mb_env <- getGccEnv (args0 ++ args1)
+    mb_env <- getGccEnv (configured_args ++ runtime_args)
 
-    runSomething readable_name p all_args mb_env
+    runSomething readable_name program all_args mb_env
 
   where
     toolSettings' = toolSettings dflags
@@ -155,7 +155,8 @@ runSourceCodePreprocessor logger tmpfs dflags preprocessor args =
     optCFiltered = filter (`notElem` g3Flags) . opt_c
     -- In the wild (and GHC), there is lots of code assuming that -optc gets
     -- passed to the C-- preprocessor too.  Note that the arguments are
-    -- reversed by getOpts.
+    -- reversed by getOpts. That is, in the invocation, first come the runtime
+    -- C opts, then -g0, then the runtime CmmP opts.
     cAndCmmOpt dflags =  opt_CmmP dflags ++ cmmG0 ++ optCFiltered dflags
     (logger_name, pgm_getter, opt_getter, readable_name)
       = case preprocessor of


=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -127,11 +127,11 @@ getWordzh(P_ stack, W_ offsetWords) {
 getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {
   P_ closurePtr;
   closurePtr = (StgStack_sp(stack) + WDS(offsetWords));
-  ASSERT(LOOKS_LIKE_CLOURE_PTR(closurePtr));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
 
   P_ next_chunk;
   (next_chunk) = ccall getUnderflowFrameNextChunk(closurePtr);
-  ASSERT(LOOKS_LIKE_CLOURE_PTR(next_chunk));
+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(next_chunk));
   return (next_chunk);
 }
 


=====================================
libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
=====================================
@@ -18,8 +18,9 @@ module GHC.Internal.InfoProv.Types
     ) where
 
 import GHC.Internal.Base
-import GHC.Internal.Data.Maybe
 import GHC.Internal.Enum
+import GHC.Internal.Real (fromIntegral)
+import GHC.Internal.Word (Word32)
 import GHC.Internal.Show (Show)
 import GHC.Internal.Ptr (Ptr(..), plusPtr)
 import GHC.Internal.Foreign.C.String.Encoding (CString, peekCString)
@@ -28,7 +29,6 @@ import GHC.Internal.Foreign.Marshal.Alloc (allocaBytes)
 import GHC.Internal.IO.Encoding (utf8)
 import GHC.Internal.Foreign.Storable (peekByteOff)
 import GHC.Internal.ClosureTypes
-import GHC.Internal.Text.Read
 import GHC.Prim (whereFrom##)
 
 data InfoProv = InfoProv {
@@ -70,9 +70,11 @@ getIPE obj fail k = allocaBytes (#size InfoProvEnt) $ \p -> IO $ \s ->
 ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
 ipeProv p = (#ptr InfoProvEnt, prov) p
 
-peekIpName, peekIpDesc, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
-peekIpName p    =  (# peek InfoProv, table_name) p
+peekIpDesc :: Ptr InfoProv -> IO Word32
 peekIpDesc p    =  (# peek InfoProv, closure_desc) p
+
+peekIpName, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName p    =  (# peek InfoProv, table_name) p
 peekIpLabel p   =  (# peek InfoProv, label) p
 peekIpUnitId p  =  (# peek InfoProv, unit_id) p
 peekIpModule p  =  (# peek InfoProv, module) p
@@ -83,7 +85,7 @@ peekIpTyDesc p  =  (# peek InfoProv, ty_desc) p
 peekInfoProv :: Ptr InfoProv -> IO InfoProv
 peekInfoProv infop = do
   name <- peekCString utf8 =<< peekIpName infop
-  desc <- peekCString utf8 =<< peekIpDesc infop
+  desc <- peekIpDesc infop
   tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
   label <- peekCString utf8 =<< peekIpLabel infop
   unit_id <- peekCString utf8 =<< peekIpUnitId infop
@@ -94,7 +96,7 @@ peekInfoProv infop = do
       ipName = name,
       -- The INVALID_OBJECT case should be impossible as we
       -- control the C code generating these values.
-      ipDesc = maybe INVALID_OBJECT toEnum . readMaybe @Int $ desc,
+      ipDesc = toEnum $ fromIntegral desc,
       ipTyDesc = tyDesc,
       ipLabel = label,
       ipUnitId = unit_id,


=====================================
rts/IPE.c
=====================================
@@ -105,7 +105,7 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
             .info = node->tables[idx],
             .prov = {
                 .table_name = &strings[ent->table_name],
-                .closure_desc = &strings[ent->closure_desc],
+                .closure_desc = ent->closure_desc,
                 .ty_desc = &strings[ent->ty_desc],
                 .label = &strings[ent->label],
                 .unit_id = &strings[node->unit_id],
@@ -176,6 +176,10 @@ void registerInfoProvList(IpeBufferListNode *node) {
     }
 }
 
+void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf) {
+    snprintf(str_buf, CLOSURE_DESC_BUFFER_SIZE, "%u", ipe_buf->prov.closure_desc);
+}
+
 bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) {
     updateIpeMap();
     IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)info);


=====================================
rts/Trace.c
=====================================
@@ -688,9 +688,12 @@ void traceIPE(const InfoProvEnt *ipe)
     if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
         ACQUIRE_LOCK(&trace_utx);
 
+        char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+        formatClosureDescIpe(ipe, closure_desc_buf);
+
         tracePreface();
         debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, unit %s, module %s, srcloc %s:%s\n",
-                   ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc,
+                   ipe->prov.table_name, closure_desc_buf, ipe->prov.ty_desc,
                    ipe->prov.label, ipe->prov.unit_id, ipe->prov.module,
                    ipe->prov.src_file, ipe->prov.src_span);
 


=====================================
rts/eventlog/EventLog.c
=====================================
@@ -1441,11 +1441,14 @@ void postTickyCounterSamples(StgEntCounter *counters)
 #endif /* TICKY_TICKY */
 void postIPE(const InfoProvEnt *ipe)
 {
+    char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+    formatClosureDescIpe(ipe, closure_desc_buf);
+
     // See Note [Maximum event length].
     const StgWord MAX_IPE_STRING_LEN = 65535;
     ACQUIRE_LOCK(&eventBufMutex);
     StgWord table_name_len = MIN(strlen(ipe->prov.table_name), MAX_IPE_STRING_LEN);
-    StgWord closure_desc_len = MIN(strlen(ipe->prov.closure_desc), MAX_IPE_STRING_LEN);
+    StgWord closure_desc_len = MIN(strlen(closure_desc_buf), MAX_IPE_STRING_LEN);
     StgWord ty_desc_len = MIN(strlen(ipe->prov.ty_desc), MAX_IPE_STRING_LEN);
     StgWord label_len = MIN(strlen(ipe->prov.label), MAX_IPE_STRING_LEN);
     StgWord module_len = MIN(strlen(ipe->prov.module), MAX_IPE_STRING_LEN);
@@ -1462,7 +1465,7 @@ void postIPE(const InfoProvEnt *ipe)
     postPayloadSize(&eventBuf, len);
     postWord64(&eventBuf, (StgWord) INFO_PTR_TO_STRUCT(ipe->info));
     postStringLen(&eventBuf, ipe->prov.table_name, table_name_len);
-    postStringLen(&eventBuf, ipe->prov.closure_desc, closure_desc_len);
+    postStringLen(&eventBuf, closure_desc_buf, closure_desc_len);
     postStringLen(&eventBuf, ipe->prov.ty_desc, ty_desc_len);
     postStringLen(&eventBuf, ipe->prov.label, label_len);
     postStringLen(&eventBuf, ipe->prov.module, module_len);


=====================================
rts/include/rts/Constants.h
=====================================
@@ -347,3 +347,10 @@
  * we can have static arrays of this size in the RTS for speed.
  */
 #define MAX_NUMA_NODES 16
+
+/*
+ * closure_desc of InfoProv is now uint32_t at all platforms, but
+ * we have to keep its stringified representation.
+ * It is known that maximum length of uint32_t in string is 10 chars (4294967295) + 1 NULL.
+ */
+#define CLOSURE_DESC_BUFFER_SIZE 11


=====================================
rts/include/rts/IPE.h
=====================================
@@ -15,7 +15,7 @@
 
 typedef struct InfoProv_ {
     const char *table_name;
-    const char *closure_desc;
+    uint32_t closure_desc; // closure type
     const char *ty_desc;
     const char *label;
     const char *unit_id;
@@ -54,7 +54,7 @@ typedef uint32_t StringIdx;
 // to ensure correct packing.
 typedef struct {
     StringIdx table_name;
-    StringIdx closure_desc;
+    uint32_t closure_desc; // closure type
     StringIdx ty_desc;
     StringIdx label;
     StringIdx src_file;
@@ -89,5 +89,11 @@ typedef struct IpeBufferListNode_ {
 
 void registerInfoProvList(IpeBufferListNode *node);
 
+// We leave it in old format to keep compatibility with existing https://github.com/haskell/ghc-events
+// See: https://github.com/haskell/ghc-events/commit/cce6a35677f5f99b44c21d86febd295b909ef1ce
+// The format depends on tooling. At the moment of commit all tooling expects a stringified unsigned int.
+// I.e. 10 -> "10". No padding zeroes. No prefixes.
+void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf);
+
 // Returns true on success, initializes `out`.
 bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out);


=====================================
testsuite/tests/rename/should_compile/T24621_normal.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_normal where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+{-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-}
+{-# RULES "." forall f g. (f . g) foo = f (g foo) #-}
+{-# RULES "foo" forall a b. (foo a) b = a b #-}
+{-# RULES "on" forall a b. (flip compare `on` foo) a b = compare b a #-}


=====================================
testsuite/tests/rename/should_compile/T24621_th.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_th where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+$( [d| {-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-} |] )
+$( [d| {-# RULES "." forall a b. (.) a b foo = a (b foo) #-} |] )
+$( [d| {-# RULES "foo" forall a b. foo a b = a b #-} |] )


=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -223,4 +223,6 @@ test('T22478a', req_th, compile, [''])
 test('RecordWildCardDeprecation', normal, multimod_compile, ['RecordWildCardDeprecation', '-Wno-duplicate-exports'])
 test('T14032b', normal, compile_and_run, [''])
 test('T14032d', normal, compile, [''])
+test('T24621_normal', normal, compile, [''])
+test('T24621_th', req_th, compile, [''])
 test('T24732', normal, compile_and_run, ['-package "base(Prelude, Text.Printf as P\')"'])


=====================================
testsuite/tests/rts/ipe/ipeEventLog.stderr
=====================================
@@ -1,20 +1,20 @@
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009


=====================================
testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr
=====================================
@@ -1,20 +1,20 @@
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000


=====================================
testsuite/tests/rts/ipe/ipeMap.c
=====================================
@@ -68,10 +68,13 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
 
     registerInfoProvList(node);
 
-    InfoProvEnt result = lookupIPE_("shouldFindOneIfItHasBeenRegistered", get_itbl(fortyTwo));
+    const InfoProvEnt result = lookupIPE_("shouldFindOneIfItHasBeenRegistered", get_itbl(fortyTwo));
+
+    char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+    formatClosureDescIpe(&result, closure_desc_buf);
 
     assertStringsEqual(result.prov.table_name, "table_name_042");
-    assertStringsEqual(result.prov.closure_desc, "closure_desc_042");
+    assertStringsEqual(closure_desc_buf, "42");
     assertStringsEqual(result.prov.ty_desc, "ty_desc_042");
     assertStringsEqual(result.prov.label, "label_042");
     assertStringsEqual(result.prov.unit_id, "unit-id");


=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -33,10 +33,7 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) {
     snprintf(tableName, tableNameLength, "table_name_%03i", i);
     provEnt.table_name = add_string(st, tableName);
 
-    unsigned int closureDescLength = strlen("closure_desc_") + 3 /* digits */ + 1 /* null character */;
-    char *closureDesc = malloc(sizeof(char) * closureDescLength);
-    snprintf(closureDesc, closureDescLength, "closure_desc_%03i", i);
-    provEnt.closure_desc = add_string(st, closureDesc);
+    provEnt.closure_desc = i;
 
     unsigned int tyDescLength = strlen("ty_desc_") + 3 /* digits */ + 1 /* null character */;
     char *tyDesc = malloc(sizeof(char) * tyDescLength);


=====================================
testsuite/tests/rts/testwsdeque.c
=====================================
@@ -34,16 +34,16 @@ void *
 myStealWSDeque_ (WSDeque *q, uint32_t n)
 {
     void * stolen;
-    
+
 // Can't do this on someone else's spark pool:
-// ASSERT_WSDEQUE_INVARIANTS(q); 
-    
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
     // NB. these loads must be ordered, otherwise there is a race
     // between steal and pop.
     StgWord t = ACQUIRE_LOAD(&q->top);
     SEQ_CST_FENCE();
     StgWord b = ACQUIRE_LOAD(&q->bottom);
-    
+
     void *result = NULL;
     if (t < b) {
         /* Non-empty queue */
@@ -59,11 +59,11 @@ void *
 myStealWSDeque (WSDeque *q, uint32_t n)
 {
     void *stolen;
-    
-    do { 
+
+    do {
         stolen = myStealWSDeque_(q,n);
     } while (stolen == NULL && !looksEmptyWSDeque(q));
-    
+
     return stolen;
 }
 
@@ -89,15 +89,15 @@ void work(void *p, uint32_t n)
 
     // debugBelch("work %ld %d\n", p, n);
     val = *(StgWord *)p;
-    if (val != 0) { 
-        fflush(stdout); 
-        fflush(stderr); 
-        barf("FAIL: %ld %d %d", p, n, val);
+    if (val != 0) {
+        fflush(stdout);
+        fflush(stderr);
+        barf("FAIL: %p %" FMT_Word32 " %" FMT_Word, p, n, val);
     }
     *(StgWord*)p = n+10;
 }
-    
-void OSThreadProcAttr thief(void *info)
+
+void* OSThreadProcAttr thief(void *info)
 {
     void *p;
     StgWord n;
@@ -114,6 +114,7 @@ void OSThreadProcAttr thief(void *info)
         if (p != NULL) { work(p,n+1); count++; }
     }
     debugBelch("thread %ld finished, stole %d", n, count);
+    return NULL;
 }
 
 int main(int argc, char*argv[])
@@ -124,13 +125,13 @@ int main(int argc, char*argv[])
 
     q = newWSDeque(1024);
     done = 0;
-    
+
     for (n=0; n < SCRATCH_SIZE; n++) {
         scratch[n] = 0;
     }
 
     for (n=0; n < THREADS; n++) {
-        createOSThread(&ids[n], "thief", thief, (void*)(StgWord)n);
+        createOSThread(&ids[n], "thief", (OSThreadProc*)thief, (void*)(StgWord)n);
     }
 
     for (n=0; n < SCRATCH_SIZE; n++) {



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11a233063497a42a981c4692963937b0952e0b25...9ded5312a893ca971fe306094bc75cf5365640d1

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11a233063497a42a981c4692963937b0952e0b25...9ded5312a893ca971fe306094bc75cf5365640d1
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240509/d7c1eee4/attachment-0001.html>


More information about the ghc-commits mailing list