GitLab

Hannes Siebenhandl pushed to branch wip/fendor/full-eventlog-live at Glasgow Haskell Compiler / GHC

Commits:

fe6cefbe

by fendor at 2026-09-11T15:43:08+02:00

Support for `ghc-stack-profiler`

This adds the +ghc-stack-profiler feature flag.
If set, GHC is instrumented with GHC Stack Profiler.

10 changed files:

.gitmodules
+ ghc-stack-profiler
ghc/Main.hs
ghc/ghc-bin.cabal.in
hadrian/src/Packages.hs
hadrian/src/Settings/Default.hs
hadrian/src/Settings/Packages.hs
+ libraries/async
+ libraries/hashable
+ libraries/unordered-containers

Changes:

.gitmodules

@@ -125,3 +125,15 @@
  [submodule "eventlog-socket"]
  	path = eventlog-socket
  	url = https://github.com/well-typed/eventlog-socket.git
 +[submodule "ghc-stack-profiler"]
 +	path = ghc-stack-profiler
 +	url = https://github.com/well-typed/ghc-stack-profiler
 +[submodule "libraries/async"]
 +	path = libraries/async
 +	url = https://github.com/fendor/async.git
 +[submodule "libraries/unordered-containers"]
 +	path = libraries/unordered-containers
 +	url = https://github.com/fendor/unordered-containers.git
 +[submodule "libraries/hashable"]
 +	path = libraries/hashable
 +	url = https://github.com/fendor/hashable

ghc-stack-profiler

+Subproject commit 389d886a1494cd019ee93c72c8f19cf7f9dc1664

ghc/Main.hs

@@ -97,6 +97,10 @@ import qualified Data.List.NonEmpty as NE
  import qualified GHC.Eventlog.Socket
  #endif
 +#if defined(GHC_STACK_PROFILER)
 +import qualified GHC.Stack.Profiler
 +#endif
++
  startEventlogSocketFromEnv :: IO ()
  #if defined(EVENTLOG_SOCKET)
  startEventlogSocketFromEnv = GHC.Eventlog.Socket.startFromEnv
@@ -104,6 +108,13 @@ startEventlogSocketFromEnv = GHC.Eventlog.Socket.startFromEnv
  startEventlogSocketFromEnv = pure ()
  #endif
 +startGhcStackProfilerFromEnv :: IO () -> IO ()
 +#if defined(GHC_STACK_PROFILER)
 +startGhcStackProfilerFromEnv act = GHC.Stack.Profiler.withProfilerFromEnv (const act)
 +#else
 +startGhcStackProfilerFromEnv = id
 +#endif
++
  -----------------------------------------------------------------------------
  -- ToDo:
@@ -117,7 +128,7 @@ startEventlogSocketFromEnv = pure ()
  -- GHC's command-line interface
  main :: IO ()
 -main = do
 +main = startGhcStackProfilerFromEnv $ do
     startEventlogSocketFromEnv
     hSetBuffering stdout LineBuffering

ghc/ghc-bin.cabal.in

@@ -37,6 +37,11 @@ Flag threaded
      Default: True
      Manual: True
 +Flag ghc-stack-profiler
 +    Description: Build with support for ghc-stack-profiler
 +    Default: False
 +    Manual: True
++
  Executable ghc
      Default-Language: GHC2024
@@ -102,6 +107,10 @@ Executable ghc
          build-depends: eventlog-socket
          CPP-OPTIONS: -DEVENTLOG_SOCKET
 +    if flag(ghc-stack-profiler)
 +        build-depends: ghc-stack-profiler
 +        CPP-OPTIONS: -DGHC_STACK_PROFILER
++
      Other-Extensions:
          CPP
          NondecreasingIndentation

hadrian/src/Packages.hs

@@ -14,6 +14,7 @@ module Packages (
      lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
      eventlogSocket, eventlogSocketControl,
      ghcPackages, isGhcPackage,
 +    async, hashable, unorderedContainers, ghc_stack_profiler, ghc_stack_profiler_core,
      -- * Package information
      crossPrefix, programBasename, programName, nonHsMainPackage, programPath, timeoutPath,
@@ -44,7 +45,9 @@ ghcPackages =
      , timeout
      , eventlogSocketControl, eventlogSocket
      , lintersCommon
 -    , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ]
 +    , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
 +    , async, hashable, unorderedContainers, ghc_stack_profiler_core, ghc_stack_profiler
 +    ]
  -- TODO: Optimise by switching to sets of packages.
  isGhcPackage :: Package -> Bool
@@ -139,6 +142,11 @@ win32               = lib  "Win32"
  xhtml               = lib  "xhtml"
  eventlogSocket      = lib "eventlog-socket" `setPath` "eventlog-socket/eventlog-socket"
  eventlogSocketControl = lib "eventlog-socket-control" `setPath` "eventlog-socket/eventlog-socket-control"
 +async               = lib "async"
 +hashable            = lib "hashable"
 +unorderedContainers = lib "unordered-containers"
 +ghc_stack_profiler = lib "ghc-stack-profiler" `setPath` "ghc-stack-profiler/ghc-stack-profiler"
 +ghc_stack_profiler_core = lib "ghc-stack-profiler-core" `setPath` "ghc-stack-profiler/ghc-stack-profiler-core"
  lintersCommon       = lib     "linters-common"      `setPath` "linters/linters-common"
  lintNotes           = linter  "lint-notes"

hadrian/src/Settings/Default.hs

@@ -192,6 +192,11 @@ stagedPackages stage = do
          , hpcBin
          , if winTarget then win32 else unix
          , runGhc
 +        , ghc_stack_profiler
 +        , ghc_stack_profiler_core
 +        , async
 +        , hashable
 +        , unorderedContainers
+         ]
        , when (winTarget && not cross)
          [ -- See Note [Hadrian's ghci-wrapper package]

hadrian/src/Settings/Packages.hs

@@ -105,6 +105,14 @@ packageArgs = do
            , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
 +        , package ghc_stack_profiler ? mconcat
 +          [ builder (Cabal Flags) ? mconcat
 +            [ arg "-use-ghc-trace-events"
 +            -- Add support for eventlog-socket commands
 +            , arg "+control"
 +            ]
 +          ]
++
          , package eventlogSocket ? mconcat
            [ builder (Cabal Flags) ? mconcat
+             [
@@ -123,6 +131,7 @@ packageArgs = do
              [ andM [expr (ghcWithInterpreter stage), orM [expr (notM cross), stage1]] `cabalFlag` "interpreter"
              , andM [expr (ghcWithInterpreter stage), notM (expr cross)] `cabalFlag` "internal-interpreter"
              , notStage0 `cabalFlag` "eventlog-socket"
 +            , notStage0 `cabalFlag` "sampleTracer"
              , ifM stage0
                    -- We build a threaded stage 1 if the bootstrapping compiler
                    -- supports it.

libraries/async

+Subproject commit 474fc7f612b74e73e24e91474fa75af18eede7b7

libraries/hashable

+Subproject commit d56d62eb2a9ff4376e7119d925ececa60959d9ec

libraries/unordered-containers

+Subproject commit 368ea40488bf3c644e9c36d996302029fb0fc227