GitLab

Simon Jakobi pushed to branch wip/sjakobi/T26964 at Glasgow Haskell Compiler / GHC

Commits:

e403294f

by Simon Jakobi at 2026-06-07T13:51:08+02:00

StgToCmm: store the current primop name as a FastString

fcs_prim_op now holds a Maybe FastString rather than a Maybe String. The
name comes straight from occNameFS (primOpOcc primop) — an already-interned
FastString — and is emitted via newByteStringCLit (bytesFS name), avoiding
the previous unpackFS/BS8.pack round-trip on every bounds-checked primop.

Also shortens the emitBoundsCheckFailed doc comment.

d841fc91

by Simon Jakobi at 2026-06-07T13:59:21+02:00

StgToCmm: build the module-name CLit straight from its FastString

getCurrentModuleCLit now reads the bare module name via
moduleNameFS (moduleName mod) and emits it with newByteStringCLit (bytesFS …),
dropping the ppr/renderWithContext/getContext pretty-printer round-trip and the
String repack. The module being reported is always stgToCmmThisModule (the home
module), which ppr never qualifies, so the rendered text is unchanged.

2 changed files:

compiler/GHC/StgToCmm/Monad.hs
compiler/GHC/StgToCmm/Prim.hs

Changes:

compiler/GHC/StgToCmm/Monad.hs

@@ -305,7 +305,7 @@ data FCodeState =
                                                           --   See Note [Self-recursive tail calls] in GHC.StgToCmm.Expr
                , fcs_ticky         :: !CLabel             -- ^ Destination for ticky counts
                , fcs_tickscope     :: !CmmTickScope       -- ^ Tick scope for new blocks & ticks
 -              , fcs_prim_op       :: Maybe String        -- ^ Source name of the primop currently being
 +              , fcs_prim_op       :: Maybe FastString    -- ^ Source name of the primop currently being
                                                           --   compiled, used by -fcheck-prim-bounds error
                                                           --   messages.
+               }
@@ -531,10 +531,10 @@ setTickyCtrLabel ticky code = do
  -- | The source name of the primop currently being compiled (e.g.
  -- @"writeArray#"@), if any. Used to produce informative @-fcheck-prim-bounds@
  -- error messages.
 -getCurrentPrimOpName :: FCode (Maybe String)
 +getCurrentPrimOpName :: FCode (Maybe FastString)
  getCurrentPrimOpName = fcs_prim_op <$> getFCodeState
 -withCurrentPrimOpName :: String -> FCode a -> FCode a
 +withCurrentPrimOpName :: FastString -> FCode a -> FCode a
  withCurrentPrimOpName name code = do
          fstate <- getFCodeState
          withFCodeState code (fstate {fcs_prim_op = Just name})

compiler/GHC/StgToCmm/Prim.hs

@@ -25,19 +25,19 @@ import GHC.StgToCmm.Layout
  import GHC.StgToCmm.Foreign
  import GHC.StgToCmm.Monad
  import GHC.StgToCmm.Utils
 -import GHC.StgToCmm.Lit ( newStringCLit )
 +import GHC.StgToCmm.Lit ( newByteStringCLit )
  import GHC.StgToCmm.Ticky
  import GHC.StgToCmm.Heap
  import GHC.StgToCmm.Prof ( costCentreFrom )
  import GHC.Types.Basic
 -import GHC.Types.Name.Occurrence ( occNameString )
 +import GHC.Types.Name.Occurrence ( occNameFS )
  import GHC.Types.Literal.Floating
  import GHC.Cmm.BlockId
  import GHC.Cmm.Graph
  import GHC.Stg.Syntax
  import GHC.Cmm
 -import GHC.Unit         ( rtsUnit )
 +import GHC.Unit         ( rtsUnit, moduleName, moduleNameFS )
  import GHC.Core.Type    ( Type, tyConAppTyCon_maybe )
  import GHC.Core.TyCon
  import GHC.Cmm.CLabel
@@ -101,7 +101,7 @@ cmmPrimOpApp cfg primop cmm_args mres_ty = do
    -- error message. Guarded by the flag so that the common (unchecked) case pays
    -- nothing: no name thunk, no FCodeState update.
    if stgToCmmDoBoundsCheck cfg
 -    then withCurrentPrimOpName (occNameString (primOpOcc primop)) (f res_ty)
 +    then withCurrentPrimOpName (occNameFS (primOpOcc primop)) (f res_ty)
      else f res_ty
  externalPrimop :: PrimOp -> [CmmExpr] -> PrimopCmmEmit
@@ -3623,8 +3623,8 @@ emitCheckedMemcpyCall dst src n align = do
      emitMemcpyCall dst src n align
    where
      doCheck platform = do
 -        name <- fromMaybe "<unknown primop>" <$> getCurrentPrimOpName
 -        nameLbl <- newStringCLit name
 +        name <- fromMaybe (fsLit "<unknown primop>") <$> getCurrentPrimOpName
 +        nameLbl <- newByteStringCLit (bytesFS name)
          modLbl <- getCurrentModuleCLit
          overlapCheckFailed <- getCode $
            emitCCallNeverReturns []
@@ -3742,13 +3742,12 @@ whenCheckBounds a = do
      False -> pure ()
      True  -> a
 --- | Render the module currently being code-generated as a string literal, for
 --- use in @-fcheck-prim-bounds@ failure diagnostics.
 +-- | The bare name of the module currently being code-generated, as a string
 +-- literal, for use in @-fcheck-prim-bounds@ failure diagnostics.
  getCurrentModuleCLit :: FCode CmmLit
  getCurrentModuleCLit = do
      mod <- getModuleName
 -    ctx <- getContext
 -    newStringCLit (renderWithContext ctx (ppr mod))
 +    newByteStringCLit (bytesFS (moduleNameFS (moduleName mod)))
  -- | Emit a call to the RTS @rtsOutOfBoundsAccess@ bounds-check failure
  -- handler, passing the offending index, element count, array size, primop name
@@ -3758,8 +3757,8 @@ emitBoundsCheckFailed :: CmmExpr  -- ^ accessed index
                        -> CmmExpr  -- ^ array size (in elements)
                        -> FCode ()
  emitBoundsCheckFailed idx count sz = do
 -    name <- fromMaybe "<unknown primop>" <$> getCurrentPrimOpName
 -    nameLbl <- newStringCLit name
 +    name <- fromMaybe (fsLit "<unknown primop>") <$> getCurrentPrimOpName
 +    nameLbl <- newByteStringCLit (bytesFS name)
      modLbl <- getCurrentModuleCLit
      emitCCallNeverReturns []
        (mkLblExpr mkOutOfBoundsAccessLabel)