[Git][ghc/ghc][wip/T24504] IPE: Eliminate dependency on Read

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri May 3 13:54:54 UTC 2024



Ben Gamari pushed to branch wip/T24504 at Glasgow Haskell Compiler / GHC


Commits:
691ee135 by Ben Gamari at 2024-05-03T09:54: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.

- - - - -


4 changed files:

- compiler/GHC/StgToCmm/InfoTableProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- rts/IPE.c
- rts/include/rts/IPE.h


Changes:

=====================================
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


=====================================
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],


=====================================
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;



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/691ee135cd7ab8f7e392c252c4e3a9c94d7b5e1b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/691ee135cd7ab8f7e392c252c4e3a9c94d7b5e1b
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/20240503/3369ad4d/attachment-0001.html>


More information about the ghc-commits mailing list