[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 22 Aug '25
by Hannes Siebenhandl (＠fendor) 22 Aug '25
22 Aug '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
8a6cdac4 by fendor at 2025-08-22T16:56:55+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
-------------------------
Metric Increase:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
-------------------------
These metric increases are unfortunate, they are most likely caused by
the larger (literally in terms of lines of code) stack decoder implementation
that are now linked into hello-word binaries.
On linux, it is almost a 10% increase, which is considerable.
- - - - -
9310dfba by fendor at 2025-08-22T16:56:55+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
54459e4b by fendor at 2025-08-22T16:56:55+02:00
Remove stg_decodeStackzh
- - - - -
b1ef001a by fendor at 2025-08-22T16:56:55+02:00
Remove ghcHeap from list of toolTargets
- - - - -
53 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- + libraries/ghc-heap/GHC/Exts/Heap/Constants.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hs
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- + libraries/ghc-heap/GHC/Exts/Stack/Constants.hs
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-heap/tests/stack-annotation/Makefile → libraries/ghc-internal/tests/stack-annotation/Makefile
- libraries/ghc-heap/tests/stack-annotation/TestUtils.hs → libraries/ghc-internal/tests/stack-annotation/TestUtils.hs
- libraries/ghc-heap/tests/stack-annotation/all.T → libraries/ghc-internal/tests/stack-annotation/all.T
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame001.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame002.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame003.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame004.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c727e33c30dbbea024a309d25adaba…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c727e33c30dbbea024a309d25adaba…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/remove-ddump-json] 8 commits: Remove -ddump-json (fixes #24113)
by Simon Hengel (＠sol) 22 Aug '25
by Simon Hengel (＠sol) 22 Aug '25
22 Aug '25
Simon Hengel pushed to branch wip/sol/remove-ddump-json at Glasgow Haskell Compiler / GHC
Commits:
961bb596 by Simon Hengel at 2025-08-22T21:38:01+07:00
Remove -ddump-json (fixes #24113)
- - - - -
e991a4f1 by Simon Hengel at 2025-08-22T21:38:01+07:00
Add SrcSpan to MCDiagnostic
- - - - -
2aa43ad0 by Simon Hengel at 2025-08-22T21:38:01+07:00
Refactoring: More consistently use logOutput, logInfo, fatalErrorMsg
- - - - -
54009c0e by Simon Hengel at 2025-08-22T21:38:01+07:00
Get rid of mkLocMessage
- - - - -
d8a4c402 by Simon Hengel at 2025-08-22T21:38:01+07:00
Add Message data type
- - - - -
638ca476 by Simon Hengel at 2025-08-22T21:38:02+07:00
Get rid of MessageClass
- - - - -
3c86056e by Simon Hengel at 2025-08-22T21:38:02+07:00
Remove JSON logging
- - - - -
95790a5c by Simon Hengel at 2025-08-22T21:38:02+07:00
Update `testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs`
- - - - -
30 changed files:
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Monad.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Pipeline/LogQueue.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Utils/Error.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/debugging.rst
- ghc/GHCi/UI.hs
- testsuite/tests/driver/T16167.stderr
- − testsuite/tests/driver/T16167.stdout
- testsuite/tests/driver/all.T
- testsuite/tests/driver/json2.stderr
- − testsuite/tests/driver/json_dump.hs
- − testsuite/tests/driver/json_dump.stderr
- testsuite/tests/ghc-api/T7478/T7478.hs
- testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs
Changes:
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -26,6 +26,7 @@ module GHC.Core.Lint (
-- ** Debug output
EndPassConfig (..),
endPassIO,
+ lintMessage,
displayLintResults, dumpPassResult
) where
@@ -309,11 +310,6 @@ path does not result in allocation in the hot path. This can be surprisingly
impactful. Changing `lint_app` reduced allocations for one test program I was
looking at by ~4%.
-Note [MCInfo for Lint]
-~~~~~~~~~~~~~~~~~~~~~~
-When printing a Lint message, use the MCInfo severity so that the
-message is printed on stderr rather than stdout (#13342).
-
************************************************************************
* *
Beginning and ending passes
@@ -321,6 +317,12 @@ message is printed on stderr rather than stdout (#13342).
************************************************************************
-}
+lintMessage :: Logger -> SDoc -> IO ()
+lintMessage logger =
+ -- Note: Use logInfo when printing a Lint message, so that the message is
+ -- printed on stderr rather than stdout (#13342).
+ logInfo logger . withPprStyle defaultDumpStyle
+
-- | Configuration for boilerplate operations at the end of a
-- compilation pass producing Core.
data EndPassConfig = EndPassConfig
@@ -436,8 +438,7 @@ displayLintResults :: Logger
-> IO ()
displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
| not (isEmptyBag errs)
- = do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint]
- $ withPprStyle defaultDumpStyle
+ = do { lintMessage logger
(vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs
, text "*** Offending Program ***"
, pp_pgm
@@ -447,8 +448,7 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
| not (isEmptyBag warns)
, log_enable_debug (logFlags logger)
, display_warnings
- = logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint]
- $ withPprStyle defaultDumpStyle
+ = lintMessage logger
(lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
| otherwise = return ()
=====================================
compiler/GHC/Core/Opt/Monad.hs
=====================================
@@ -362,19 +362,22 @@ we aren't using annotations heavily.
************************************************************************
-}
-msg :: MessageClass -> SDoc -> CoreM ()
-msg msg_class doc = do
+msg :: Message -> CoreM ()
+msg msg = do
logger <- getLogger
- loc <- getSrcSpanM
name_ppr_ctx <- getNamePprCtx
- let sty = case msg_class of
- MCDiagnostic _ _ _ -> err_sty
- MCDump -> dump_sty
- _ -> user_sty
- err_sty = mkErrStyle name_ppr_ctx
- user_sty = mkUserStyle name_ppr_ctx AllTheWay
- dump_sty = mkDumpStyle name_ppr_ctx
- liftIO $ logMsg logger msg_class loc (withPprStyle sty doc)
+ let m = case msg of
+ MCDump doc -> MCDump (dump_sty doc)
+ UnsafeMCDiagnostic span severity reason code doc diagnostic -> UnsafeMCDiagnostic span severity reason code (err_sty doc) diagnostic
+ MCOutput doc -> MCOutput (user_sty doc)
+ MCFatal doc -> MCFatal (user_sty doc)
+ MCInteractive doc -> MCInteractive (user_sty doc)
+ MCInfo doc -> MCInfo (user_sty doc)
+
+ err_sty = withPprStyle $ mkErrStyle name_ppr_ctx
+ user_sty = withPprStyle $ mkUserStyle name_ppr_ctx AllTheWay
+ dump_sty = withPprStyle $ mkDumpStyle name_ppr_ctx
+ liftIO $ logMsg logger m
-- | Output a String message to the screen
putMsgS :: String -> CoreM ()
@@ -382,7 +385,7 @@ putMsgS = putMsg . text
-- | Output a message to the screen
putMsg :: SDoc -> CoreM ()
-putMsg = msg MCInfo
+putMsg = msg . MCInfo
diagnostic :: DiagnosticReason -> SDoc -> CoreM ()
diagnostic reason doc = do
@@ -407,7 +410,7 @@ fatalErrorMsgS = fatalErrorMsg . text
-- | Output a fatal error to the screen. Does not cause the compiler to die.
fatalErrorMsg :: SDoc -> CoreM ()
-fatalErrorMsg = msg MCFatal
+fatalErrorMsg = msg . MCFatal
-- | Output a string debugging message at verbosity level of @-v@ or higher
debugTraceMsgS :: String -> CoreM ()
@@ -415,4 +418,4 @@ debugTraceMsgS = debugTraceMsg . text
-- | Outputs a debugging message at verbosity level of @-v@ or higher
debugTraceMsg :: SDoc -> CoreM ()
-debugTraceMsg = msg MCDump
+debugTraceMsg = msg . MCDump
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -18,6 +18,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.ForeignSrcLang
import GHC.Data.FastString
+import GHC.Core.Lint ( lintMessage )
import GHC.CmmToAsm ( nativeCodeGen )
import GHC.CmmToLlvm ( llvmCodeGen )
@@ -55,7 +56,6 @@ import GHC.Utils.Panic.Plain ( pgmError )
import GHC.Unit
import GHC.Unit.Finder ( mkStubPaths )
-import GHC.Types.SrcLoc
import GHC.Types.CostCentre
import GHC.Types.ForeignStubs
import GHC.Types.Unique.DSM
@@ -109,10 +109,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g
(text "CmmLint"<+>brackets (ppr this_mod))
(const ()) $ do
{ case cmmLint (targetPlatform dflags) cmm of
- Just err -> do { logMsg logger
- MCInfo -- See Note [MCInfo for Lint] in "GHC.Core.Lint"
- noSrcSpan
- $ withPprStyle defaultDumpStyle err
+ Just err -> do { lintMessage logger err
; ghcExit logger 1
}
Nothing -> return ()
=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -46,19 +46,16 @@ printMessages logger msg_opts opts = mapM_ (printMessage logger msg_opts opts) .
sortMessages = sortMsgBag (Just opts) . getMessages
printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO ()
-printMessage logger msg_opts opts message
- | log_diags_as_json = do
- decorated <- decorateDiagnostic logflags messageClass location doc
- let
- rendered :: String
- rendered = renderWithContext (log_default_user_context logflags) decorated
-
- jsonMessage :: JsonDoc
- jsonMessage = jsonDiagnostic rendered message
+printMessage logger msg_opts opts message = do
+ decorated <- decorateDiagnostic logflags location severity reason code doc
+ let
+ rendered :: String
+ rendered = renderWithContext (log_default_user_context logflags) decorated
- logJsonMsg logger messageClass jsonMessage
+ jsonMessage :: JsonDoc
+ jsonMessage = jsonDiagnostic rendered message
- | otherwise = logMsg logger messageClass location doc
+ logMsg logger $ UnsafeMCDiagnostic location severity reason code decorated jsonMessage
where
logflags :: LogFlags
logflags = logFlags logger
@@ -66,9 +63,6 @@ printMessage logger msg_opts opts message
doc :: SDoc
doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic)
- messageClass :: MessageClass
- messageClass = UnsafeMCDiagnostic severity (errMsgReason message) (diagnosticCode diagnostic)
-
style :: PprStyle
style = mkErrStyle (errMsgContext message)
@@ -84,6 +78,12 @@ printMessage logger msg_opts opts message
severity :: Severity
severity = errMsgSeverity message
+ reason :: ResolvedDiagnosticReason
+ reason = errMsgReason message
+
+ code :: Maybe DiagnosticCode
+ code = diagnosticCode diagnostic
+
messageWithHints :: a -> SDoc
messageWithHints e =
let main_msg = formatBulleted $ diagnosticMessage msg_opts e
@@ -93,8 +93,22 @@ printMessage logger msg_opts opts message
hs -> main_msg $$ hang (text "Suggested fixes:") 2
(formatBulleted $ mkDecorated . map ppr $ hs)
- log_diags_as_json :: Bool
- log_diags_as_json = log_diagnostics_as_json (logFlags logger)
+decorateDiagnostic :: LogFlags -> SrcSpan -> Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> SDoc -> IO SDoc
+decorateDiagnostic logflags span severity reason code doc = addCaret
+ where
+ -- Pretty print the warning flag, if any (#10752)
+ message :: SDoc
+ message = formatDiagnostic (log_show_warn_groups logflags) span severity reason code doc
+
+ addCaret :: IO SDoc
+ addCaret = do
+ caretDiagnostic <-
+ if log_show_caret logflags
+ then getCaretDiagnostic severity span
+ else pure empty
+ return $ getPprStyle $ \style ->
+ withPprStyle (setStyleColoured True style)
+ (message $+$ caretDiagnostic $+$ blankLine)
-- | Given a bag of diagnostics, turn them into an exception if
-- any has 'SevError', or print them out otherwise.
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -526,7 +526,6 @@ data DumpFlag
| Opt_D_dump_view_pattern_commoning
| Opt_D_verbose_core2core
| Opt_D_dump_debug
- | Opt_D_dump_json
| Opt_D_ppr_debug
| Opt_D_no_debug_output
| Opt_D_dump_faststrings
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1835,7 +1835,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
]
badFlags df = concatMap (badFlag df) unsafeFlagsForInfer
badFlag df (ext,loc,on,_)
- | on df = [mkLocMessage MCOutput (loc df) $
+ | on df = [formatLocMessage (loc df) $
text "-X" <> ppr ext <+> text "is not allowed in Safe Haskell"]
| otherwise = []
badInsts insts = concatMap badInst insts
@@ -1844,9 +1844,10 @@ markUnsafeInfer tcg_env whyUnsafe = do
checkOverlap _ = True
badInst ins | checkOverlap (overlapMode (is_flag ins))
- = [mkLocMessage MCOutput (nameSrcSpan $ getName $ is_dfun ins) $
+ = [formatLocMessage (nameSrcSpan $ getName $ is_dfun ins) $
ppr (overlapMode $ is_flag ins) <+>
- text "overlap mode isn't allowed in Safe Haskell"]
+ text "overlap mode isn't allowed in Safe Haskell"
+ ]
| otherwise = []
-- | Figure out the final correct safe haskell mode
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1442,14 +1442,14 @@ withDeferredDiagnostics f = do
fatals <- liftIO $ newIORef []
logger <- getLogger
- let deferDiagnostics _dflags !msgClass !srcSpan !msg = do
- let action = logMsg logger msgClass srcSpan msg
- case msgClass of
- MCDiagnostic SevWarning _reason _code
+ let deferDiagnostics _dflags !msg = do
+ let action = logMsg logger msg
+ case msg of
+ MCDiagnostic _ SevWarning _reason _code
-> atomicModifyIORef' warnings $ \(!i) -> (action: i, ())
- MCDiagnostic SevError _reason _code
+ MCDiagnostic _ SevError _reason _code
-> atomicModifyIORef' errors $ \(!i) -> (action: i, ())
- MCFatal
+ MCFatal _
-> atomicModifyIORef' fatals $ \(!i) -> (action: i, ())
_ -> action
=====================================
compiler/GHC/Driver/Monad.hs
=====================================
@@ -23,8 +23,6 @@ module GHC.Driver.Monad (
modifyLogger,
pushLogHookM,
popLogHookM,
- pushJsonLogHookM,
- popJsonLogHookM,
putLogMsgM,
putMsgM,
withTimingM,
@@ -47,7 +45,6 @@ import GHC.Utils.Exception
import GHC.Utils.Error
import GHC.Utils.Logger
-import GHC.Types.SrcLoc
import GHC.Types.SourceError
import Control.Monad
@@ -123,12 +120,6 @@ pushLogHookM = modifyLogger . pushLogHook
popLogHookM :: GhcMonad m => m ()
popLogHookM = modifyLogger popLogHook
-pushJsonLogHookM :: GhcMonad m => (LogJsonAction -> LogJsonAction) -> m ()
-pushJsonLogHookM = modifyLogger . pushJsonLogHook
-
-popJsonLogHookM :: GhcMonad m => m ()
-popJsonLogHookM = modifyLogger popJsonLogHook
-
-- | Put a log message
putMsgM :: GhcMonad m => SDoc -> m ()
putMsgM doc = do
@@ -136,10 +127,10 @@ putMsgM doc = do
liftIO $ putMsg logger doc
-- | Put a log message
-putLogMsgM :: GhcMonad m => MessageClass -> SrcSpan -> SDoc -> m ()
-putLogMsgM msg_class loc doc = do
+putLogMsgM :: GhcMonad m => Message -> m ()
+putLogMsgM message = do
logger <- getLogger
- liftIO $ logMsg logger msg_class loc doc
+ liftIO $ logMsg logger message
-- | Time an action
withTimingM :: GhcMonad m => SDoc -> (b -> ()) -> m b -> m b
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -1162,7 +1162,7 @@ getHCFilePackages filename =
linkDynLibCheck :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do
when (haveRtsOptsFlags dflags) $
- logMsg logger MCInfo noSrcSpan
+ logInfo logger
$ withPprStyle defaultUserStyle
(text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
text " Call hs_init_ghc() from your main() function to set these options.")
=====================================
compiler/GHC/Driver/Pipeline/LogQueue.hs
=====================================
@@ -18,7 +18,6 @@ import GHC.Prelude
import Control.Concurrent
import Data.IORef
import GHC.Types.Error
-import GHC.Types.SrcLoc
import GHC.Utils.Logger
import qualified Data.IntMap as IM
import Control.Concurrent.STM
@@ -30,7 +29,7 @@ import Control.Monad
-- to. A 'Nothing' value contains the result of compilation, and denotes the
-- end of the message queue.
data LogQueue = LogQueue { logQueueId :: !Int
- , logQueueMessages :: !(IORef [Maybe (MessageClass, SrcSpan, SDoc, LogFlags)])
+ , logQueueMessages :: !(IORef [Maybe (Message, LogFlags)])
, logQueueSemaphore :: !(MVar ())
}
@@ -45,12 +44,12 @@ finishLogQueue lq = do
writeLogQueueInternal lq Nothing
-writeLogQueue :: LogQueue -> (MessageClass,SrcSpan,SDoc, LogFlags) -> IO ()
+writeLogQueue :: LogQueue -> (Message, LogFlags) -> IO ()
writeLogQueue lq msg = do
writeLogQueueInternal lq (Just msg)
-- | Internal helper for writing log messages
-writeLogQueueInternal :: LogQueue -> Maybe (MessageClass,SrcSpan,SDoc, LogFlags) -> IO ()
+writeLogQueueInternal :: LogQueue -> Maybe (Message, LogFlags) -> IO ()
writeLogQueueInternal (LogQueue _n ref sem) msg = do
atomicModifyIORef' ref $ \msgs -> (msg:msgs,())
_ <- tryPutMVar sem ()
@@ -59,8 +58,8 @@ writeLogQueueInternal (LogQueue _n ref sem) msg = do
-- The log_action callback that is used to synchronize messages from a
-- worker thread.
parLogAction :: LogQueue -> LogAction
-parLogAction log_queue log_flags !msgClass !srcSpan !msg =
- writeLogQueue log_queue (msgClass,srcSpan,msg, log_flags)
+parLogAction log_queue log_flags !msg =
+ writeLogQueue log_queue (msg, log_flags)
-- Print each message from the log_queue using the global logger
printLogs :: Logger -> LogQueue -> IO ()
@@ -72,8 +71,8 @@ printLogs !logger (LogQueue _n ref sem) = read_msgs
print_loop [] = read_msgs
print_loop (x:xs) = case x of
- Just (msgClass,srcSpan,msg,flags) -> do
- logMsg (setLogFlags logger flags) msgClass srcSpan msg
+ Just (msg,flags) -> do
+ logMsg (setLogFlags logger flags) msg
print_loop xs
-- Exit the loop once we encounter the end marker.
Nothing -> return ()
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1657,9 +1657,6 @@ dynamic_flags_deps = [
(NoArg (setGeneralFlag Opt_NoTypeableBinds))
, make_ord_flag defGhcFlag "ddump-debug"
(setDumpFlag Opt_D_dump_debug)
- , make_dep_flag defGhcFlag "ddump-json"
- (setDumpFlag Opt_D_dump_json)
- "Use `-fdiagnostics-as-json` instead"
, make_ord_flag defGhcFlag "dppr-debug"
(setDumpFlag Opt_D_ppr_debug)
, make_ord_flag defGhcFlag "ddebug-output"
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -94,7 +94,6 @@ import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.DSet
-import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.PkgQual
@@ -1105,7 +1104,7 @@ For some background on this choice see #15269.
showIface :: Logger -> DynFlags -> UnitState -> NameCache -> FilePath -> IO ()
showIface logger dflags unit_state name_cache filename = do
let profile = targetProfile dflags
- printer = logMsg logger MCOutput noSrcSpan . withPprStyle defaultDumpStyle
+ printer = logOutput logger . withPprStyle defaultDumpStyle
-- skip the hi way check; we don't want to worry about profiled vs.
-- non-profiled interfaces, for example.
@@ -1119,7 +1118,7 @@ showIface logger dflags unit_state name_cache filename = do
neverQualifyModules
neverQualifyPackages
alwaysPrintPromTick
- logMsg logger MCDump noSrcSpan
+ logMsg logger $ MCDump
$ withPprStyle (mkDumpStyle name_ppr_ctx)
$ pprModIface unit_state iface
=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -25,6 +25,7 @@ import GHC.Linker.Types
import GHC.Types.SrcLoc
import GHC.Types.Unique.DSet
import GHC.Types.Unique.DFM
+import GHC.Types.Error (formatFatalLocMessage)
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -231,7 +232,7 @@ splice point about what we would prefer.
-}
dieWith :: LinkDepsOpts -> SrcSpan -> SDoc -> IO a
-dieWith opts span msg = throwProgramError opts (mkLocMessage MCFatal span msg)
+dieWith opts span msg = throwProgramError opts (formatFatalLocMessage span msg)
throwProgramError :: LinkDepsOpts -> SDoc -> IO a
throwProgramError opts doc = throwGhcExceptionIO (ProgramError (renderWithContext (ldPprOpts opts) doc))
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -507,7 +507,7 @@ classifyLdInput logger platform f
| isObjectFilename platform f = return (Just (Objects [f]))
| isDynLibFilename platform f = return (Just (DLLPath f))
| otherwise = do
- logMsg logger MCInfo noSrcSpan
+ logInfo logger
$ withPprStyle defaultUserStyle
(text ("Warning: ignoring unrecognised input `" ++ f ++ "'"))
return Nothing
@@ -1638,9 +1638,8 @@ addEnvPaths name list
maybePutSDoc :: Logger -> SDoc -> IO ()
maybePutSDoc logger s
= when (logVerbAtLeast logger 2) $
- logMsg logger
+ logMsg logger $
MCInteractive
- noSrcSpan
$ withPprStyle defaultUserStyle s
maybePutStr :: Logger -> String -> IO ()
=====================================
compiler/GHC/Runtime/Debugger.hs
=====================================
@@ -209,7 +209,7 @@ showTerm term = do
setSession new_env
-- this disables logging of errors
- let noop_log _ _ _ _ = return ()
+ let noop_log _ _ = return ()
pushLogHookM (const noop_log)
return (hsc_env, bname)
=====================================
compiler/GHC/Stg/Lint.hs
=====================================
@@ -104,6 +104,7 @@ import GHC.Stg.Utils
import GHC.Core.DataCon
import GHC.Core ( AltCon(..) )
import GHC.Core.Type
+import GHC.Core.Lint ( lintMessage )
import GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isMarkedCbv )
import GHC.Types.CostCentre ( isCurrentCCS )
@@ -148,8 +149,7 @@ lintStgTopBindings platform logger diag_opts opts extra_vars this_mod unarised w
Nothing ->
return ()
Just msg -> do
- logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] in "GHC.Core.Lint"
- $ withPprStyle defaultDumpStyle
+ lintMessage logger
(vcat [ text "*** Stg Lint ErrMsgs: in" <+>
text whodunit <+> text "***",
msg,
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -864,7 +864,7 @@ wrapDocLoc doc = do
if logHasDumpFlag logger Opt_D_ppr_debug
then do
loc <- getSrcSpanM
- return (mkLocMessage MCOutput loc doc)
+ return (formatLocMessage loc doc)
else
return doc
@@ -2343,8 +2343,7 @@ failIfM msg = do
env <- getLclEnv
let full_msg = (if_loc env <> colon) $$ nest 2 msg
logger <- getLogger
- liftIO (logMsg logger MCFatal
- noSrcSpan $ withPprStyle defaultErrStyle full_msg)
+ liftIO $ fatalErrorMsg logger full_msg
failM
--------------------
@@ -2376,10 +2375,7 @@ forkM doc thing_inside
logger <- getLogger
let msg = hang (text "forkM failed:" <+> doc)
2 (text (show exn))
- liftIO $ logMsg logger
- MCFatal
- noSrcSpan
- $ withPprStyle defaultErrStyle msg
+ liftIO $ fatalErrorMsg logger msg
; traceIf (text "} ending fork (badly)" <+> doc)
; pgmError "Cannot continue after interface file error" }
}
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.Types.Error
-- * Classifying Messages
- , MessageClass (MCDiagnostic, ..)
+ , Message (MCDiagnostic, ..)
, Severity (..)
, Diagnostic (..)
, UnknownDiagnostic (..)
@@ -70,8 +70,8 @@ module GHC.Types.Error
, mapDecoratedSDoc
, pprMessageBag
- , mkLocMessage
- , mkLocMessageWarningGroups
+ , formatLocMessage
+ , formatFatalLocMessage
, formatDiagnostic
, getCaretDiagnostic
@@ -479,22 +479,22 @@ data MsgEnvelope e = MsgEnvelope
-- | The class for a diagnostic message. The main purpose is to classify a
-- message within GHC, to distinguish it from a debug/dump message vs a proper
-- diagnostic, for which we include a 'DiagnosticReason'.
-data MessageClass
- = MCOutput
- | MCFatal
- | MCInteractive
+data Message
+ = MCOutput SDoc
+ | MCFatal SDoc
+ | MCInteractive SDoc
- | MCDump
+ | MCDump SDoc
-- ^ Log message intended for compiler developers
-- No file\/line\/column stuff
- | MCInfo
+ | MCInfo SDoc
-- ^ Log messages intended for end users.
-- No file\/line\/column stuff.
- | UnsafeMCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode)
+ | UnsafeMCDiagnostic SrcSpan Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) SDoc JsonDoc
-- ^ Diagnostics from the compiler. This constructor is very powerful as
- -- it allows the construction of a 'MessageClass' with a completely
+ -- it allows the construction of a 'Message' with a completely
-- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such,
-- users are encouraged to use higher level primitives
-- instead. Use this constructor directly only if you need to construct
@@ -508,8 +508,8 @@ data MessageClass
-- should always have a 'DiagnosticCode'. See Note [Diagnostic codes].
{-# COMPLETE MCOutput, MCFatal, MCInteractive, MCDump, MCInfo, MCDiagnostic #-}
-pattern MCDiagnostic :: Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass
-pattern MCDiagnostic severity reason code <- UnsafeMCDiagnostic severity reason code
+pattern MCDiagnostic :: SrcSpan -> Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> Message
+pattern MCDiagnostic span severity reason code <- UnsafeMCDiagnostic span severity reason code _diagnostic _json
{-
Note [Suppressing Messages]
@@ -538,9 +538,6 @@ the "SevIgnore one" for a number of reasons:
-- | Used to describe warnings and errors
--- o The message has a file\/line\/column heading,
--- plus "warning:" or "error:",
--- added by mkLocMessage
-- o With 'SevIgnore' the message is suppressed
-- o Output is intended for end users
data Severity
@@ -563,15 +560,6 @@ instance ToJson Severity where
json SevWarning = JSString "Warning"
json SevError = JSString "Error"
-instance ToJson MessageClass where
- json MCOutput = JSString "MCOutput"
- json MCFatal = JSString "MCFatal"
- json MCInteractive = JSString "MCInteractive"
- json MCDump = JSString "MCDump"
- json MCInfo = JSString "MCInfo"
- json (MCDiagnostic sev reason code) =
- JSString $ renderWithContext defaultSDocContext (ppr $ text "MCDiagnostic" <+> ppr sev <+> ppr reason <+> ppr code)
-
instance ToJson DiagnosticCode where
json c = JSInt (fromIntegral (diagnosticCodeNumber c))
@@ -646,35 +634,14 @@ showMsgEnvelope err =
pprMessageBag :: Bag SDoc -> SDoc
pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))
-mkLocMessage
- :: MessageClass -- ^ What kind of message?
- -> SrcSpan -- ^ location
- -> SDoc -- ^ message
- -> SDoc
-mkLocMessage = mkLocMessageWarningGroups True
-
--- | Make an error message with location info, specifying whether to show
--- warning groups (if applicable).
-mkLocMessageWarningGroups
- :: Bool -- ^ Print warning groups (if applicable)?
- -> MessageClass -- ^ What kind of message?
- -> SrcSpan -- ^ location
- -> SDoc -- ^ message
- -> SDoc
-mkLocMessageWarningGroups show_warn_groups msg_class locn msg
- = case msg_class of
- MCDiagnostic severity reason code -> formatDiagnostic show_warn_groups locn severity reason code msg
- _ -> sdocOption sdocColScheme $ \col_scheme ->
- let
- msg_colour = getMessageClassColour msg_class col_scheme
-
- msg_title = coloured msg_colour $
- case msg_class of
- MCFatal -> text "fatal"
- _ -> empty
-
+formatFatalLocMessage :: SrcSpan -> SDoc -> SDoc
+formatFatalLocMessage locn msg = sdocOption sdocColScheme $ \col_scheme ->
+ let msg_title = coloured (Col.sFatal col_scheme) $ text "fatal"
in formatLocMessageWarningGroups locn msg_title empty empty msg
+formatLocMessage :: SrcSpan -> SDoc -> SDoc
+formatLocMessage span = formatLocMessageWarningGroups span empty empty empty
+
formatDiagnostic
:: Bool -- ^ Print warning groups?
-> SrcSpan -- ^ location
@@ -784,13 +751,7 @@ formatLocMessageWarningGroups locn msg_title code_doc warning_flag_doc msg
code_doc <+> warning_flag_doc
in coloured (Col.sMessage col_scheme)
- (hang (coloured (Col.sHeader col_scheme) header) 4
- msg)
-
-getMessageClassColour :: MessageClass -> Col.Scheme -> Col.PprColour
-getMessageClassColour (MCDiagnostic severity _reason _code) = getSeverityColour severity
-getMessageClassColour MCFatal = Col.sFatal
-getMessageClassColour _ = const mempty
+ $ hang (coloured (Col.sHeader col_scheme) header) 4 msg
getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour
getSeverityColour severity = case severity of
@@ -798,9 +759,9 @@ getSeverityColour severity = case severity of
SevWarning -> Col.sWarning
SevIgnore -> const mempty
-getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc
+getCaretDiagnostic :: Severity -> SrcSpan -> IO SDoc
getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
-getCaretDiagnostic msg_class (RealSrcSpan span _) =
+getCaretDiagnostic severity (RealSrcSpan span _) =
caretDiagnostic <$> getSrcLine (srcSpanFile span) row
where
getSrcLine fn i =
@@ -833,7 +794,7 @@ getCaretDiagnostic msg_class (RealSrcSpan span _) =
caretDiagnostic Nothing = empty
caretDiagnostic (Just srcLineWithNewline) =
sdocOption sdocColScheme$ \col_scheme ->
- let sevColour = getMessageClassColour msg_class col_scheme
+ let sevColour = getSeverityColour severity col_scheme
marginColour = Col.sMargin col_scheme
in
coloured marginColour (text marginSpace) <>
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.Utils.Error (
-- * Messages
Diagnostic(..),
MsgEnvelope(..),
- MessageClass(..),
+ Message(..),
SDoc,
DecoratedSDoc(unDecorated),
Messages,
@@ -28,7 +28,7 @@ module GHC.Utils.Error (
-- ** Construction
DiagOpts (..), emptyDiagOpts, diag_wopt, diag_fatal_wopt,
- emptyMessages, mkDecorated, mkLocMessage,
+ emptyMessages, mkDecorated,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
mkLintWarning, diagReasonSeverity,
@@ -282,9 +282,8 @@ unsafePprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s
, errMsgContext = name_ppr_ctx
, errMsgReason = reason })
= withErrStyle name_ppr_ctx $
- mkLocMessage
- (UnsafeMCDiagnostic sev reason (diagnosticCode e))
- s
+ formatDiagnostic True
+ s sev reason (diagnosticCode e)
(formatBulleted $ diagnosticMessage opts e)
sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e]
@@ -314,7 +313,7 @@ ghcExit logger val
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
- logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
+ logMsg logger $ MCFatal (withPprStyle defaultErrStyle msg)
compilationProgressMsg :: Logger -> SDoc -> IO ()
compilationProgressMsg logger msg = do
@@ -475,11 +474,11 @@ printOutputForUser logger name_ppr_ctx msg
= logOutput logger (withUserStyle name_ppr_ctx AllTheWay msg)
logInfo :: Logger -> SDoc -> IO ()
-logInfo logger msg = logMsg logger MCInfo noSrcSpan msg
+logInfo logger = logMsg logger . MCInfo
-- | Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'
logOutput :: Logger -> SDoc -> IO ()
-logOutput logger msg = logMsg logger MCOutput noSrcSpan msg
+logOutput logger = logMsg logger . MCOutput
prettyPrintGhcErrors :: ExceptionMonad m => Logger -> m a -> m a
=====================================
compiler/GHC/Utils/Logger.hs
=====================================
@@ -24,7 +24,6 @@ module GHC.Utils.Logger
-- * Logger setup
, initLogger
, LogAction
- , LogJsonAction
, DumpAction
, TraceAction
, DumpFormat (..)
@@ -32,8 +31,6 @@ module GHC.Utils.Logger
-- ** Hooks
, popLogHook
, pushLogHook
- , popJsonLogHook
- , pushJsonLogHook
, popDumpHook
, pushDumpHook
, popTraceHook
@@ -55,15 +52,11 @@ module GHC.Utils.Logger
, putLogMsg
, defaultLogAction
, defaultLogActionWithHandles
- , defaultLogJsonAction
, defaultLogActionHPrintDoc
, defaultLogActionHPutStrDoc
, logMsg
- , logJsonMsg
, logDumpMsg
- , decorateDiagnostic
-
-- * Dumping
, defaultDumpAction
, putDumpFile
@@ -85,16 +78,14 @@ where
import GHC.Prelude
import GHC.Driver.Flags
import GHC.Types.Error
-import GHC.Types.SrcLoc
import qualified GHC.Utils.Ppr as Pretty
import GHC.Utils.Outputable
-import GHC.Utils.Json
import GHC.Utils.Panic
+import GHC.Utils.Json (renderJSON)
import GHC.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
-import GHC.Data.FastString
import System.Directory
import System.FilePath ( takeDirectory, (</>) )
@@ -182,16 +173,9 @@ setLogFlags logger flags = logger { logFlags = flags }
---------------------------------------------------------------
type LogAction = LogFlags
- -> MessageClass
- -> SrcSpan
- -> SDoc
+ -> Message
-> IO ()
-type LogJsonAction = LogFlags
- -> MessageClass
- -> JsonDoc
- -> IO ()
-
type DumpAction = LogFlags
-> PprStyle
-> DumpFlag
@@ -229,9 +213,6 @@ data Logger = Logger
{ log_hook :: [LogAction -> LogAction]
-- ^ Log hooks stack
- , json_log_hook :: [LogJsonAction -> LogJsonAction]
- -- ^ Json log hooks stack
-
, dump_hook :: [DumpAction -> DumpAction]
-- ^ Dump hooks stack
@@ -267,7 +248,6 @@ initLogger = do
dumps <- newMVar Map.empty
return $ Logger
{ log_hook = []
- , json_log_hook = []
, dump_hook = []
, trace_hook = []
, generated_dumps = dumps
@@ -279,10 +259,6 @@ initLogger = do
putLogMsg :: Logger -> LogAction
putLogMsg logger = foldr ($) defaultLogAction (log_hook logger)
--- | Log a JsonDoc
-putJsonLogMsg :: Logger -> LogJsonAction
-putJsonLogMsg logger = foldr ($) defaultLogJsonAction (json_log_hook logger)
-
-- | Dump something
putDumpFile :: Logger -> DumpAction
putDumpFile logger =
@@ -307,15 +283,6 @@ popLogHook logger = case log_hook logger of
[] -> panic "popLogHook: empty hook stack"
_:hs -> logger { log_hook = hs }
--- | Push a json log hook
-pushJsonLogHook :: (LogJsonAction -> LogJsonAction) -> Logger -> Logger
-pushJsonLogHook h logger = logger { json_log_hook = h:json_log_hook logger }
-
-popJsonLogHook :: Logger -> Logger
-popJsonLogHook logger = case json_log_hook logger of
- [] -> panic "popJsonLogHook: empty hook stack"
- _:hs -> logger { json_log_hook = hs}
-
-- | Push a dump hook
pushDumpHook :: (DumpAction -> DumpAction) -> Logger -> Logger
pushDumpHook h logger = logger { dump_hook = h:dump_hook logger }
@@ -344,8 +311,8 @@ makeThreadSafe logger = do
with_lock :: forall a. IO a -> IO a
with_lock act = withMVar lock (const act)
- log action logflags msg_class loc doc =
- with_lock (action logflags msg_class loc doc)
+ log action logflags message =
+ with_lock (action logflags message)
dmp action logflags sty opts str fmt doc =
with_lock (action logflags sty opts str fmt doc)
@@ -359,49 +326,6 @@ makeThreadSafe logger = do
$ pushTraceHook trc
$ logger
--- See Note [JSON Error Messages]
-defaultLogJsonAction :: LogJsonAction
-defaultLogJsonAction logflags msg_class jsdoc =
- case msg_class of
- MCOutput -> printOut msg
- MCDump -> printOut (msg $$ blankLine)
- MCInteractive -> putStrSDoc msg
- MCInfo -> printErrs msg
- MCFatal -> printErrs msg
- MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message
- MCDiagnostic _sev _rea _code -> printErrs msg
- where
- printOut = defaultLogActionHPrintDoc logflags False stdout
- printErrs = defaultLogActionHPrintDoc logflags False stderr
- putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout
- msg = renderJSON jsdoc
-
--- See Note [JSON Error Messages]
--- this is to be removed
-jsonLogActionWithHandle :: Handle {-^ Standard out -} -> LogAction
-jsonLogActionWithHandle _ _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message
-jsonLogActionWithHandle out logflags msg_class srcSpan msg
- =
- defaultLogActionHPutStrDoc logflags True out
- (withPprStyle PprCode (doc $$ text ""))
- where
- str = renderWithContext (log_default_user_context logflags) msg
- doc = renderJSON $
- JSObject [ ( "span", spanToDumpJSON srcSpan )
- , ( "doc" , JSString str )
- , ( "messageClass", json msg_class )
- ]
- spanToDumpJSON :: SrcSpan -> JsonDoc
- spanToDumpJSON s = case s of
- (RealSrcSpan rss _) -> JSObject [ ("file", json file)
- , ("startLine", json $ srcSpanStartLine rss)
- , ("startCol", json $ srcSpanStartCol rss)
- , ("endLine", json $ srcSpanEndLine rss)
- , ("endCol", json $ srcSpanEndCol rss)
- ]
- where file = unpackFS $ srcSpanFile rss
- UnhelpfulSpan _ -> JSNull
-
-- | The default 'LogAction' prints to 'stdout' and 'stderr'.
--
-- To replicate the default log action behaviour with different @out@ and @err@
@@ -412,72 +336,24 @@ defaultLogAction = defaultLogActionWithHandles stdout stderr
-- | The default 'LogAction' parametrized over the standard output and standard error handles.
-- Allows clients to replicate the log message formatting of GHC with custom handles.
defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction
-defaultLogActionWithHandles out err logflags msg_class srcSpan msg
- | log_dopt Opt_D_dump_json logflags = jsonLogActionWithHandle out logflags msg_class srcSpan msg
- | otherwise = case msg_class of
- MCOutput -> printOut msg
- MCDump -> printOut (msg $$ blankLine)
- MCInteractive -> putStrSDoc msg
- MCInfo -> printErrs msg
- MCFatal -> printErrs msg
- MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message
- MCDiagnostic _sev _rea _code -> decorateDiagnostic logflags msg_class srcSpan msg >>= printErrs
+defaultLogActionWithHandles out err logflags message
+ = case message of
+ MCOutput msg -> printOut msg
+ MCDump msg -> printOut (msg $$ blankLine)
+ MCInteractive msg -> putStrSDoc msg
+ MCInfo msg -> printErrs msg
+ MCFatal msg -> printErrs msg
+ MCDiagnostic _ SevIgnore _ _ -> pure () -- suppress the message
+ UnsafeMCDiagnostic _span _severity _reason _code doc json -> do
+ if log_diagnostics_as_json logflags then do
+ printErrs (renderJSON json)
+ else do
+ printErrs doc
where
printOut = defaultLogActionHPrintDoc logflags False out
printErrs = defaultLogActionHPrintDoc logflags False err
putStrSDoc = defaultLogActionHPutStrDoc logflags False out
--- This function is used by `defaultLogActionWithHandles` for non-JSON output,
--- and also by `GHC.Driver.Errors.printMessages` to produce the `rendered`
--- message on `-fdiagnostics-as-json`.
---
--- We would want to eventually consolidate this. However, this is currently
--- not feasible for the following reasons:
---
--- 1. Some parts of the compiler sidestep `printMessages`, for that reason we
--- can not decorate the message in `printMessages`.
---
--- 2. GHC uses two different code paths for JSON and non-JSON diagnostics. For
--- that reason we can not decorate the message in `defaultLogActionWithHandles`.
---
--- See also Note [JSON Error Messages]:
---
--- `jsonLogAction` should be removed along with -ddump-json
---
--- Also note that (1) is the reason why some parts of the compiler produce
--- diagnostics that don't respect `-fdiagnostics-as-json`.
---
--- The plan as I see it is as follows:
---
--- 1. Refactor all places in the compiler that report diagnostics to go
--- through `GHC.Driver.Errors.printMessages`.
---
--- (It's easy to find all those places by looking for who creates
--- MCDiagnostic, either directly or via `mkMCDiagnostic` or
--- `errorDiagnostic`.)
---
--- 2. Get rid of `-ddump-json`, `jsonLogAction` and consolidate message
--- decoration at one place (either `printMessages` or
--- `defaultLogActionWithHandles`)
---
--- This story is tracked by #24113.
-decorateDiagnostic :: LogFlags -> MessageClass -> SrcSpan -> SDoc -> IO SDoc
-decorateDiagnostic logflags msg_class srcSpan msg = addCaret
- where
- -- Pretty print the warning flag, if any (#10752)
- message :: SDoc
- message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg
-
- addCaret :: IO SDoc
- addCaret = do
- caretDiagnostic <-
- if log_show_caret logflags
- then getCaretDiagnostic msg_class srcSpan
- else pure empty
- return $ getPprStyle $ \style ->
- withPprStyle (setStyleColoured True style)
- (message $+$ caretDiagnostic $+$ blankLine)
-
-- | Like 'defaultLogActionHPutStrDoc' but appends an extra newline.
defaultLogActionHPrintDoc :: LogFlags -> Bool -> Handle -> SDoc -> IO ()
defaultLogActionHPrintDoc logflags asciiSpace h d
@@ -491,28 +367,6 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d
-- calls to this log-action can output all on the same line
= printSDoc (log_default_user_context logflags) (Pretty.PageMode asciiSpace) h d
---
--- Note [JSON Error Messages]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- When the user requests the compiler output to be dumped as json
--- we used to collect them all in an IORef and then print them at the end.
--- This doesn't work very well with GHCi. (See #14078) So instead we now
--- use the simpler method of just outputting a JSON document inplace to
--- stdout.
---
--- Before the compiler calls log_action, it has already turned the `ErrMsg`
--- into a formatted message. This means that we lose some possible
--- information to provide to the user but refactoring log_action is quite
--- invasive as it is called in many places. So, for now I left it alone
--- and we can refine its behaviour as users request different output.
---
--- The recent work here replaces the purpose of flag -ddump-json with
--- -fdiagnostics-as-json. For temporary backwards compatibility while
--- -ddump-json is being deprecated, `jsonLogAction` has been added in, but
--- it should be removed along with -ddump-json. Similarly, the guard in
--- `defaultLogAction` should be removed. This cleanup is tracked in #24113.
-
-- | Default action for 'dumpAction' hook
defaultDumpAction :: DumpCache -> LogAction -> DumpAction
defaultDumpAction dumps log_action logflags sty flag title _fmt doc =
@@ -545,10 +399,10 @@ dumpSDocWithStyle dumps log_action sty logflags flag hdr doc =
-- write the dump to stdout
writeDump Nothing = do
- let (doc', msg_class)
- | null hdr = (doc, MCOutput)
- | otherwise = (mkDumpDoc hdr doc, MCDump)
- log_action logflags msg_class noSrcSpan (withPprStyle sty doc')
+ let message
+ | null hdr = MCOutput (withPprStyle sty doc)
+ | otherwise = MCDump (withPprStyle sty $ mkDumpDoc hdr doc)
+ log_action logflags message
-- | Run an action with the handle of a 'DumpFlag' if we are outputting to a
@@ -638,11 +492,8 @@ defaultTraceAction logflags title doc x =
-- | Log something
-logMsg :: Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
-logMsg logger mc loc msg = putLogMsg logger (logFlags logger) mc loc msg
-
-logJsonMsg :: Logger -> MessageClass -> JsonDoc -> IO ()
-logJsonMsg logger mc = putJsonLogMsg logger (logFlags logger) mc
+logMsg :: Logger -> Message -> IO ()
+logMsg logger = putLogMsg logger (logFlags logger)
-- | Dump something
logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
@@ -654,7 +505,7 @@ logTraceMsg logger hdr doc a = putTraceMsg logger (logFlags logger) hdr doc a
-- | Log a dump message (not a dump file)
logDumpMsg :: Logger -> String -> SDoc -> IO ()
-logDumpMsg logger hdr doc = logMsg logger MCDump noSrcSpan
+logDumpMsg logger hdr doc = logMsg logger $ MCDump
(withPprStyle defaultDumpStyle
(mkDumpDoc hdr doc))
=====================================
docs/users_guide/debugging.rst
=====================================
@@ -55,13 +55,6 @@ Dumping out compiler intermediate structures
``Main.p.dump-simpl`` and ``Main.dump-simpl`` instead of overwriting the
output of one way with the output of another.
-.. ghc-flag:: -ddump-json
- :shortdesc: *(deprecated)* Use :ghc-flag:`-fdiagnostics-as-json` instead
- :type: dynamic
-
- This flag was previously used to generated JSON formatted GHC diagnostics,
- but has been deprecated. Instead, use :ghc-flag:`-fdiagnostics-as-json`.
-
.. ghc-flag:: -dshow-passes
:shortdesc: Print out each pass name as it happens
:type: dynamic
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -498,8 +498,6 @@ interactiveUI config srcs maybe_exprs = do
installInteractiveHomeUnits
- -- Update the LogAction. Ensure we don't override the user's log action lest
- -- we break -ddump-json (#14078)
lastErrLocationsRef <- liftIO $ newIORef []
pushLogHookM (ghciLogAction lastErrLocationsRef)
@@ -835,10 +833,10 @@ resetLastErrorLocations = do
ghciLogAction :: IORef [(FastString, Int)] -> LogAction -> LogAction
ghciLogAction lastErrLocations old_log_action
- dflags msg_class srcSpan msg = do
- old_log_action dflags msg_class srcSpan msg
- case msg_class of
- MCDiagnostic SevError _reason _code -> case srcSpan of
+ dflags msg = do
+ old_log_action dflags msg
+ case msg of
+ MCDiagnostic srcSpan SevError _reason _code -> case srcSpan of
RealSrcSpan rsp _ -> modifyIORef lastErrLocations
(++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
_ -> return ()
=====================================
testsuite/tests/driver/T16167.stderr
=====================================
@@ -1 +1,2 @@
+{"version":"1.2","ghcVersion":"ghc-9.15.20250819","span":{"file":"T16167.hs","start":{"line":1,"column":8},"end":{"line":1,"column":9}},"severity":"Error","code":58481,"rendered":"T16167.hs:1:8: error: [GHC-58481] parse error on input \u2018f\u2019\n","message":["parse error on input \u2018f\u2019"],"hints":[]}
*** Exception: ExitFailure 1
=====================================
testsuite/tests/driver/T16167.stdout deleted
=====================================
@@ -1,2 +0,0 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":{"file":"T16167.hs","startLine":1,"startCol":8,"endLine":1,"endCol":9},"doc":"parse error on input \u2018f\u2019","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-58481"}
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -274,12 +274,11 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef'])
test('T12955', normal, makefile_test, [])
test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
-test('json_dump', normal, compile_fail, ['-ddump-json'])
test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches -Wx-partial'])
-test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
+test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -fdiagnostics-as-json -Wno-unsupported-llvm-version'])
test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
- ['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
+ ['{compiler} -x hs -e ":set prog T16167.hs" -fdiagnostics-as-json T16167.hs'])
test('T13604', [], makefile_test, [])
test('T13604a',
[ js_broken(22261) # require HPC support
=====================================
testsuite/tests/driver/json2.stderr
=====================================
@@ -1,2 +1,4 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":null,"doc":"TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [(normal, base-4.21.0.0)]","messageClass":"MCOutput"}
+TYPE SIGNATURES
+ foo :: forall a. a -> a
+Dependent modules: []
+Dependent packages: [(normal, base-4.21.0.0)]
=====================================
testsuite/tests/driver/json_dump.hs deleted
=====================================
@@ -1,6 +0,0 @@
-module Foo where
-
-import Data.List
-
-id1 :: a -> a
-id1 = 5
=====================================
testsuite/tests/driver/json_dump.stderr deleted
=====================================
@@ -1,2 +0,0 @@
-{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"}
-{"span":{"file":"json_dump.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"}
=====================================
testsuite/tests/ghc-api/T7478/T7478.hs
=====================================
@@ -24,11 +24,11 @@ compileInGhc targets handlerOutput = do
flags0 <- getSessionDynFlags
let flags = flags0 {verbosity = 1 }
setSessionDynFlags flags
- let collectSrcError handlerOutput _flags MCOutput _srcspan msg
+ let collectSrcError _flags (MCOutput msg)
= handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg
- collectSrcError _ _ _ _ _
+ collectSrcError _ _
= return ()
- pushLogHookM (const (collectSrcError handlerOutput))
+ pushLogHookM (const collectSrcError)
-- Set up targets.
oldTargets <- getTargets
let oldFiles = map fileFromTarget oldTargets
=====================================
testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs
=====================================
@@ -19,6 +19,6 @@ hooksP opts hsc_env = do
return hsc_env'
logHook :: LogAction -> LogAction
-logHook action logFlags messageClass srcSpan msgDoc = do
+logHook action logFlags message = do
putStrLn "Log hook called"
- action logFlags messageClass srcSpan msgDoc
+ action logFlags message
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0465d8c6c112b8c0dbfae85a7af30e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0465d8c6c112b8c0dbfae85a7af30e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Cheng Shao pushed new branch wip/hoopl-coerce at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hoopl-coerce
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] compiler: fix closure C type in SPT init code
by Marge Bot (＠marge-bot) 22 Aug '25
by Marge Bot (＠marge-bot) 22 Aug '25
22 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6a43f8ec by Cheng Shao at 2025-08-21T17:52:52-04:00
compiler: fix closure C type in SPT init code
This patch fixes the closure C type in SPT init code to StgClosure,
instead of the previously incorrect StgPtr. Having an incorrect C type
makes SPT init code not compatible with other foreign stub generation
logic, which may also emit their own extern declarations for the same
closure symbols and thus will clash with the incorrect prototypes in
SPT init code.
- - - - -
1 changed file:
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
Changes:
=====================================
compiler/GHC/Iface/Tidy/StaticPtrTable.hs
=====================================
@@ -17,18 +17,18 @@
-- > static void hs_hpc_init_Main(void) {
-- >
-- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
--- > extern StgPtr Main_r2wb_closure;
+-- > extern StgClosure Main_r2wb_closure;
-- > hs_spt_insert(k0, &Main_r2wb_closure);
-- >
-- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
--- > extern StgPtr Main_r2wc_closure;
+-- > extern StgClosure Main_r2wc_closure;
-- > hs_spt_insert(k1, &Main_r2wc_closure);
-- >
-- > }
--
-- where the constants are fingerprints produced from the static forms.
--
--- The linker must find the definitions matching the @extern StgPtr <name>@
+-- The linker must find the definitions matching the @extern StgClosure <name>@
-- declarations. For this to work, the identifiers of static pointers need to be
-- exported. This is done in 'GHC.Core.Opt.SetLevels.newLvlVar'.
--
@@ -263,7 +263,7 @@ sptModuleInitCode platform this_mod entries
-- CLabel. Regardless, MayHaveCafRefs/NoCafRefs wouldn't make
-- any difference here, they would pretty-print to the same
-- foreign stub content.
- $$ text "extern StgPtr "
+ $$ text "extern StgClosure "
<> (pprCLabel platform $ mkClosureLabel n MayHaveCafRefs) <> semi
$$ text "hs_spt_insert" <> parens
(hcat $ punctuate comma
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a43f8ec2e679d1240ddf6de597bc2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a43f8ec2e679d1240ddf6de597bc2f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Serialize wired-in names as external names when creating HIE files
by Marge Bot (＠marge-bot) 22 Aug '25
by Marge Bot (＠marge-bot) 22 Aug '25
22 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
42724462 by Simon Hengel at 2025-08-21T17:52:11-04:00
Serialize wired-in names as external names when creating HIE files
Note that the domain of de-serialized names stays the same.
Specifically, for known-key names, before `lookupKnownKeyName` was used,
while now this is handled by `lookupOrigNameCache` which captures the
same range provided that the OrigNameCache has been initialized with
`knownKeyNames` (which is the case by default).
(fixes #26238)
- - - - -
4 changed files:
- compiler/GHC/Iface/Ext/Binary.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/Types/Name/Cache.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
Changes:
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -17,7 +17,6 @@ where
import GHC.Prelude
-import GHC.Builtin.Utils
import GHC.Settings.Utils ( maybeRead )
import GHC.Settings.Config ( cProjectVersion )
import GHC.Utils.Binary
@@ -28,10 +27,8 @@ import GHC.Iface.Binary ( putAllTables )
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Unique
import GHC.Types.Unique.FM
import qualified GHC.Utils.Binary as Binary
-import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified Data.Array as A
@@ -290,6 +287,9 @@ fromHieName nc hie_name = do
case hie_name of
ExternalName mod occ span -> updateNameCache nc mod occ $ \cache -> do
case lookupOrigNameCache cache mod occ of
+ -- Note that this may be a wired-in name (provided that the NameCache
+ -- was initialized with known-key names, which is always the case if you
+ -- use `newNameCache`).
Just name -> pure (cache, name)
Nothing -> do
uniq <- takeUniqFromNameCache nc
@@ -302,11 +302,6 @@ fromHieName nc hie_name = do
-- don't update the NameCache for local names
pure $ mkInternalName uniq occ span
- KnownKeyName u -> case lookupKnownKeyName u of
- Nothing -> pprPanic "fromHieName:unknown known-key unique"
- (ppr u)
- Just n -> pure n
-
-- ** Reading and writing `HieName`'s
putHieName :: WriteBinHandle -> HieName -> IO ()
@@ -316,9 +311,6 @@ putHieName bh (ExternalName mod occ span) = do
putHieName bh (LocalName occName span) = do
putByte bh 1
put_ bh (occName, BinSrcSpan span)
-putHieName bh (KnownKeyName uniq) = do
- putByte bh 2
- put_ bh $ unpkUnique uniq
getHieName :: ReadBinHandle -> IO HieName
getHieName bh = do
@@ -330,7 +322,4 @@ getHieName bh = do
1 -> do
(occ, span) <- get bh
return $ LocalName occ $ unBinSrcSpan span
- 2 -> do
- (c,i) <- get bh
- return $ KnownKeyName $ mkUnique c i
_ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag"
=====================================
compiler/GHC/Iface/Ext/Types.hs
=====================================
@@ -19,14 +19,12 @@ import GHC.Prelude
import GHC.Settings.Config
import GHC.Utils.Binary
import GHC.Data.FastString
-import GHC.Builtin.Utils
import GHC.Iface.Type
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Types.SrcLoc
import GHC.Types.Avail
-import GHC.Types.Unique
import qualified GHC.Utils.Outputable as O ( (<>) )
import GHC.Utils.Panic
import GHC.Core.ConLike ( ConLike(..) )
@@ -766,7 +764,6 @@ instance Binary TyVarScope where
data HieName
= ExternalName !Module !OccName !SrcSpan
| LocalName !OccName !SrcSpan
- | KnownKeyName !Unique
deriving (Eq)
instance Ord HieName where
@@ -774,34 +771,28 @@ instance Ord HieName where
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (LocalName a b) (LocalName c d) = compare a c S.<> leftmost_smallest b d
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
- compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
- -- Not actually non deterministic as it is a KnownKey
compare ExternalName{} _ = LT
compare LocalName{} ExternalName{} = GT
- compare LocalName{} _ = LT
- compare KnownKeyName{} _ = GT
instance Outputable HieName where
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
- ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
hieNameOcc :: HieName -> OccName
hieNameOcc (ExternalName _ occ _) = occ
hieNameOcc (LocalName occ _) = occ
-hieNameOcc (KnownKeyName u) =
- case lookupKnownKeyName u of
- Just n -> nameOccName n
- Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
- (ppr u)
toHieName :: Name -> HieName
-toHieName name
- | isKnownKeyName name = KnownKeyName (nameUnique name)
- | isExternalName name = ExternalName (nameModule name)
- (nameOccName name)
- (removeBufSpan $ nameSrcSpan name)
- | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
+toHieName name =
+ case nameModule_maybe name of
+ Nothing -> LocalName occName span
+ Just m -> ExternalName m occName span
+ where
+ occName :: OccName
+ occName = nameOccName name
+
+ span :: SrcSpan
+ span = removeBufSpan $ nameSrcSpan name
{- Note [Capture Entity Information]
=====================================
compiler/GHC/Types/Name/Cache.hs
=====================================
@@ -101,9 +101,14 @@ OrigNameCache at all? Good question; after all,
3) Loading of interface files encodes names via Uniques, as detailed in
Note [Symbol table representation of names] in GHC.Iface.Binary
-It turns out that we end up looking up built-in syntax in the cache when we
-generate Haddock documentation. E.g. if we don't find tuple data constructors
-there, hyperlinks won't work as expected. Test case: haddockHtmlTest (Bug923.hs)
+
+However note that:
+ 1) It turns out that we end up looking up built-in syntax in the cache when
+ we generate Haddock documentation. E.g. if we don't find tuple data
+ constructors there, hyperlinks won't work as expected. Test case:
+ haddockHtmlTest (Bug923.hs)
+ 2) HIE de-serialization relies on wired-in names, including built-in syntax,
+ being present in the OrigNameCache.
-}
-- | The NameCache makes sure that there is just one Unique assigned for
=====================================
utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
=====================================
@@ -229,10 +229,7 @@ writeInterfaceFile filename iface = do
return ()
freshNameCache :: IO NameCache
-freshNameCache =
- initNameCache
- 'a' -- ??
- []
+freshNameCache = newNameCache
-- | Read a Haddock (@.haddock@) interface file. Return either an
-- 'InterfaceFile' or an error message.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42724462e3cfaba426882711c869e4f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42724462e3cfaba426882711c869e4f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 22 Aug '25
by Hannes Siebenhandl (＠fendor) 22 Aug '25
22 Aug '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
2267763e by fendor at 2025-08-21T23:18:35+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
-------------------------
Metric Increase:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
-------------------------
These metric increases are unfortunate, they are most likely caused by
the larger (literally in terms of lines of code) stack decoder implementation
that are now linked into hello-word binaries.
On linux, it is almost a 10% increase, which is considerable.
- - - - -
b0ce7b46 by fendor at 2025-08-21T23:18:35+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
d98da02a by fendor at 2025-08-21T23:18:35+02:00
Remove stg_decodeStackzh
- - - - -
c727e33c by fendor at 2025-08-21T23:18:35+02:00
Remove ghcHeap from list of toolTargets
- - - - -
53 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- + libraries/ghc-heap/GHC/Exts/Heap/Constants.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hs
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- + libraries/ghc-heap/GHC/Exts/Stack/Constants.hs
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-heap/tests/stack-annotation/Makefile → libraries/ghc-internal/tests/stack-annotation/Makefile
- libraries/ghc-heap/tests/stack-annotation/TestUtils.hs → libraries/ghc-internal/tests/stack-annotation/TestUtils.hs
- libraries/ghc-heap/tests/stack-annotation/all.T → libraries/ghc-internal/tests/stack-annotation/all.T
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame001.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame002.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame003.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame004.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f255aff17d7dc7d043771fd9f7e060…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f255aff17d7dc7d043771fd9f7e060…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Remove deprecated functions from the ghci package
by Marge Bot (＠marge-bot) 22 Aug '25
by Marge Bot (＠marge-bot) 22 Aug '25
22 Aug '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
f0a19d74 by fendor at 2025-08-20T19:55:00-04:00
Remove deprecated functions from the ghci package
- - - - -
ebeb991b by fendor at 2025-08-20T19:55:00-04:00
base: Remove unstable heap representation details from GHC.Exts
- - - - -
e368e247 by Rodrigo Mesquita at 2025-08-20T19:55:42-04:00
bytecode: Use 32bits for breakpoint index
Fixes #26325
- - - - -
c938ca38 by Simon Hengel at 2025-08-21T14:01:47-04:00
Serialize wired-in names as external names when creating HIE files
Note that the domain of de-serialized names stays the same.
Specifically, for known-key names, before `lookupKnownKeyName` was used,
while now this is handled by `lookupOrigNameCache` which captures the
same range provided that the OrigNameCache has been initialized with
`knownKeyNames` (which is the case by default).
(fixes #26238)
- - - - -
b5431ced by Cheng Shao at 2025-08-21T14:01:51-04:00
compiler: fix closure C type in SPT init code
This patch fixes the closure C type in SPT init code to StgClosure,
instead of the previously incorrect StgPtr. Having an incorrect C type
makes SPT init code not compatible with other foreign stub generation
logic, which may also emit their own extern declarations for the same
closure symbols and thus will clash with the incorrect prototypes in
SPT init code.
- - - - -
14 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Iface/Ext/Binary.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/Types/Name/Cache.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Exts.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- rts/Disassembler.c
- rts/Interpreter.c
- − testsuite/tests/module/T21752.stderr
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -843,16 +843,18 @@ assembleI platform i = case i of
BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
p1 <- ptr $ BCOPtrBreakArray info_mod
- let -- cast that checks that round-tripping through Word16 doesn't change the value
- toW16 x = let r = fromIntegral x :: Word16
- in if fromIntegral r == x
+ let -- cast that checks that round-tripping through Word32 doesn't change the value
+ infoW32 = let r = fromIntegral infox :: Word32
+ in if fromIntegral r == infox
then r
- else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
+ else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr infox)
+ ix_hi = fromIntegral (infoW32 `shiftR` 16)
+ ix_lo = fromIntegral (infoW32 .&. 0xffff)
info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
np <- lit1 $ BCONPtrCostCentre ibi
emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
- , SmallOp (toW16 infox), Op np ]
+ , SmallOp ix_hi, SmallOp ix_lo, Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp (if active then 1 else 0)]
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -17,7 +17,6 @@ where
import GHC.Prelude
-import GHC.Builtin.Utils
import GHC.Settings.Utils ( maybeRead )
import GHC.Settings.Config ( cProjectVersion )
import GHC.Utils.Binary
@@ -28,10 +27,8 @@ import GHC.Iface.Binary ( putAllTables )
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Unique
import GHC.Types.Unique.FM
import qualified GHC.Utils.Binary as Binary
-import GHC.Utils.Outputable
import GHC.Utils.Panic
import qualified Data.Array as A
@@ -290,6 +287,9 @@ fromHieName nc hie_name = do
case hie_name of
ExternalName mod occ span -> updateNameCache nc mod occ $ \cache -> do
case lookupOrigNameCache cache mod occ of
+ -- Note that this may be a wired-in name (provided that the NameCache
+ -- was initialized with known-key names, which is always the case if you
+ -- use `newNameCache`).
Just name -> pure (cache, name)
Nothing -> do
uniq <- takeUniqFromNameCache nc
@@ -302,11 +302,6 @@ fromHieName nc hie_name = do
-- don't update the NameCache for local names
pure $ mkInternalName uniq occ span
- KnownKeyName u -> case lookupKnownKeyName u of
- Nothing -> pprPanic "fromHieName:unknown known-key unique"
- (ppr u)
- Just n -> pure n
-
-- ** Reading and writing `HieName`'s
putHieName :: WriteBinHandle -> HieName -> IO ()
@@ -316,9 +311,6 @@ putHieName bh (ExternalName mod occ span) = do
putHieName bh (LocalName occName span) = do
putByte bh 1
put_ bh (occName, BinSrcSpan span)
-putHieName bh (KnownKeyName uniq) = do
- putByte bh 2
- put_ bh $ unpkUnique uniq
getHieName :: ReadBinHandle -> IO HieName
getHieName bh = do
@@ -330,7 +322,4 @@ getHieName bh = do
1 -> do
(occ, span) <- get bh
return $ LocalName occ $ unBinSrcSpan span
- 2 -> do
- (c,i) <- get bh
- return $ KnownKeyName $ mkUnique c i
_ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag"
=====================================
compiler/GHC/Iface/Ext/Types.hs
=====================================
@@ -19,14 +19,12 @@ import GHC.Prelude
import GHC.Settings.Config
import GHC.Utils.Binary
import GHC.Data.FastString
-import GHC.Builtin.Utils
import GHC.Iface.Type
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Types.SrcLoc
import GHC.Types.Avail
-import GHC.Types.Unique
import qualified GHC.Utils.Outputable as O ( (<>) )
import GHC.Utils.Panic
import GHC.Core.ConLike ( ConLike(..) )
@@ -766,7 +764,6 @@ instance Binary TyVarScope where
data HieName
= ExternalName !Module !OccName !SrcSpan
| LocalName !OccName !SrcSpan
- | KnownKeyName !Unique
deriving (Eq)
instance Ord HieName where
@@ -774,34 +771,28 @@ instance Ord HieName where
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
compare (LocalName a b) (LocalName c d) = compare a c S.<> leftmost_smallest b d
-- TODO (int-index): Perhaps use RealSrcSpan in HieName?
- compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
- -- Not actually non deterministic as it is a KnownKey
compare ExternalName{} _ = LT
compare LocalName{} ExternalName{} = GT
- compare LocalName{} _ = LT
- compare KnownKeyName{} _ = GT
instance Outputable HieName where
ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
- ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
hieNameOcc :: HieName -> OccName
hieNameOcc (ExternalName _ occ _) = occ
hieNameOcc (LocalName occ _) = occ
-hieNameOcc (KnownKeyName u) =
- case lookupKnownKeyName u of
- Just n -> nameOccName n
- Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
- (ppr u)
toHieName :: Name -> HieName
-toHieName name
- | isKnownKeyName name = KnownKeyName (nameUnique name)
- | isExternalName name = ExternalName (nameModule name)
- (nameOccName name)
- (removeBufSpan $ nameSrcSpan name)
- | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
+toHieName name =
+ case nameModule_maybe name of
+ Nothing -> LocalName occName span
+ Just m -> ExternalName m occName span
+ where
+ occName :: OccName
+ occName = nameOccName name
+
+ span :: SrcSpan
+ span = removeBufSpan $ nameSrcSpan name
{- Note [Capture Entity Information]
=====================================
compiler/GHC/Iface/Tidy/StaticPtrTable.hs
=====================================
@@ -17,18 +17,18 @@
-- > static void hs_hpc_init_Main(void) {
-- >
-- > static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
--- > extern StgPtr Main_r2wb_closure;
+-- > extern StgClosure Main_r2wb_closure;
-- > hs_spt_insert(k0, &Main_r2wb_closure);
-- >
-- > static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
--- > extern StgPtr Main_r2wc_closure;
+-- > extern StgClosure Main_r2wc_closure;
-- > hs_spt_insert(k1, &Main_r2wc_closure);
-- >
-- > }
--
-- where the constants are fingerprints produced from the static forms.
--
--- The linker must find the definitions matching the @extern StgPtr <name>@
+-- The linker must find the definitions matching the @extern StgClosure <name>@
-- declarations. For this to work, the identifiers of static pointers need to be
-- exported. This is done in 'GHC.Core.Opt.SetLevels.newLvlVar'.
--
@@ -263,7 +263,7 @@ sptModuleInitCode platform this_mod entries
-- CLabel. Regardless, MayHaveCafRefs/NoCafRefs wouldn't make
-- any difference here, they would pretty-print to the same
-- foreign stub content.
- $$ text "extern StgPtr "
+ $$ text "extern StgClosure "
<> (pprCLabel platform $ mkClosureLabel n MayHaveCafRefs) <> semi
$$ text "hs_spt_insert" <> parens
(hcat $ punctuate comma
=====================================
compiler/GHC/Types/Name/Cache.hs
=====================================
@@ -101,9 +101,14 @@ OrigNameCache at all? Good question; after all,
3) Loading of interface files encodes names via Uniques, as detailed in
Note [Symbol table representation of names] in GHC.Iface.Binary
-It turns out that we end up looking up built-in syntax in the cache when we
-generate Haddock documentation. E.g. if we don't find tuple data constructors
-there, hyperlinks won't work as expected. Test case: haddockHtmlTest (Bug923.hs)
+
+However note that:
+ 1) It turns out that we end up looking up built-in syntax in the cache when
+ we generate Haddock documentation. E.g. if we don't find tuple data
+ constructors there, hyperlinks won't work as expected. Test case:
+ haddockHtmlTest (Bug923.hs)
+ 2) HIE de-serialization relies on wired-in names, including built-in syntax,
+ being present in the OrigNameCache.
-}
-- | The NameCache makes sure that there is just one Unique assigned for
=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.23.0.0 *TBA*
+ * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212))
* Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337))
* Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338))
* Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -26,12 +26,6 @@ module GHC.Exts
-- ** Legacy interface for arrays of arrays
module GHC.Internal.ArrayArray,
-- * Primitive operations
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.BCO,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.mkApUpd0#,
- {-# DEPRECATED ["The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14", "These symbols should be imported from ghc-internal instead if needed."] #-}
- Prim.newBCO#,
module GHC.Prim,
module GHC.Prim.Ext,
-- ** Running 'RealWorld' state thread
@@ -130,9 +124,6 @@ import GHC.Prim hiding
, whereFrom#
, isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#
- -- deprecated
- , BCO, mkApUpd0#, newBCO#
-
-- Don't re-export vector FMA instructions
, fmaddFloatX4#
, fmsubFloatX4#
@@ -255,8 +246,6 @@ import GHC.Prim hiding
, minWord8X32#
, minWord8X64#
)
-import qualified GHC.Prim as Prim
- ( BCO, mkApUpd0#, newBCO# )
import GHC.Prim.Ext
=====================================
libraries/ghci/GHCi/CreateBCO.hs
=====================================
@@ -6,10 +6,6 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
--- TODO We want to import GHC.Internal.Base (BCO, mkApUpd0#, newBCO#) instead
--- of from GHC.Exts when we can require of the bootstrap compiler to have
--- ghc-internal.
--
-- (c) The University of Glasgow 2002-2006
@@ -30,7 +26,8 @@ import Data.Array.Base
import Foreign hiding (newArray)
import Unsafe.Coerce (unsafeCoerce)
import GHC.Arr ( Array(..) )
-import GHC.Exts
+import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# )
+import GHC.Internal.Base ( BCO, mkApUpd0#, newBCO# )
import GHC.IO
import Control.Exception ( ErrorCall(..) )
=====================================
libraries/ghci/GHCi/TH.hs
=====================================
@@ -1,9 +1,6 @@
{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,
TupleSections, RecordWildCards, InstanceSigs, CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
--- TODO We want to import GHC.Internal.Desugar instead of GHC.Desugar when we
--- can require of the bootstrap compiler to have ghc-internal.
-- |
-- Running TH splices
@@ -112,7 +109,7 @@ import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
-import GHC.Desugar (AnnotationWrapper(..))
+import GHC.Internal.Desugar (AnnotationWrapper(..))
import qualified GHC.Boot.TH.Syntax as TH
import Unsafe.Coerce
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -86,11 +86,7 @@ library
rts,
array == 0.5.*,
base >= 4.8 && < 4.23,
- -- ghc-internal == @ProjectVersionForLib@.*
- -- TODO: Use GHC.Internal.Desugar and GHC.Internal.Base from
- -- ghc-internal instead of ignoring the deprecation warning in GHCi.TH
- -- and GHCi.CreateBCO when we require ghc-internal of the bootstrap
- -- compiler
+ ghc-internal >= 9.1001.0 && <=@ProjectVersionForLib@.0,
ghc-prim >= 0.5.0 && < 0.14,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
=====================================
rts/Disassembler.c
=====================================
@@ -89,7 +89,7 @@ disInstr ( StgBCO *bco, int pc )
p1 = BCO_GET_LARGE_ARG;
info_mod = BCO_GET_LARGE_ARG;
info_unit_id = BCO_GET_LARGE_ARG;
- info_wix = BCO_NEXT;
+ info_wix = BCO_READ_NEXT_32;
np = BCO_GET_LARGE_ARG;
debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
debugBelch("%" FMT_Word, literals[info_mod] );
=====================================
rts/Interpreter.c
=====================================
@@ -720,7 +720,7 @@ interpretBCO (Capability* cap)
arg1_brk_array = BCO_GET_LARGE_ARG;
/* info_mod_name = */ BCO_GET_LARGE_ARG;
/* info_mod_id = */ BCO_GET_LARGE_ARG;
- arg4_info_index = BCO_NEXT;
+ arg4_info_index = BCO_READ_NEXT_32;
StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
StgArrBytes* breakPoints = (StgArrBytes *) BCO_PTR(arg1_brk_array);
@@ -1542,7 +1542,7 @@ run_BCO:
arg1_brk_array = BCO_GET_LARGE_ARG;
arg2_info_mod_name = BCO_GET_LARGE_ARG;
arg3_info_mod_id = BCO_GET_LARGE_ARG;
- arg4_info_index = BCO_NEXT;
+ arg4_info_index = BCO_READ_NEXT_32;
#if defined(PROFILING)
arg5_cc = BCO_GET_LARGE_ARG;
#else
=====================================
testsuite/tests/module/T21752.stderr deleted
=====================================
@@ -1,32 +0,0 @@
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of ‘newBCO#’ (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of ‘newBCO#’ (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of ‘mkApUpd0#’ (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of ‘mkApUpd0#’ (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of type constructor or class ‘BCO’
- (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
-T21752A.hs:4:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
- In the use of type constructor or class ‘BCO’
- (imported from GHC.Exts):
- Deprecated: "The BCO, mkApUpd0#, and newBCO# re-exports from GHC.Exts have been deprecated and will be removed in 9.14
- These symbols should be imported from ghc-internal instead if needed."
-
=====================================
utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
=====================================
@@ -229,10 +229,7 @@ writeInterfaceFile filename iface = do
return ()
freshNameCache :: IO NameCache
-freshNameCache =
- initNameCache
- 'a' -- ??
- []
+freshNameCache = newNameCache
-- | Read a Haddock (@.haddock@) interface file. Return either an
-- 'InterfaceFile' or an error message.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bfe81288fe9932253919504b969d5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bfe81288fe9932253919504b969d5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/remove-stg_stackDecode] 4 commits: Move stack decoding logic from ghc-heap to ghc-internal
by Hannes Siebenhandl (＠fendor) 22 Aug '25
by Hannes Siebenhandl (＠fendor) 22 Aug '25
22 Aug '25
Hannes Siebenhandl pushed to branch wip/fendor/remove-stg_stackDecode at Glasgow Haskell Compiler / GHC
Commits:
3f233ef6 by fendor at 2025-08-21T19:15:21+02:00
Move stack decoding logic from ghc-heap to ghc-internal
The stack decoding logic in `ghc-heap` is more sophisticated than the one
currently employed in `CloneStack`. We want to use the stack decoding
implementation from `ghc-heap` in `base`.
We cannot simply depend on `ghc-heap` in `base` due do bootstrapping
issues.
Thus, we move the code that is necessary to implement stack decoding to
`ghc-internal`. This is the right location, as we don't want to add a
new API to `base`.
Moving the stack decoding logic and re-exposing it in ghc-heap is
insufficient, though, as we have a dependency cycle between.
* ghc-heap depends on stage1:ghc-internal
* stage0:ghc depends on stage0:ghc-heap
To fix this, we remove ghc-heap from the set of `stage0` dependencies.
This is not entirely straight-forward, as a couple of boot dependencies,
such as `ghci` depend on `ghc-heap`.
Luckily, the boot compiler of GHC is now >=9.10, so we can migrate `ghci`
to use `ghc-internal` instead of `ghc-heap`, which already exports the
relevant modules.
However, we cannot 100% remove ghc's dependency on `ghc-heap`, since
when we compile `stage0:ghc`, `stage1:ghc-internal` is not yet
available.
Thus, when we compile with the boot-compiler, we still depend on an
older version of `ghc-heap`, and only use the modules from `ghc-internal`,
if the `ghc-internal` version is recent enough.
-------------------------
Metric Increase:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
-------------------------
These metric increases are unfortunate, they are most likely caused by
the larger (literally in terms of lines of code) stack decoder implementation
that are now linked into hello-word binaries.
On linux, it is almost a 10% increase, which is considerable.
- - - - -
4bf0f1e2 by fendor at 2025-08-21T19:15:21+02:00
Implement `decode` in terms of `decodeStackWithIpe`
Uses the more efficient stack decoder implementation.
- - - - -
3f1a9d68 by fendor at 2025-08-21T19:15:21+02:00
Remove stg_decodeStackzh
- - - - -
f255aff1 by fendor at 2025-08-21T19:15:21+02:00
Remove ghcHeap from list of toolTargets
- - - - -
53 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- libraries/base/src/GHC/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- + libraries/ghc-heap/GHC/Exts/Heap/Constants.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hs
- + libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hs
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs
- + libraries/ghc-heap/GHC/Exts/Stack/Constants.hs
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-heap/cbits/HeapPrim.cmm → libraries/ghc-internal/cbits/HeapPrim.cmm
- libraries/ghc-heap/cbits/Stack.cmm → libraries/ghc-internal/cbits/Stack.cmm
- libraries/ghc-internal/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/cbits/Stack_c.c → libraries/ghc-internal/cbits/Stack_c.c
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/jsbits/base.js
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- + libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-heap/GHC/Exts/Heap/InfoTableProf.hsc → libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- + libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc → libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- + libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-heap/tests/stack-annotation/Makefile → libraries/ghc-internal/tests/stack-annotation/Makefile
- libraries/ghc-heap/tests/stack-annotation/TestUtils.hs → libraries/ghc-internal/tests/stack-annotation/TestUtils.hs
- libraries/ghc-heap/tests/stack-annotation/all.T → libraries/ghc-internal/tests/stack-annotation/all.T
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame001.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame002.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame003.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs → libraries/ghc-internal/tests/stack-annotation/ann_frame004.hs
- libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout → libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/ghci.cabal.in
- rts/CloneStack.c
- rts/CloneStack.h
- rts/RtsSymbols.c
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc6d0c8a28e8bc58b8af27534cc8f8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc6d0c8a28e8bc58b8af27534cc8f8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/gdc-files] Add support for generating bytecode objects
by Matthew Pickering (＠mpickering) 22 Aug '25
by Matthew Pickering (＠mpickering) 22 Aug '25
22 Aug '25
Matthew Pickering pushed to branch wip/gdc-files at Glasgow Haskell Compiler / GHC
Commits:
6f56a971 by Matthew Pickering at 2025-08-21T17:41:50+01:00
Add support for generating bytecode objects
This commit adds the `-fwrite-byte-code` option which makes GHC emit a
`.gbc` file which contains a serialised representation of bytecode.
The bytecode can be loaded by the compiler to avoid having to
reinterpret a module when using the bytecode interpreter (for example,
in GHCi).
There are also the new options:
* -gbcdir=<DIR>: Specify the directory to place the gbc files
* -gbcsuf=<suffix>: Specify the suffix for gbc files
The option `-fbyte-code-and-object-code` now implies
`-fwrite-byte-code`.
- - - - -
49 changed files:
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Backpack.hs
- + compiler/GHC/Driver/ByteCode.hs
- compiler/GHC/Driver/Config/Finder.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- docs/users_guide/phases.rst
- docs/users_guide/separate_compilation.rst
- testsuite/driver/testlib.py
- testsuite/tests/driver/T5313.hs
- + testsuite/tests/driver/bytecode-object/A.hs
- + testsuite/tests/driver/bytecode-object/BytecodeMain.hs
- + testsuite/tests/driver/bytecode-object/BytecodeTest.hs
- + testsuite/tests/driver/bytecode-object/Makefile
- + testsuite/tests/driver/bytecode-object/all.T
- + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr
- + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object19.script
- + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout
- testsuite/tests/ghc-api/T10052/T10052.hs
- testsuite/tests/ghc-api/T8639_api.hs
- testsuite/tests/ghc-api/apirecomp001/myghc.hs
- testsuite/tests/ghci/linking/dyn/T3372.hs
- testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T
- testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T
- testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f56a971247344abcc8225096358055…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f56a971247344abcc8225096358055…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/gdc-files] 3 commits: testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests
by Matthew Pickering (＠mpickering) 22 Aug '25
by Matthew Pickering (＠mpickering) 22 Aug '25
22 Aug '25
Matthew Pickering pushed to branch wip/gdc-files at Glasgow Haskell Compiler / GHC
Commits:
c31525ed by Matthew Pickering at 2025-08-21T17:27:20+01:00
testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests
These tests reimplemented the logic from `valid_way` in order to
determine what ways to run. It's easier to use this combination of
`only_ways` and `extra_ways` to only run in GHCi ways and always run in
GHCi ways.
- - - - -
f435b43a by Matthew Pickering at 2025-08-21T17:27:20+01:00
Rename interpreterBackend to bytecodeBackend
- - - - -
014cb905 by Matthew Pickering at 2025-08-21T17:40:46+01:00
WIP: Generate .gdb files for modules
- - - - -
45 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Backend/Internal.hs
- compiler/GHC/Driver/Backpack.hs
- + compiler/GHC/Driver/ByteCode.hs
- compiler/GHC/Driver/Config/Finder.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- docs/users_guide/phases.rst
- docs/users_guide/separate_compilation.rst
- ghc/Main.hs
- + testsuite/tests/driver/bytecode-object/A.hs
- + testsuite/tests/driver/bytecode-object/BytecodeMain.hs
- + testsuite/tests/driver/bytecode-object/BytecodeTest.hs
- + testsuite/tests/driver/bytecode-object/Makefile
- + testsuite/tests/driver/bytecode-object/all.T
- + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr
- + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object19.script
- + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35dd8de44771a5719cfe75d1edc7aa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35dd8de44771a5719cfe75d1edc7aa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0