[Git][ghc/ghc][wip/bco_name_improve] interpreter: Always print unit and module name in BCO_NAME instruction

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/bco_name_improve at Glasgow Haskell Compiler / GHC


Commits:
d257bf3a by Matthew Pickering at 2025-01-29T11:34:35+00:00
interpreter: Always print unit and module name in BCO_NAME instruction

Currently the BCO_Name instruction is a bit difficult to use since the
names are not qualified by the module they come from. When you have a
very generic name such as "wildX4", it becomes impossible to work out
which module the identifier comes from.

Fixes #25694

- - - - -


1 changed file:

- compiler/GHC/StgToByteCode.hs


Changes:

=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -240,11 +240,12 @@ ppBCEnv p
 -- Create a BCO and do a spot of peephole optimisation on the insns
 -- at the same time.
 mkProtoBCO
-   :: (Outputable name)
-   => Platform
-   -> Bool      -- ^ True <=> label with @BCO_NAME@ instruction
-                -- see Note [BCO_NAME]
-   -> name
+   ::
+    Platform
+   -> Maybe Module
+        -- ^ Just cur_mod <=> label with @BCO_NAME@ instruction
+        -- see Note [BCO_NAME]
+   -> Name
    -> BCInstrList
    -> Either  [CgStgAlt] (CgStgRhs)
                 -- ^ original expression; for debugging only
@@ -253,7 +254,7 @@ mkProtoBCO
    -> [StgWord] -- ^ bitmap
    -> Bool      -- ^ True <=> is a return point, rather than a function
    -> [FFIInfo]
-   -> ProtoBCO name
+   -> ProtoBCO Name
 mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
    = ProtoBCO {
         protoBCOName = nm,
@@ -267,9 +268,9 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit
      where
 #if MIN_VERSION_rts(1,0,3)
         maybe_add_bco_name instrs
-          | _add_bco_name = BCO_NAME str : instrs
-          where
-            str = BS.pack $ showSDocOneLine defaultSDocContext (ppr nm)
+          | Just cur_mod <- _add_bco_name =
+              let str = BS.pack $ showSDocOneLine defaultSDocContext (pprFullName cur_mod nm)
+              in BCO_NAME str : instrs
 #endif
         maybe_add_bco_name instrs = instrs
 
@@ -1398,7 +1399,7 @@ Note [unboxed tuple bytecodes and tuple_BCO]
 
 tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
 tupleBCO platform args_info args =
-  mkProtoBCO platform False invented_name body_code (Left [])
+  mkProtoBCO platform Nothing invented_name body_code (Left [])
              0{-no arity-} bitmap_size bitmap False{-is alts-}
   where
     {-
@@ -1419,7 +1420,7 @@ tupleBCO platform args_info args =
 
 primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
 primCallBCO platform args_info args =
-  mkProtoBCO platform False invented_name body_code (Left [])
+  mkProtoBCO platform Nothing invented_name body_code (Left [])
              0{-no arity-} bitmap_size bitmap False{-is alts-}
   where
     {-
@@ -2359,8 +2360,12 @@ getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
 getProfile :: BcM Profile
 getProfile = targetProfile <$> getDynFlags
 
-shouldAddBcoName :: BcM Bool
-shouldAddBcoName = gopt Opt_AddBcoName <$> getDynFlags
+shouldAddBcoName :: BcM (Maybe Module)
+shouldAddBcoName = do
+  add <- gopt Opt_AddBcoName <$> getDynFlags
+  if add
+    then Just <$> getCurrentModule
+    else return Nothing
 
 emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
 emitBc bco



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d257bf3ae97f26dcfe614e01d1f8b3c1516029a0
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/20250129/d8478215/attachment-0001.html>