26 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
3cbb38fe by Rodrigo Mesquita at 2025-06-26T16:27:12+01:00
littel better
- - - - -
1 changed file:
- compiler/GHC/StgToByteCode.hs
Changes:
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -2666,10 +2666,10 @@ runBc hsc_env this_mod modBreaks (BcM m)
= m (BcM_Env hsc_env this_mod modBreaks) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty))
instance HasDynFlags BcM where
- getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st))
+ getDynFlags = hsc_dflags <$> getHscEnv
getHscEnv :: BcM HscEnv
-getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
+getHscEnv = BcM $ \env st -> return (st, bcm_hsc_env env)
getProfile :: BcM Profile
getProfile = targetProfile <$> getDynFlags
@@ -2682,16 +2682,16 @@ shouldAddBcoName = do
else return Nothing
getLabelBc :: BcM LocalLabel
-getLabelBc
- = BcM $ \st -> do let nl = nextlabel st
- when (nl == maxBound) $
- panic "getLabelBc: Ran out of labels"
- return (st{nextlabel = nl + 1}, LocalLabel nl)
+getLabelBc = BcM $ \_ st ->
+ do let nl = nextlabel st
+ when (nl == maxBound) $
+ panic "getLabelBc: Ran out of labels"
+ return (st{nextlabel = nl + 1}, LocalLabel nl)
getLabelsBc :: Word32 -> BcM [LocalLabel]
-getLabelsBc n
- = BcM $ \st -> let ctr = nextlabel st
- in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
+getLabelsBc n = BcM $ \_ st ->
+ let ctr = nextlabel st
+ in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
newBreakInfo :: CgBreakInfo -> BcM InternalBreakpointId
newBreakInfo info = BcM $ \env st ->
@@ -2704,7 +2704,7 @@ newBreakInfo info = BcM $ \env st ->
in return (st', ibi)
getCurrentModule :: BcM Module
-getCurrentModule = BcM $ \st -> return (st, thisModule st)
+getCurrentModule = BcM $ \env st -> return (st, thisModule env)
tickFS :: FastString
tickFS = fsLit "ticked"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbb38fecc7fad079204332299bc527…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3cbb38fecc7fad079204332299bc527…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/step-out-8] 2 commits: Continue refactor
by Rodrigo Mesquita (＠alt-romes) 26 Jun '25
by Rodrigo Mesquita (＠alt-romes) 26 Jun '25
26 Jun '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC
Commits:
178dd899 by Rodrigo Mesquita at 2025-06-26T14:22:39+01:00
Continue refactor
- - - - -
f084188e by Rodrigo Mesquita at 2025-06-26T16:20:46+01:00
Lots of progress
- - - - -
21 changed files:
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/StgToByteCode.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord )
-import GHC.Types.Breakpoint
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Literal
@@ -74,6 +73,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified Data.List as List ( any )
import GHC.Exts
+import GHC.HsToCore.Breakpoints (ModBreaks(..))
-- -----------------------------------------------------------------------------
@@ -111,7 +111,7 @@ assembleBCOs
-> FlatBag (ProtoBCO Name)
-> [TyCon]
-> [(Name, ByteString)]
- -> Maybe ModBreaks
+ -> Maybe (InternalModBreaks, ModBreaks)
-> [SptEntry]
-> IO CompiledByteCode
assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -0,0 +1,210 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Breakpoint information constructed during ByteCode generation.
+--
+-- Specifically, code-generation breakpoints are referred to as "internal
+-- breakpoints", the internal breakpoint data for a module is stored in
+-- 'InternalModBreaks', and is uniquely identified at runtime by an
+-- 'InternalBreakpointId'.
+--
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
+module GHC.ByteCode.Breakpoints
+ ( -- * Internal Mod Breaks
+ InternalModBreaks(imodBreaks_breakInfo), CgBreakInfo(..)
+ , mkInternalModBreaks
+
+ -- ** Operations
+ , getInternalBreak, addInternalBreak
+
+ -- ** Internal breakpoint identifier
+ , InternalBreakpointId(..), BreakInfoIndex
+
+ -- * Utils
+ , seqInternalModBreaks
+
+ )
+ where
+
+import GHC.Prelude
+import Control.DeepSeq
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IM
+
+import GHC.Iface.Syntax
+import GHC.Types.Tickish
+
+import GHC.Unit.Module (Module)
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
+{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
+Note [Breakpoint identifiers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Before optimization a breakpoint is identified uniquely with a tick module
+and a tick index. See 'BreakpointId'. A tick module contains an array, indexed
+with the tick indexes, which indicates breakpoint status.
+
+When we generate ByteCode, we collect information for every breakpoint at
+their *occurrence sites* (see CgBreakInfo) and these info
+are stored in the ModIface of the occurrence module. Because of inlining, we
+can't reuse the tick index to uniquely identify an occurrence; because of
+cross-module inlining, we can't assume that the occurrence module is the same
+as the tick module (#24712).
+
+So every breakpoint occurrence gets assigned a module-unique *info index* and
+we store it alongside the occurrence module (*info module*) in the
+'InternalBreakpointId' datatype. This is the index that we use at runtime to
+identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@. See `internalBreakIdToBreakId`
+-}
+
+--------------------------------------------------------------------------------
+-- * Internal breakpoint identifiers
+--------------------------------------------------------------------------------
+
+-- | Internal breakpoint info index
+type BreakInfoIndex = Int
+
+-- | Internal breakpoint identifier
+--
+-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
+-- See Note [Breakpoint identifiers]
+data InternalBreakpointId = InternalBreakpointId
+ { ibi_info_mod :: !Module -- ^ Breakpoint tick module
+ , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
+ }
+ deriving (Eq, Ord)
+
+--------------------------------------------------------------------------------
+-- * Internal Mod Breaks
+--------------------------------------------------------------------------------
+
+-- | Internal mod breaks store the runtime-relevant information of breakpoints.
+--
+-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'.
+--
+-- 'InternalModBreaks' are constructed during bytecode generation and stored in
+-- 'CompiledByteCode' afterwards.
+data InternalModBreaks = InternalModBreaks
+ { imodBreaks_breakInfo :: IntMap CgBreakInfo
+ -- ^ Access code-gen time information about a breakpoint, indexed by
+ -- 'InternalBreakpointId'.
+ , imodBreaks_module :: !Module
+ -- ^ Cache the module corresponding to these 'InternalModBreaks' for
+ -- sanity checks. Don't export it!
+ }
+
+-- | Construct an 'InternalModBreaks'
+mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> InternalModBreaks
+mkInternalModBreaks mod im = InternalModBreaks im mod
+
+-- | Information about a breakpoint that we know at code-generation time
+-- In order to be used, this needs to be hydrated relative to the current HscEnv by
+-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
+-- preventing space leaks (see #22530)
+data CgBreakInfo
+ = CgBreakInfo
+ { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
+ , cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
+ , cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. See Note [Breakpoint identifiers].
+ }
+-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
+
+-- | Get an internal breakpoint info by 'InternalBreakpointId'
+getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
+
+-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
+addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
+addInternalBreak (InternalBreakpointId mod ix) info imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)}
+
+-- | Assert that the module in the 'InternalBreakpointId' and in
+-- 'InternalModBreaks' match.
+assert_modules_match :: Module -> Module -> a -> a
+assert_modules_match ibi_mod imbs_mod =
+ assertPpr (ibi_mod == imbs_mod)
+ (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod
+ <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod)
+
+-- TODO: See what Cheng has in .
+-- mkCCSArray
+-- :: Interp -> Module -> Int -> [Tick]
+-- -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre))
+-- mkCCSArray interp modul count entries
+-- | interpreterProfiled interp = do
+-- let module_str = moduleNameString (moduleName modul)
+-- costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries)
+-- return (listArray (0,count-1) costcentres)
+-- | otherwise = return (listArray (0,-1) [])
+-- where
+-- mk_one t = (name, src)
+-- where name = concat $ intersperse "." $ tick_path t
+-- src = renderWithContext defaultSDocContext $ ppr $ tick_loc t
+-- , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre))
+-- -- ^ Array pointing to cost centre for each breakpoint
+-- ccs <- mkCCSArray interpProfiled mod count entries
+
+--------------------------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------------------------
+
+-- | Fully force an 'InternalModBreaks' value
+seqInternalModBreaks :: InternalModBreaks -> ()
+seqInternalModBreaks InternalModBreaks{..} =
+ rnf (fmap seqCgBreakInfo imodBreaks_breakInfo)
+ where
+ seqCgBreakInfo :: CgBreakInfo -> ()
+ seqCgBreakInfo CgBreakInfo{..} =
+ rnf cgb_tyvars `seq`
+ rnf cgb_vars `seq`
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
+
+instance Outputable InternalBreakpointId where
+ ppr InternalBreakpointId{..} =
+ text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index
+
+instance NFData InternalBreakpointId where
+ rnf InternalBreakpointId{..} =
+ rnf ibi_info_mod `seq` rnf ibi_info_index
+
+instance Outputable CgBreakInfo where
+ ppr info = text "CgBreakInfo" <+>
+ parens (ppr (cgb_vars info) <+>
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -36,7 +36,6 @@ import GHC.Stack.CCS (CostCentre)
import GHC.Stg.Syntax
import GHCi.BreakArray (BreakArray)
-import GHC.Types.Breakpoint
-- ----------------------------------------------------------------------------
-- Bytecode instructions
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -18,15 +18,17 @@ module GHC.ByteCode.Types
, UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
, ItblEnv, ItblPtr(..)
, AddrEnv, AddrPtr(..)
- , CgBreakInfo(..)
- , ModBreaks (..)
- , CCostCentre
, FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag
+
+ -- * Internal Mod Breaks
+ , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
+ -- ** Internal breakpoint identifier
+ , InternalBreakpointId(..), BreakInfoIndex
) where
import GHC.Prelude
-import GHC.Types.Breakpoint
+import GHC.ByteCode.Breakpoints
import GHC.Data.FastString
import GHC.Data.FlatBag
import GHC.Types.Name
@@ -34,7 +36,6 @@ import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Builtin.PrimOps
import GHC.Types.SptEntry
-import GHC.Types.SrcLoc
import GHCi.BreakArray
import GHCi.Message
import GHCi.RemoteTypes
@@ -43,14 +44,10 @@ import Control.DeepSeq
import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
import Foreign
-import Data.Array
import Data.ByteString (ByteString)
-import Data.IntMap (IntMap)
import qualified GHC.Exts.Heap as Heap
-import GHC.Stack.CCS
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
-import GHC.Iface.Syntax
-import GHC.Unit.Module (Module)
+import GHC.HsToCore.Breakpoints (ModBreaks)
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
@@ -65,8 +62,12 @@ data CompiledByteCode = CompiledByteCode
, bc_strs :: [(Name, ByteString)]
-- ^ top-level strings (heap allocated)
- , bc_breaks :: Maybe ModBreaks
- -- ^ breakpoint info (Nothing if breakpoints are disabled)
+ , bc_breaks :: (Maybe (InternalModBreaks, ModBreaks))
+ -- ^ internal breakpoint info (no tick-level 'ModBreaks' if breakpoints are disabled)
+ --
+ -- TODO: If ModBreaks is serialized and reconstructed as part of ModDetails
+ -- we don't need to keep it here as it can be fetched from the
+ -- 'HomeModInfo' directly.
, bc_spt_entries :: ![SptEntry]
-- ^ Static pointer table entries which should be loaded along with the
@@ -87,8 +88,8 @@ seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{..} =
rnf bc_bcos `seq`
rnf bc_itbls `seq`
- rnf bc_strs `seq`
- rnf (fmap seqModBreaks bc_breaks)
+ rnf bc_strs
+ -- TODO: Add here something if new.
newtype ByteOff = ByteOff Int
deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable)
@@ -282,82 +283,9 @@ data BCONPtr
instance NFData BCONPtr where
rnf x = x `seq` ()
--- | Information about a breakpoint that we know at code-generation time
--- In order to be used, this needs to be hydrated relative to the current HscEnv by
--- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
--- preventing space leaks (see #22530)
-data CgBreakInfo
- = CgBreakInfo
- { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
- , cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
- , cgb_resty :: !IfaceType
- , cgb_tick_id :: !BreakpointId
- -- ^ This field records the original breakpoint tick identifier for this
- -- internal breakpoint info. See Note [Breakpoint identifiers].
- }
--- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-
-seqCgBreakInfo :: CgBreakInfo -> ()
-seqCgBreakInfo CgBreakInfo{..} =
- rnf cgb_tyvars `seq`
- rnf cgb_vars `seq`
- rnf cgb_resty `seq`
- rnf cgb_tick_id
-
instance Outputable UnlinkedBCO where
ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
= sep [text "BCO", ppr nm, text "with",
ppr (sizeFlatBag lits), text "lits",
ppr (sizeFlatBag ptrs), text "ptrs" ]
-instance Outputable CgBreakInfo where
- ppr info = text "CgBreakInfo" <+>
- parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info) <+>
- ppr (cgb_tick_id info))
-
--- -----------------------------------------------------------------------------
--- Breakpoints
-
--- | C CostCentre type
-data CCostCentre
-
--- | All the information about the breakpoints for a module
-data ModBreaks
- = ModBreaks
- { modBreaks_flags :: !(ForeignRef BreakArray)
- -- ^ The array of flags, one per breakpoint,
- -- indicating which breakpoints are enabled.
- , modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
- -- ^ An array giving the source span of each breakpoint.
- , modBreaks_vars :: !(Array BreakTickIndex [OccName])
- -- ^ An array giving the names of the free variables at each breakpoint.
- , modBreaks_decls :: !(Array BreakTickIndex [String])
- -- ^ An array giving the names of the declarations enclosing each breakpoint.
- -- See Note [Field modBreaks_decls]
- , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre))
- -- ^ Array pointing to cost centre for each breakpoint
- , modBreaks_breakInfo :: IntMap CgBreakInfo
- -- ^ info about each breakpoint from the bytecode generator
- , modBreaks_module :: !Module
- -- ^ info about the module in which we are setting the breakpoint
- }
-
-seqModBreaks :: ModBreaks -> ()
-seqModBreaks ModBreaks{..} =
- rnf modBreaks_flags `seq`
- rnf modBreaks_locs `seq`
- rnf modBreaks_vars `seq`
- rnf modBreaks_decls `seq`
- rnf modBreaks_ccs `seq`
- rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
- rnf modBreaks_module
-
-{-
-Note [Field modBreaks_decls]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
-The breakpoint is in the function called "baz" that is declared in a `let`
-or `where` clause of a declaration called "bar", which itself is declared
-in a `let` or `where` clause of the top-level function called "foo".
--}
=====================================
compiler/GHC/Core/Ppr.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.Prelude
import GHC.Core
import GHC.Core.Stats (exprStats)
-import GHC.Types.Breakpoint
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Literal( pprLiteral )
import GHC.Types.Name( pprInfixName, pprPrefixName )
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -72,7 +72,6 @@ import GHC.Iface.Syntax
import GHC.Data.FastString
import GHC.Data.BooleanFormula qualified as BF(BooleanFormula(..))
-import GHC.Types.Breakpoint
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Id.Make ( noinlineIdName, noinlineConstraintIdName )
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -97,7 +97,6 @@ import GHC.Unit.Module.Deps
import Data.List (partition)
import Data.IORef
-import Data.Traversable (for)
import GHC.Iface.Make (mkRecompUsageInfo)
{-
@@ -162,13 +161,12 @@ deSugar hsc_env
mod mod_loc
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
- ; modBreaks <- for
- [ (i, s)
- | i <- hsc_interp hsc_env
- , (_, s) <- m_tickInfo
- , breakpointsAllowed dflags
- ]
- $ \(interp, specs) -> mkModBreaks interp mod specs
+ ; let modBreaks
+ | Just (_, specs) <- m_tickInfo
+ , breakpointsAllowed dflags
+ = Just $ mkModBreaks mod specs
+ | otherwise
+ = Nothing
; ds_hpc_info <- case m_tickInfo of
Just (orig_file2, ticks)
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -1,25 +1,67 @@
+-- | Information attached to Breakpoints generated from Ticks
+--
+-- The breakpoint information stored in 'ModBreaks' is generated during
+-- desugaring from the ticks annotating the source expressions.
+--
+-- This information can be queried per-breakpoint using the 'BreakpointId'
+-- datatype, which indexes tick-level breakpoint information.
+--
+-- 'ModBreaks' and 'BreakpointId's are not to be confused with
+-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
+-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
+--
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
- ( mkModBreaks
+ ( -- * ModBreaks
+ mkModBreaks, ModBreaks(modBreaks_locs, modBreaks_vars, modBreaks_decls)
+
+ -- ** Queries
+ , getBreakLoc, getBreakVars, getBreakDecls
+
+ -- ** Re-exports BreakpointId
+ , BreakpointId(..), BreakTickIndex
) where
import GHC.Prelude
-
-import qualified GHC.Runtime.Interpreter as GHCi
-import GHC.Runtime.Interpreter.Types
-import GHCi.RemoteTypes
-import GHC.ByteCode.Types
-import GHC.Stack.CCS
-import GHC.Unit
+import Data.Array
import GHC.HsToCore.Ticks (Tick (..))
-
import GHC.Data.SizedSeq
-import GHC.Utils.Outputable as Outputable
+import GHC.Types.SrcLoc (SrcSpan)
+import GHC.Types.Name (OccName)
+import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..))
+import GHC.Unit.Module (Module)
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
-import Data.List (intersperse)
-import Data.Array
-import qualified Data.IntMap as IntMap
-import GHC.Types.Breakpoint
+--------------------------------------------------------------------------------
+-- ModBreaks
+--------------------------------------------------------------------------------
+
+-- | All the information about the source-relevant breakpoints for a module
+--
+-- This information is constructed once during desugaring (with `mkModBreaks`)
+-- from breakpoint ticks and fixed/unchanged from there on forward. It could be
+-- exported as an abstract datatype because it should never be updated after
+-- construction, only queried.
+--
+-- The arrays can be indexed using the int in the corresponding 'BreakpointId'
+-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding
+-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars',
+-- and 'modBreaks_decls'.
+data ModBreaks
+ = ModBreaks
+ { modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
+ -- ^ An array giving the source span of each breakpoint.
+ , modBreaks_vars :: !(Array BreakTickIndex [OccName])
+ -- ^ An array giving the names of the free variables at each breakpoint.
+ , modBreaks_decls :: !(Array BreakTickIndex [String])
+ -- ^ An array giving the names of the declarations enclosing each breakpoint.
+ -- See Note [Field modBreaks_decls]
+ , modBreaks_module :: !Module
+ -- ^ The module to which this ModBreaks is associated.
+ -- We cache this here for internal sanity checks (don't export it!).
+ }
-- | Initialize memory for breakpoint data that is shared between the bytecode
-- generator and the interpreter.
@@ -28,38 +70,48 @@ import GHC.Types.Breakpoint
-- generator needs to encode this information for each expression, the data is
-- allocated remotely in GHCi's address space and passed to the codegen as
-- foreign pointers.
-mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
-mkModBreaks interp mod extendedMixEntries
- = do
- let count = fromIntegral $ sizeSS extendedMixEntries
+mkModBreaks :: Module -> SizedSeq Tick -> ModBreaks
+mkModBreaks modl extendedMixEntries
+ = let count = fromIntegral $ sizeSS extendedMixEntries
entries = ssElts extendedMixEntries
-
- breakArray <- GHCi.newBreakArray interp count
- ccs <- mkCCSArray interp mod count entries
- let
- locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
- varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
- declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
- return $ ModBreaks
- { modBreaks_flags = breakArray
- , modBreaks_locs = locsTicks
+ locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
+ varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
+ declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
+ in ModBreaks
+ { modBreaks_locs = locsTicks
, modBreaks_vars = varsTicks
, modBreaks_decls = declsTicks
- , modBreaks_ccs = ccs
- , modBreaks_breakInfo = IntMap.empty
- , modBreaks_module = mod
+ , modBreaks_module = modl
}
-mkCCSArray
- :: Interp -> Module -> Int -> [Tick]
- -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre))
-mkCCSArray interp modul count entries
- | GHCi.interpreterProfiled interp = do
- let module_str = moduleNameString (moduleName modul)
- costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries)
- return (listArray (0,count-1) costcentres)
- | otherwise = return (listArray (0,-1) [])
- where
- mk_one t = (name, src)
- where name = concat $ intersperse "." $ tick_path t
- src = renderWithContext defaultSDocContext $ ppr $ tick_loc t
+-- | Get the source span for this breakpoint
+getBreakLoc :: BreakpointId -> ModBreaks -> SrcSpan
+getBreakLoc (BreakpointId bid_mod ix) mbs =
+ assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_locs mbs ! ix
+
+-- | Get the vars for this breakpoint
+getBreakVars :: BreakpointId -> ModBreaks -> [OccName]
+getBreakVars (BreakpointId bid_mod ix) mbs =
+ assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_vars mbs ! ix
+
+-- | Get the decls for this breakpoint
+getBreakDecls :: BreakpointId -> ModBreaks -> [String]
+getBreakDecls (BreakpointId bid_mod ix) mbs =
+ assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_decls mbs ! ix
+
+-- | Assert that the module in the 'BreakpointId' and in 'ModBreaks' match.
+assert_modules_match :: Module -> Module -> a -> a
+assert_modules_match bid_mod mbs_mod =
+ assertPpr (bid_mod == mbs_mod)
+ (text "Tried to query the ModBreaks of module" <+> ppr mbs_mod
+ <+> text "with a BreakpointId for module" <+> ppr bid_mod)
+
+{-
+Note [Field modBreaks_decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
+The breakpoint is in the function called "baz" that is declared in a `let`
+or `where` clause of a declaration called "bar", which itself is declared
+in a `let` or `where` clause of the top-level function called "foo".
+-}
+
=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -55,7 +55,6 @@ import Data.Bifunctor (second)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Set (Set)
import qualified Data.Set as Set
-import GHC.Types.Breakpoint (BreakpointId(..))
{-
************************************************************************
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -56,7 +56,6 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
constraintKindTyConKey )
-import GHC.Types.Breakpoint
import GHC.Types.Unique ( hasKey )
import GHC.Iface.Type
import GHC.Iface.Recomp.Binary
@@ -75,6 +74,7 @@ import GHC.Types.Avail
import GHC.Types.ForeignCall
import GHC.Types.Annotations( AnnPayload, AnnTarget )
import GHC.Types.Basic
+import GHC.Types.Tickish
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Types.SrcLoc
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -22,7 +22,6 @@ import GHC.Driver.Monad
import GHC.Driver.Session.Inspect
import GHC.Runtime.Eval
import GHC.Runtime.Eval.Utils
-import GHC.Types.Breakpoint
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Unit.Module
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -705,6 +705,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
{-
Note [Syncing breakpoint info]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ ROMES:TODO: Update
To display the values of the free variables for a single breakpoint, the
function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls
out the information from the fields `modBreaks_breakInfo` and
=====================================
compiler/GHC/Runtime/Eval/Types.hs
=====================================
@@ -17,17 +17,18 @@ import GHC.Prelude
import GHCi.RemoteTypes
import GHCi.Message (EvalExpr, ResumeContext)
+import GHC.ByteCode.Types (InternalBreakpointId(..))
import GHC.Driver.Config (EvalStep(..))
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.TyThing
-import GHC.Types.Breakpoint
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Utils.Exception
import Data.Word
import GHC.Stack.CCS
+import GHC.Types.Tickish (BreakpointId)
data ExecOptions
= ExecOptions
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -28,11 +28,10 @@ module GHC.Runtime.Interpreter
, whereFrom
, getModBreaks
, readModBreaks
+ , readModBreaksMaybe
, seqHValue
, evalBreakpointToId
, internalBreakIdToBreakId
- , interpreterDynamic
- , interpreterProfiled
-- * The object-code linker
, initObjLinker
@@ -77,9 +76,10 @@ import GHCi.Message
import GHCi.RemoteTypes
import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray)
-import GHC.Types.Breakpoint
-import GHC.ByteCode.Types
+import GHC.HsToCore.Breakpoints
+import GHC.ByteCode.Breakpoints
+import GHC.ByteCode.Types
import GHC.Linker.Types
import GHC.Data.Maybe
@@ -123,7 +123,6 @@ import qualified GHC.Unit.Home.Graph as HUG
-- Standard libraries
import GHC.Exts
-import qualified Data.IntMap as IntMap
{- Note [Remote GHCi]
~~~~~~~~~~~~~~~~~~
@@ -434,9 +433,8 @@ evalBreakpointToId eval_break =
-- See also Note [Breakpoint identifiers]
internalBreakIdToBreakId :: HomeUnitGraph -> InternalBreakpointId -> IO BreakpointId
internalBreakIdToBreakId hug ibi = do
- ModBreaks{modBreaks_breakInfo} <- readModBreaks hug (ibi_info_mod ibi)
- let CgBreakInfo{cgb_tick_id} = expectJust $
- IntMap.lookup (ibi_info_index ibi) modBreaks_breakInfo
+ (imbs, _) <- readModBreaks hug (ibi_info_mod ibi)
+ let CgBreakInfo{cgb_tick_id} = getInternalBreak ibi imbs
return cgb_tick_id
-- | Process the result of a Seq or ResumeSeq message. #2950
@@ -467,7 +465,7 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi
+ Just (_, modbreaks) -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -747,10 +745,13 @@ wormholeRef interp _r = case interpInstance interp of
ExternalInterp {}
-> throwIO (InstallationError "this operation requires -fno-external-interpreter")
--- -----------------------------------------------------------------------------
--- Misc utils
+--------------------------------------------------------------------------------
+-- * Finding breakpoint information
+--------------------------------------------------------------------------------
-getModBreaks :: HomeModInfo -> Maybe ModBreaks
+-- | Get the breakpoint information from the ByteCode object associated to this
+-- 'HomeModInfo'.
+getModBreaks :: HomeModInfo -> Maybe (InternalModBreaks, ModBreaks)
getModBreaks hmi
| Just linkable <- homeModInfoByteCode hmi,
-- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
@@ -759,33 +760,18 @@ getModBreaks hmi
| otherwise
= Nothing -- probably object code
--- | Read the 'ModBreaks' of the given home 'Module' from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks
-readModBreaks hug mod =
- expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
+-- from the 'HomeUnitGraph'.
+readModBreaks :: HomeUnitGraph -> Module -> IO (InternalModBreaks, ModBreaks)
+readModBreaks hug mod = expectJust <$> readModBreaksMaybe hug mod
+
+readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe (InternalModBreaks, ModBreaks))
+readModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug
+
+-- -----------------------------------------------------------------------------
+-- Misc utils
fromEvalResult :: EvalResult a -> IO a
fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
fromEvalResult (EvalSuccess a) = return a
--- | Interpreter uses Profiling way
-interpreterProfiled :: Interp -> Bool
-interpreterProfiled interp = case interpInstance interp of
-#if defined(HAVE_INTERNAL_INTERPRETER)
- InternalInterp -> hostIsProfiled
-#endif
- ExternalInterp ext -> case ext of
- ExtIServ i -> iservConfProfiled (interpConfig i)
- ExtJS {} -> False -- we don't support profiling yet in the JS backend
- ExtWasm i -> wasmInterpProfiled $ interpConfig i
-
--- | Interpreter uses Dynamic way
-interpreterDynamic :: Interp -> Bool
-interpreterDynamic interp = case interpInstance interp of
-#if defined(HAVE_INTERNAL_INTERPRETER)
- InternalInterp -> hostIsDynamic
-#endif
- ExternalInterp ext -> case ext of
- ExtIServ i -> iservConfDynamic (interpConfig i)
- ExtJS {} -> False -- dynamic doesn't make sense for JS
- ExtWasm {} -> True -- wasm dyld can only load dynamic code
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs
=====================================
@@ -24,7 +24,8 @@ module GHC.Runtime.Interpreter.Types
, interpSymbolSuffix
, eliminateInterpSymbol
, interpretedInterpSymbol
-
+ , interpreterProfiled
+ , interpreterDynamic
-- * IServ
, IServ
@@ -136,6 +137,28 @@ data ExtInterpInstance c = ExtInterpInstance
-- ^ Instance specific extra fields
}
+-- | Interpreter uses Profiling way
+interpreterProfiled :: Interp -> Bool
+interpreterProfiled interp = case interpInstance interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ InternalInterp -> hostIsProfiled
+#endif
+ ExternalInterp ext -> case ext of
+ ExtIServ i -> iservConfProfiled (interpConfig i)
+ ExtJS {} -> False -- we don't support profiling yet in the JS backend
+ ExtWasm i -> wasmInterpProfiled $ interpConfig i
+
+-- | Interpreter uses Dynamic way
+interpreterDynamic :: Interp -> Bool
+interpreterDynamic interp = case interpInstance interp of
+#if defined(HAVE_INTERNAL_INTERPRETER)
+ InternalInterp -> hostIsDynamic
+#endif
+ ExternalInterp ext -> case ext of
+ ExtIServ i -> iservConfDynamic (interpConfig i)
+ ExtJS {} -> False -- dynamic doesn't make sense for JS
+ ExtWasm {} -> True -- wasm dyld can only load dynamic code
+
------------------------
-- JS Stuff
------------------------
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -4,13 +4,14 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DerivingVia #-}
--
-- (c) The University of Glasgow 2002-2006
--
-- | GHC.StgToByteCode: Generate bytecode from STG
-module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen) where
+module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen ) where
import GHC.Prelude
@@ -70,7 +71,8 @@ import GHC.Data.OrdList
import GHC.Data.Maybe
import GHC.Types.Tickish
import GHC.Types.SptEntry
-import GHC.Types.Breakpoint
+import GHC.HsToCore.Breakpoints
+import GHC.ByteCode.Breakpoints
import Data.List ( genericReplicate, intersperse
, partition, scanl', sortBy, zip4, zip6 )
@@ -98,6 +100,10 @@ import GHC.Stg.Syntax
import qualified Data.IntSet as IntSet
import GHC.CoreToIface
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader (ReaderT)
+import Control.Monad.Trans.State (StateT)
+
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
@@ -131,9 +137,15 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
"Proto-BCOs" FormatByteCode
(vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos)))
- let mod_breaks = case modBreaks of
- Nothing -> Nothing
- Just mb -> Just mb{ modBreaks_breakInfo = breakInfo }
+ let all_mod_breaks = case mb_modBreaks of
+ Just modBreaks -> Just (modBreaks, internalBreaks)
+ Nothing -> Nothing
+ -- no modBreaks, thus drop all
+ -- internalBreaks? Will we ever want to have internal breakpoints in
+ -- a module for which we're not doing breakpoints at all? probably
+ -- not?
+ -- TODO: Consider always returning InternalBreaks;
+ -- TODO: Consider making ModBreaks a SUM that can be empty instead of using Maybe.
cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
-- Squash space leaks in the CompiledByteCode. This is really
@@ -314,7 +326,7 @@ schemeTopBind (id, rhs)
-- because mkConAppCode treats nullary constructor applications
-- by just re-using the single top-level definition. So
-- for the worker itself, we must allocate it directly.
- -- ioToBc (putStrLn $ "top level BCO")
+ -- liftIO (putStrLn $ "top level BCO")
pure (mkProtoBCO platform add_bco_name
(getName id) (toOL [PACK data_con 0, RETURN P])
(Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
@@ -395,32 +407,27 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
hsc_env <- getHscEnv
current_mod <- getCurrentModule
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
+ liftIO (readModBreaksMaybe (hsc_HUG hsc_env) current_mod) >>= \case
Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env (bi_tick_mod tick_id) current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = _tick_mod, modBreaks_ccs = cc_arr} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
+ Just ModBreaks {modBreaks_flags = breaks, modBreaks_ccs = cc_arr} -> do
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
+ let info_mod = current_mod
+ infox <- newBreakInfo breakInfo
- let cc | Just interp <- hsc_interp hsc_env
- , interpreterProfiled interp
- = cc_arr ! bi_tick_index tick_id
- | otherwise = toRemotePtr nullPtr
+ let cc | Just interp <- hsc_interp hsc_env
+ , interpreterProfiled interp
+ = cc_arr ! bi_tick_index tick_id
+ | otherwise = toRemotePtr nullPtr
- breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc
+ breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc
- return $ breakInstr `consOL` code
+ return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
-- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
@@ -452,7 +459,7 @@ break_info hsc_env mod current_mod current_mod_breaks
| mod == current_mod
= pure current_mod_breaks
| otherwise
- = ioToBc (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
+ = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
Just hp -> pure $ getModBreaks hp
Nothing -> pure Nothing
@@ -2630,57 +2637,33 @@ typeArgReps platform = map (toArgRep platform) . typePrimRep
-- -----------------------------------------------------------------------------
-- The bytecode generator's monad
+-- | Read only environment for generating ByteCode
+data BcM_Env
+ = BcM_Env
+ { bcm_hsc_env :: HscEnv
+ , bcm_module :: Module -- current module (for breakpoints)
+ , bcm_mod_breaks :: Maybe ModBreaks -- this module's ModBreaks
+ }
+
data BcM_State
= BcM_State
- { bcm_hsc_env :: HscEnv
- , thisModule :: Module -- current module (for breakpoints)
- , nextlabel :: Word32 -- for generating local labels
- , modBreaks :: Maybe ModBreaks -- info about breakpoints
-
- , breakInfo :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence.
- -- Indexed with breakpoint *info* index.
- -- See Note [Breakpoint identifiers]
- -- in GHC.Types.Breakpoint
- , breakInfoIdx :: !Int -- ^ Next index for breakInfo array
+ { nextlabel :: !Word32 -- ^ For generating local labels
+ , breakInfoIdx :: !Int -- ^ Next index for breakInfo array
+ , internalBreaks :: InternalModBreaks
+ -- ^ Info at breakpoints occurrences. Indexed with
+ -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in
+ -- GHC.ByteCode.Breakpoints.
}
-newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor)
-
-ioToBc :: IO a -> BcM a
-ioToBc io = BcM $ \st -> do
- x <- io
- return (st, x)
+newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (BcM_State, r))
+ deriving (Functor, Applicative, Monad, MonadIO)
+ via (ReaderT BcM_Env (StateT BcM_State IO))
runBc :: HscEnv -> Module -> Maybe ModBreaks
-> BcM r
-> IO (BcM_State, r)
runBc hsc_env this_mod modBreaks (BcM m)
- = m (BcM_State hsc_env this_mod 0 modBreaks IntMap.empty 0)
-
-thenBc :: BcM a -> (a -> BcM b) -> BcM b
-thenBc (BcM expr) cont = BcM $ \st0 -> do
- (st1, q) <- expr st0
- let BcM k = cont q
- (st2, r) <- k st1
- return (st2, r)
-
-thenBc_ :: BcM a -> BcM b -> BcM b
-thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do
- (st1, _) <- expr st0
- (st2, r) <- cont st1
- return (st2, r)
-
-returnBc :: a -> BcM a
-returnBc result = BcM $ \st -> (return (st, result))
-
-instance Applicative BcM where
- pure = returnBc
- (<*>) = ap
- (*>) = thenBc_
-
-instance Monad BcM where
- (>>=) = thenBc
- (>>) = (*>)
+ = m (BcM_Env hsc_env this_mod modBreaks) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty))
instance HasDynFlags BcM where
getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st))
@@ -2710,20 +2693,18 @@ getLabelsBc n
= BcM $ \st -> let ctr = nextlabel st
in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
-newBreakInfo :: CgBreakInfo -> BcM Int
-newBreakInfo info = BcM $ \st ->
+newBreakInfo :: CgBreakInfo -> BcM InternalBreakpointId
+newBreakInfo info = BcM $ \env st ->
let ix = breakInfoIdx st
+ ibi = InternalBreakpointId (bcm_module env) ix
st' = st
- { breakInfo = IntMap.insert ix info (breakInfo st)
- , breakInfoIdx = ix + 1
- }
- in return (st', ix)
+ { internalBreaks = addInternalBreak ibi info (internalBreaks st)
+ , breakInfoIdx = ix + 1
+ }
+ in return (st', ibi)
getCurrentModule :: BcM Module
getCurrentModule = BcM $ \st -> return (st, thisModule st)
-getCurrentModBreaks :: BcM (Maybe ModBreaks)
-getCurrentModBreaks = BcM $ \st -> return (st, modBreaks st)
-
tickFS :: FastString
tickFS = fsLit "ticked"
=====================================
compiler/GHC/Types/Breakpoint.hs deleted
=====================================
@@ -1,77 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
--- | Breakpoint related types
-module GHC.Types.Breakpoint
- ( BreakpointId (..)
- , InternalBreakpointId (..)
- , BreakTickIndex, BreakInfoIndex
- )
-where
-
-import Control.DeepSeq
-import GHC.Prelude
-import GHC.Unit.Module
-import GHC.Utils.Outputable
-import Data.Data (Data)
-
--- | Breakpoint tick index
-type BreakTickIndex = Int
-
--- | Internal breakpoint info index
-type BreakInfoIndex = Int
-
--- | Breakpoint identifier.
---
--- See Note [Breakpoint identifiers]
-data BreakpointId = BreakpointId
- { bi_tick_mod :: !Module -- ^ Breakpoint tick module
- , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index
- }
- deriving (Eq, Ord, Data)
-
--- | Internal breakpoint identifier
---
--- See Note [Breakpoint identifiers]
-data InternalBreakpointId = InternalBreakpointId
- { ibi_info_mod :: !Module -- ^ Breakpoint tick module
- , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
- }
- deriving (Eq, Ord)
-
--- Note [Breakpoint identifiers]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- ROMES:TODO: UPDATE NOTE
--- Before optimization a breakpoint is identified uniquely with a tick module
--- and a tick index. See BreakpointId. A tick module contains an array, indexed
--- with the tick indexes, which indicates breakpoint status.
---
--- When we generate ByteCode, we collect information for every breakpoint at
--- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info
--- are stored in the ModIface of the occurrence module. Because of inlining, we
--- can't reuse the tick index to uniquely identify an occurrence; because of
--- cross-module inlining, we can't assume that the occurrence module is the same
--- as the tick module (#24712).
---
--- So every breakpoint occurrence gets assigned a module-unique *info index* and
--- we store it alongside the occurrence module (*info module*) in the
--- InternalBreakpointId datatype.
-
---------------------------------------------------------------------------------
--- Instances
---------------------------------------------------------------------------------
-
-instance Outputable BreakpointId where
- ppr BreakpointId{..} =
- text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
-
-instance Outputable InternalBreakpointId where
- ppr InternalBreakpointId{..} =
- text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index
-
-instance NFData BreakpointId where
- rnf BreakpointId{..} =
- rnf bi_tick_mod `seq` rnf bi_tick_index
-
-instance NFData InternalBreakpointId where
- rnf InternalBreakpointId{..} =
- rnf ibi_info_mod `seq` rnf ibi_info_index
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -21,11 +21,15 @@ module GHC.Types.Tickish (
isProfTick,
TickishPlacement(..),
tickishPlace,
- tickishContains
+ tickishContains,
+
+ -- * Breakpoint tick identifiers
+ BreakpointId(..), BreakTickIndex
) where
import GHC.Prelude
import GHC.Data.FastString
+import Control.DeepSeq
import GHC.Core.Type
@@ -40,8 +44,7 @@ import GHC.Utils.Panic
import Language.Haskell.Syntax.Extension ( NoExtField )
import Data.Data
-import GHC.Utils.Outputable (Outputable (ppr), text)
-import GHC.Types.Breakpoint
+import GHC.Utils.Outputable (Outputable (ppr), text, (<+>))
{- *********************************************************************
* *
@@ -171,6 +174,33 @@ deriving instance Eq (GenTickish 'TickishPassCmm)
deriving instance Ord (GenTickish 'TickishPassCmm)
deriving instance Data (GenTickish 'TickishPassCmm)
+--------------------------------------------------------------------------------
+-- Tick breakpoint index
+--------------------------------------------------------------------------------
+
+-- | Breakpoint tick index
+type BreakTickIndex = Int
+
+-- | Breakpoint identifier.
+--
+-- Indexes into the structures in the @'ModBreaks'@ created during desugaring
+-- (after inserting the breakpoint ticks in the expressions).
+-- See Note [Breakpoint identifiers]
+data BreakpointId = BreakpointId
+ { bi_tick_mod :: !Module -- ^ Breakpoint tick module
+ , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index
+ }
+ deriving (Eq, Ord, Data)
+
+instance Outputable BreakpointId where
+ ppr BreakpointId{bi_tick_mod, bi_tick_index} =
+ text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index
+
+instance NFData BreakpointId where
+ rnf BreakpointId{bi_tick_mod, bi_tick_index} =
+ rnf bi_tick_mod `seq` rnf bi_tick_index
+
+--------------------------------------------------------------------------------
-- | A "counting tick" (where tickishCounts is True) is one that
-- counts evaluations in some way. We cannot discard a counting tick,
=====================================
compiler/GHC/Unit/External.hs
=====================================
@@ -24,7 +24,7 @@ import GHC.Unit.Module.ModIface
import GHC.Core.FamInstEnv
import GHC.Core.InstEnv ( InstEnv, emptyInstEnv )
import GHC.Core.Opt.ConstantFold
-import GHC.Core.Rules ( RuleBase, mkRuleBase)
+import GHC.Core.Rules ( RuleBase, mkRuleBase )
import GHC.Types.Annotations ( AnnEnv, emptyAnnEnv )
import GHC.Types.CompleteMatch
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -7,7 +7,7 @@ where
import GHC.Prelude
-import GHC.ByteCode.Types
+import GHC.HsToCore.Breakpoints
import GHC.ForeignSrcLang
import GHC.Hs
=====================================
compiler/ghc.cabal.in
=====================================
@@ -223,6 +223,7 @@ Library
GHC.Builtin.Uniques
GHC.Builtin.Utils
GHC.ByteCode.Asm
+ GHC.ByteCode.Breakpoints
GHC.ByteCode.InfoTable
GHC.ByteCode.Instr
GHC.ByteCode.Linker
@@ -892,7 +893,6 @@ Library
GHC.Types.Annotations
GHC.Types.Avail
GHC.Types.Basic
- GHC.Types.Breakpoint
GHC.Types.CompleteMatch
GHC.Types.CostCentre
GHC.Types.CostCentre.State
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2578af8a2a622f6e0990e7001ad7ae…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2578af8a2a622f6e0990e7001ad7ae…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
26 Jun '25
Ben Gamari pushed new branch wip/caller-cc-sensitivity at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/caller-cc-sensitivity
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Expose ghc-internal unit id through the settings file
by Marge Bot (＠marge-bot) 26 Jun '25
by Marge Bot (＠marge-bot) 26 Jun '25
26 Jun '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
61f2f973 by Teo Camarasu at 2025-06-26T06:55:48-04:00
Implement user-defined allocation limit handlers
Allocation Limits allow killing a thread if they allocate more than a
user-specified limit.
We extend this feature to allow more versatile behaviour.
- We allow not killing the thread if the limit is exceeded.
- We allow setting a custom handler to be called when the limit is exceeded.
User-specified allocation limit handlers run in a fresh thread and are passed
the ThreadId of the thread that exceeded its limit.
We introduce utility functions for getting and setting the allocation
limits of other threads, so that users can reset the limit of a thread
from a handler. Both of these are somewhat coarse-grained as we are
unaware of the allocations in the current nursery chunk.
We provide several examples of usages in testsuite/tests/rts/T22859.hs
Resolves #22859
- - - - -
088cd94e by Florian Ragwitz at 2025-06-26T06:55:58-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
41 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/Setup.hs
- docs/users_guide/9.14.1-notes.rst
- hadrian/src/Rules/Generate.hs
- libraries/ghc-experimental/ghc-experimental.cabal.in
- + libraries/ghc-experimental/src/System/Mem/Experimental.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- + libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/Schedule.c
- rts/external-symbols.list.in
- rts/include/rts/storage/GC.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MiscClosures.h
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
- 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
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- + testsuite/tests/rts/T22859.hs
- + testsuite/tests/rts/T22859.stderr
- testsuite/tests/rts/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7591beb672d5726b659ae2c176009…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7591beb672d5726b659ae2c176009…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T18570] 2 commits: Fix hole fits
by Sjoerd Visscher (＠trac-sjoerd_visscher) 26 Jun '25
by Sjoerd Visscher (＠trac-sjoerd_visscher) 26 Jun '25
26 Jun '25
Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
2431bd4d by Sjoerd Visscher at 2025-06-26T12:00:18+02:00
Fix hole fits
- - - - -
df12b161 by Sjoerd Visscher at 2025-06-26T12:00:19+02:00
Remove check for LinearTypes extension
- - - - -
9 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
- testsuite/tests/perf/compiler/T16875.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- utils/haddock/html-test/ref/Bug294.html
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3541,12 +3541,12 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
pprHoleFit _ (RawHoleFit sd) = sd
pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
hang display 2 provenance
- where tyApp = sep $ zipWithEqual pprArg vars hfWrap
+ where tyApps = concat $ zipWithEqual pprArg vars hfWrap
where pprArg b arg = case binderFlag b of
- Specified -> text "@" <> pprParendType arg
+ Specified -> [text "@" <> pprParendType arg]
-- Do not print type application for inferred
-- variables (#16456)
- Inferred -> empty
+ Inferred -> []
Required -> pprPanic "pprHoleFit: bad Required"
(ppr b <+> ppr arg)
tyAppVars = sep $ punctuate comma $
@@ -3573,9 +3573,9 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
IdHFCand id_ -> pprPrefixOcc id_
tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
has = not . null
- wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
+ wrapDisp = ppWhen (has tyApps && (sWrp || sWrpVars))
$ text "with" <+> if sWrp || not sTy
- then occDisp <+> tyApp
+ then occDisp <+> sep tyApps
else tyAppVars
docs = case hfDoc of
Just d -> pprHsDocStrings d
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -841,7 +841,7 @@ mkPatSynRecSelBinds :: PatSyn
-> FieldSelectors
-> [(Id, LHsBind GhcRn)]
mkPatSynRecSelBinds ps fields has_sel
- = [ mkOneRecordSelector False [PatSynCon ps] (RecSelPatSyn ps) fld_lbl has_sel
+ = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl has_sel
| fld_lbl <- fields ]
isUnidirectional :: HsPatSynDir a -> Bool
=====================================
compiler/GHC/Tc/TyCl/Utils.hs
=====================================
@@ -766,8 +766,7 @@ addTyConsToGblEnv tyclss
do { traceTc "tcAddTyCons" $ vcat
[ text "tycons" <+> ppr tyclss
, text "implicits" <+> ppr implicit_things ]
- ; linearEnabled <- xoptM LangExt.LinearTypes
- ; gbl_env <- tcRecSelBinds (mkRecSelBinds linearEnabled tyclss)
+ ; gbl_env <- tcRecSelBinds (mkRecSelBinds tyclss)
; th_bndrs <- tcTyThBinders implicit_things
; return (gbl_env, th_bndrs)
}
@@ -850,24 +849,24 @@ tcRecSelBinds sel_bind_prs
, let loc = getSrcSpan sel_id ]
binds = [(NonRecursive, [bind]) | (_, bind) <- sel_bind_prs]
-mkRecSelBinds :: Bool -> [TyCon] -> [(Id, LHsBind GhcRn)]
+mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)]
-- NB We produce *un-typechecked* bindings, rather like 'deriving'
-- This makes life easier, because the later type checking will add
-- all necessary type abstractions and applications
-mkRecSelBinds allowMultiplicity tycons
- = [ mkRecSelBind allowMultiplicity tc fld | tc <- tycons
- , fld <- tyConFieldLabels tc ]
+mkRecSelBinds tycons
+ = [ mkRecSelBind tc fld | tc <- tycons
+ , fld <- tyConFieldLabels tc ]
-mkRecSelBind :: Bool -> TyCon -> FieldLabel -> (Id, LHsBind GhcRn)
-mkRecSelBind allowMultiplicity tycon fl
- = mkOneRecordSelector allowMultiplicity all_cons (RecSelData tycon) fl
+mkRecSelBind :: TyCon -> FieldLabel -> (Id, LHsBind GhcRn)
+mkRecSelBind tycon fl
+ = mkOneRecordSelector all_cons (RecSelData tycon) fl
FieldSelectors -- See Note [NoFieldSelectors and naughty record selectors]
where
all_cons = map RealDataCon (tyConDataCons tycon)
-mkOneRecordSelector :: Bool -> [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors
+mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors
-> (Id, LHsBind GhcRn)
-mkOneRecordSelector allowMultiplicity all_cons idDetails fl has_sel
+mkOneRecordSelector all_cons idDetails fl has_sel
= (sel_id, L (noAnnSrcSpan loc) sel_bind)
where
loc = getSrcSpan sel_name
@@ -932,7 +931,7 @@ mkOneRecordSelector allowMultiplicity all_cons idDetails fl has_sel
mkVisFunTy sel_mult data_ty $
field_ty
non_partial = length all_cons == length cons_w_field -- See Note [Multiplicity and partial selectors]
- (mult_tvb, sel_mult) = if allowMultiplicity && non_partial && all_other_fields_unrestricted
+ (mult_tvb, sel_mult) = if non_partial && all_other_fields_unrestricted
then ([mkForAllTyBinder (Invisible InferredSpec) mult_var], mkTyVarTy mult_var)
else ([], manyDataConTy)
mult_var = mkTyVar (mkSysTvName (mkBuiltinUnique 1) (fsLit "m")) multiplicityTy
=====================================
testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
=====================================
@@ -1,4 +1,3 @@
-
DRFHoleFits.hs:7:7: error: [GHC-88464]
• Found hole: _ :: T -> Int
• In the expression: _ :: T -> Int
@@ -6,8 +5,8 @@ DRFHoleFits.hs:7:7: error: [GHC-88464]
• Relevant bindings include
bar :: T -> Int (bound at DRFHoleFits.hs:7:1)
Valid hole fits include
- foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
bar :: T -> Int (defined at DRFHoleFits.hs:7:1)
+ foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
DRFHoleFits.hs:8:7: error: [GHC-88464]
• Found hole: _ :: A.S -> Int
@@ -20,3 +19,4 @@ DRFHoleFits.hs:8:7: error: [GHC-88464]
A.foo :: A.S -> Int
(imported qualified from ‘DRFHoleFits_A’ at DRFHoleFits.hs:3:1-35
(and originally defined at DRFHoleFits_A.hs:5:16-18))
+
=====================================
testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
=====================================
@@ -1,5 +1,8 @@
data Main.R = Main.MkR {Main.foo :: GHC.Internal.Types.Int}
-Main.foo :: Main.R -> GHC.Internal.Types.Int
-Main.foo :: Main.R -> GHC.Internal.Types.Int
-Main.foo :: Main.R -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
+Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
+ Main.R %m_0 -> GHC.Internal.Types.Int
42
=====================================
testsuite/tests/perf/compiler/T16875.stderr
=====================================
@@ -6,7 +6,5 @@ T16875.hs:12:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• In an equation for ‘a’: a = _
• Relevant bindings include a :: p (bound at T16875.hs:12:1)
Valid hole fits include
- a :: forall {p}. p
- with a
- (defined at T16875.hs:12:1)
+ a :: forall {p}. p (defined at T16875.hs:12:1)
=====================================
testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
=====================================
@@ -1,22 +1,32 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 82, types: 52, coercions: 29, joins: 0/0}
+ = {terms: 83, types: 55, coercions: 31, joins: 0/0}
--- RHS size: {terms: 3, types: 3, coercions: 0, joins: 0/0}
-unsafeToInteger1 :: forall (n :: Nat). Signed n -> Signed n
+-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
+unsafeToInteger1
+ :: forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Signed n
[GblId, Arity=1, Unf=OtherCon []]
-unsafeToInteger1 = \ (@(n :: Nat)) (ds :: Signed n) -> ds
+unsafeToInteger1
+ = \ (@(n :: Nat))
+ (@(m :: GHC.Internal.Types.Multiplicity))
+ (ds :: Signed n) ->
+ ds
--- RHS size: {terms: 1, types: 0, coercions: 8, joins: 0/0}
-unsafeToInteger :: forall (n :: Nat). Signed n -> Integer
+-- RHS size: {terms: 1, types: 0, coercions: 10, joins: 0/0}
+unsafeToInteger
+ :: forall (n :: Nat) {m :: GHC.Internal.Types.Multiplicity}.
+ Signed n %m -> Integer
[GblId[[RecSel]], Arity=1, Unf=OtherCon []]
unsafeToInteger
= unsafeToInteger1
- `cast` (forall (n :: <Nat>_N).
- <Signed n>_R %<Many>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
- :: (forall (n :: Nat). Signed n -> Signed n)
- ~R# (forall (n :: Nat). Signed n -> Integer))
+ `cast` (forall (n :: <Nat>_N) (m :: <GHC.Internal.Types.Multiplicity>_N).
+ <Signed n>_R %<m>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
+ :: (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Signed n)
+ ~R# (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
+ Signed n %m -> Integer))
-- RHS size: {terms: 8, types: 7, coercions: 21, joins: 0/0}
times [InlPrag=OPAQUE]
=====================================
testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
=====================================
@@ -1,3 +1,11 @@
-CommonFieldTypeMismatch.hs:3:1: [GHC-91827]
- Constructors A1 and A2 give different types for field ‘fld’
- In the data type declaration for ‘A’
+CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
+ • Constructors A1 and A2 give different types for field ‘fld’
+ • In the data type declaration for ‘A’
+
+CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
+ • Couldn't match type ‘[Char]’ with ‘Int’
+ Expected: Int
+ Actual: String
+ • In the expression: fld
+ In an equation for ‘fld’: fld A2 {fld = fld} = fld
+
=====================================
utils/haddock/html-test/ref/Bug294.html
=====================================
@@ -159,9 +159,13 @@
><p class="src"
><a id="v:problemField" class="def"
>problemField</a
- > :: TO <a href="#" title="Bug294"
+ > :: <span class="keyword"
+ >forall</span
+ > {m :: <a href="#" title="GHC.Exts"
+ >Multiplicity</a
+ >}. TO <a href="#" title="Bug294"
>A</a
- > -> <a href="#" title="Bug294"
+ > %m -> <a href="#" title="Bug294"
>A</a
> <a href="#" class="selflink"
>#</a
@@ -171,9 +175,13 @@
><p class="src"
><a id="v:problemField-39-" class="def"
>problemField'</a
- > :: DO <a href="#" title="Bug294"
+ > :: <span class="keyword"
+ >forall</span
+ > {m :: <a href="#" title="GHC.Exts"
+ >Multiplicity</a
+ >}. DO <a href="#" title="Bug294"
>A</a
- > -> <a href="#" title="Bug294"
+ > %m -> <a href="#" title="Bug294"
>A</a
> <a href="#" class="selflink"
>#</a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4876d312cc9e208e2c51af1226bb68…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4876d312cc9e208e2c51af1226bb68…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 3 commits: CI: Fix and clean up capture of timings
by Marge Bot (＠marge-bot) 26 Jun '25
by Marge Bot (＠marge-bot) 26 Jun '25
26 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
5 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -367,7 +367,7 @@ lint-submods-branch:
- .gitlab/ci.sh setup
after_script:
- .gitlab/ci.sh save_cache
- - cat ci-timings
+ - cat ci_timings.txt
variables:
GHC_FLAGS: -Werror
cache:
@@ -419,7 +419,7 @@ hadrian-ghc-in-ghci:
- echo ":q" | HADRIAN_ARGS=-j$CORES hadrian/ghci -j$CORES | tail -n2 | grep "Ok,"
after_script:
- .gitlab/ci.sh save_cache
- - cat ci-timings
+ - cat ci_timings.txt
cache:
key: hadrian-ghci-$CACHE_REV
paths:
=====================================
.gitlab/ci.sh
=====================================
@@ -34,7 +34,11 @@ function time_it() {
local delta=$(expr $end - $start)
echo "$name took $delta seconds"
- printf "%15s | $delta" > ci-timings
+ if [[ ! -e ci_timings.txt ]]; then
+ echo "=== TIMINGS ===" > ci_timings.txt
+ fi
+
+ printf "%15s | $delta\n" $name >> ci_timings.txt
return $res
}
@@ -239,8 +243,6 @@ function cabal_update() {
# Extract GHC toolchain
function setup() {
- echo "=== TIMINGS ===" > ci-timings
-
if [ -d "$CABAL_CACHE" ]; then
info "Extracting cabal cache from $CABAL_CACHE to $CABAL_DIR..."
mkdir -p "$CABAL_DIR"
@@ -279,7 +281,7 @@ function fetch_ghc() {
fail "neither GHC nor GHC_VERSION are not set"
fi
- start_section "fetch GHC"
+ start_section fetch-ghc "Fetch GHC"
url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…"
info "Fetching GHC binary distribution from $url..."
curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution"
@@ -296,7 +298,7 @@ function fetch_ghc() {
;;
esac
rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz
- end_section "fetch GHC"
+ end_section fetch-ghc
fi
}
@@ -308,7 +310,7 @@ function fetch_cabal() {
fail "neither CABAL nor CABAL_INSTALL_VERSION are not set"
fi
- start_section "fetch cabal"
+ start_section fetch-cabal "Fetch Cabal"
case "$(uname)" in
# N.B. Windows uses zip whereas all others use .tar.xz
MSYS_*|MINGW*)
@@ -341,7 +343,7 @@ function fetch_cabal() {
fi
;;
esac
- end_section "fetch cabal"
+ end_section fetch-cabal
fi
}
@@ -349,6 +351,7 @@ function fetch_cabal() {
# here. For Docker platforms this is done in the Docker image
# build.
function setup_toolchain() {
+ start_section setup-toolchain "Setup toolchain"
fetch_ghc
fetch_cabal
cabal_update
@@ -371,10 +374,11 @@ function setup_toolchain() {
info "Building alex..."
$cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION"
+ end_section setup-toolchain
}
function cleanup_submodules() {
- start_section "clean submodules"
+ start_section clean-submodules "Clean submodules"
if [ -d .git ]; then
info "Cleaning submodules..."
# On Windows submodules can inexplicably get into funky states where git
@@ -386,7 +390,7 @@ function cleanup_submodules() {
else
info "Not cleaning submodules, not in a git repo"
fi;
- end_section "clean submodules"
+ end_section clean-submodules
}
function configure() {
@@ -486,6 +490,8 @@ function check_release_build() {
}
function build_hadrian() {
+ start_section build-hadrian "Build via Hadrian"
+
if [ -z "${BIN_DIST_NAME:-}" ]; then
fail "BIN_DIST_NAME not set"
fi
@@ -519,7 +525,7 @@ function build_hadrian() {
;;
esac
fi
-
+ end_section build-hadrian
}
# run's `make DESTDIR=$1 install` and then
@@ -545,6 +551,7 @@ function make_install_destdir() {
# install the binary distribution in directory $1 to $2.
function install_bindist() {
+ start_section install-bindist "Install bindist"
case "${CONFIGURE_WRAPPER:-}" in
emconfigure) source "$EMSDK/emsdk_env.sh" ;;
*) ;;
@@ -584,9 +591,11 @@ function install_bindist() {
;;
esac
popd
+ end_section install-bindist
}
function test_hadrian() {
+ start_section test-hadrian "Test via Hadrian"
check_msys2_deps _build/stage1/bin/ghc --version
check_release_build
@@ -708,6 +717,7 @@ function test_hadrian() {
info "STAGE2_TEST=$?"
fi
+ end_section test-hadrian
}
function summarise_hi_files() {
@@ -742,7 +752,7 @@ function cabal_abi_test() {
pushd $DIR
echo $PWD
- start_section "Cabal test: $OUT"
+ start_section cabal-abi-test "Cabal ABI test: $OUT"
mkdir -p "$OUT"
"$HC" \
-hidir tmp -odir tmp -fforce-recomp -haddock \
@@ -752,7 +762,7 @@ function cabal_abi_test() {
summarise_hi_files
summarise_o_files
popd
- end_section "Cabal test: $OUT"
+ end_section cabal-abi-test
}
function cabal_test() {
@@ -760,7 +770,7 @@ function cabal_test() {
fail "OUT not set"
fi
- start_section "Cabal test: $OUT"
+ start_section cabal-test "Cabal test: $OUT"
mkdir -p "$OUT"
run "$HC" \
-hidir tmp -odir tmp -fforce-recomp \
@@ -769,7 +779,7 @@ function cabal_test() {
-ilibraries/Cabal/Cabal/src -XNoPolyKinds Distribution.Simple \
"$@" 2>&1 | tee $OUT/log
rm -Rf tmp
- end_section "Cabal test: $OUT"
+ end_section cabal-test
}
function run_perf_test() {
=====================================
.gitlab/common.sh
=====================================
@@ -20,15 +20,18 @@ WHITE="1;37"
LT_GRAY="0;37"
# GitLab Pipelines log section delimiters
-# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664
-start_section() {
- name="$1"
- echo -e "section_start:$(date +%s):$name\015\033[0K"
+# https://docs.gitlab.com/ci/jobs/job_logs/#custom-collapsible-sections
+function start_section () {
+ local section_title="${1}"
+ local section_description="${2:-$section_title}"
+
+ echo -e "section_start:$(date +%s):${section_title}[collapsed=true]\r\e[0K${section_description}"
}
-end_section() {
- name="$1"
- echo -e "section_end:$(date +%s):$name\015\033[0K"
+function end_section () {
+ local section_title="${1}"
+
+ echo -e "section_end:$(date +%s):${section_title}\r\e[0K"
}
echo_color() {
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -870,7 +870,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} }
[ ".gitlab/ci.sh save_cache"
, ".gitlab/ci.sh save_test_output"
, ".gitlab/ci.sh clean"
- , "cat ci_timings"
+ , "cat ci_timings.txt"
]
jobFlavour = mkJobFlavour buildConfig
=====================================
.gitlab/jobs.yaml
=====================================
@@ -5,7 +5,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -71,7 +71,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -134,7 +134,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -196,7 +196,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -258,7 +258,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -320,7 +320,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -401,7 +401,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -482,7 +482,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -545,7 +545,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -607,7 +607,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -669,7 +669,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -736,7 +736,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -800,7 +800,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -863,7 +863,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -926,7 +926,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -989,7 +989,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1071,7 +1071,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1153,7 +1153,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -1217,7 +1217,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1280,7 +1280,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1343,7 +1343,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1413,7 +1413,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1479,7 +1479,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -1543,7 +1543,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1607,7 +1607,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1671,7 +1671,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1735,7 +1735,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1800,7 +1800,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1865,7 +1865,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1930,7 +1930,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1993,7 +1993,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2056,7 +2056,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2121,7 +2121,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2187,7 +2187,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2250,7 +2250,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2313,7 +2313,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -2376,7 +2376,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2440,7 +2440,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2503,7 +2503,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2568,7 +2568,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2631,7 +2631,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2694,7 +2694,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2757,7 +2757,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2820,7 +2820,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -2885,7 +2885,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2948,7 +2948,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3011,7 +3011,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3076,7 +3076,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3142,7 +3142,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3207,7 +3207,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3270,7 +3270,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3333,7 +3333,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3396,7 +3396,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3459,7 +3459,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3522,7 +3522,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3587,7 +3587,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3776,7 +3776,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3844,7 +3844,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3909,7 +3909,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3973,7 +3973,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4037,7 +4037,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -4102,7 +4102,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4166,7 +4166,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4230,7 +4230,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4301,7 +4301,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4368,7 +4368,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -4433,7 +4433,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4498,7 +4498,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4563,7 +4563,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4628,7 +4628,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4692,7 +4692,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4756,7 +4756,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4820,7 +4820,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4884,7 +4884,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4948,7 +4948,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5014,7 +5014,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5080,7 +5080,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5147,7 +5147,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5211,7 +5211,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5275,7 +5275,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5339,7 +5339,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5403,7 +5403,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5467,7 +5467,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5659,7 +5659,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5728,7 +5728,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5793,7 +5793,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -5856,7 +5856,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5919,7 +5919,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5982,7 +5982,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6045,7 +6045,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6109,7 +6109,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6174,7 +6174,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6239,7 +6239,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6301,7 +6301,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6363,7 +6363,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6427,7 +6427,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6492,7 +6492,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6554,7 +6554,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6616,7 +6616,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6679,7 +6679,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6742,7 +6742,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6804,7 +6804,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6868,7 +6868,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6930,7 +6930,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6992,7 +6992,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7054,7 +7054,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7116,7 +7116,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -7181,7 +7181,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7243,7 +7243,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7305,7 +7305,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7369,7 +7369,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7434,7 +7434,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7498,7 +7498,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7560,7 +7560,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7622,7 +7622,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7684,7 +7684,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7746,7 +7746,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7808,7 +7808,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7872,7 +7872,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/49f44e52c1fb6188a5b3b40f5513c8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/49f44e52c1fb6188a5b3b40f5513c8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Expose ghc-internal unit id through the settings file
by Marge Bot (＠marge-bot) 26 Jun '25
by Marge Bot (＠marge-bot) 26 Jun '25
26 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
3 changed files:
- compiler/GHC/Driver/Session.hs
- compiler/Setup.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3463,6 +3463,7 @@ compilerInfo dflags
("Project Patch Level1", cProjectPatchLevel1),
("Project Patch Level2", cProjectPatchLevel2),
("Project Unit Id", cProjectUnitId),
+ ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids]
("Booter version", cBooterVersion),
("Stage", cStage),
("Build platform", cBuildPlatformString),
@@ -3516,6 +3517,26 @@ compilerInfo dflags
expandDirectories :: FilePath -> Maybe FilePath -> String -> String
expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd
+-- Note [Special unit-ids]
+-- ~~~~~~~~~~~~~~~~~~~~~~~
+-- Certain units are special to the compiler:
+-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`.
+-- - GHC plugins must be linked against a specific unit-id of `ghc`,
+-- namely the same one as the compiler.
+-- - When using Template Haskell, the result of executing splices refer to
+-- the Template Haskell ASTs created using constructors from `ghc-internal`,
+-- and must be linked against the same `ghc-internal` unit-id as the compiler.
+--
+-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and
+-- ghc ("Project Unit Id") through `ghc --info`.
+--
+-- This allows build tools to act accordingly, eg, if a user wishes to build a
+-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit
+-- that the compiler was linked against.
+-- See:
+-- - https://github.com/haskell/cabal/issues/10087
+-- - https://github.com/commercialhaskell/stack/issues/6749
+
{- -----------------------------------------------------------------------------
Note [DynFlags consistency]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/Setup.hs
=====================================
@@ -11,6 +11,7 @@ import Distribution.Verbosity
import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Simple.Setup
+import Distribution.Simple.PackageIndex
import System.IO
import System.Process
@@ -56,7 +57,7 @@ primopIncls =
]
ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
-ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap}
+ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs}
= do
-- Get compiler/ root directory from the cabal file
let Just compilerRoot = takeDirectory <$> pkgDescrFile
@@ -96,9 +97,14 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId
_ -> error "Couldn't find unique cabal library when building ghc"
+ let cGhcInternalUnitId = case lookupPackageName installedPkgs (mkPackageName "ghc-internal") of
+ -- We assume there is exactly one copy of `ghc-internal` in our dependency closure
+ [(_,[packageInfo])] -> unUnitId $ installedUnitId packageInfo
+ _ -> error "Couldn't find unique ghc-internal library when building ghc"
+
-- Write GHC.Settings.Config
configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
- configHs = generateConfigHs cProjectUnitId settings
+ configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings
createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
rewriteFileEx verbosity configHsPath configHs
@@ -110,8 +116,9 @@ getSetting settings kh kr = go settings kr
Just v -> Right v
generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key
+ -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key
-> [(String,String)] -> String
-generateConfigHs cProjectUnitId settings = either error id $ do
+generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do
let getSetting' = getSetting $ (("cStage","2"):) settings
buildPlatform <- getSetting' "cBuildPlatformString" "Host platform"
hostPlatform <- getSetting' "cHostPlatformString" "Target platform"
@@ -127,6 +134,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -150,4 +158,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -607,6 +607,8 @@ generateConfigHs = do
-- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the
-- unit-id in both situations.
cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage
+
+ cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage
return $ unlines
[ "module GHC.Settings.Config"
, " ( module GHC.Version"
@@ -616,6 +618,7 @@ generateConfigHs = do
, " , cBooterVersion"
, " , cStage"
, " , cProjectUnitId"
+ , " , cGhcInternalUnitId"
, " ) where"
, ""
, "import GHC.Prelude.Basic"
@@ -639,6 +642,9 @@ generateConfigHs = do
, ""
, "cProjectUnitId :: String"
, "cProjectUnitId = " ++ show cProjectUnitId
+ , ""
+ , "cGhcInternalUnitId :: String"
+ , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId
]
where
stageString (Stage0 InTreeLibs) = "1"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49f44e52c1fb6188a5b3b40f5513c80…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49f44e52c1fb6188a5b3b40f5513c80…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
99ef3a43 by Simon Peyton Jones at 2025-06-25T23:13:42+01:00
Remove pprTrace
- - - - -
1 changed file:
- compiler/GHC/HsToCore/Binds.hs
Changes:
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1357,37 +1357,37 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs
= Left (DsRuleIgnoredDueToConstructor con) -- See Note [No RULES on datacons]
| otherwise = case decompose fun2 args2 of
- Nothing -> pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
- , text "orig_lhs:" <+> ppr orig_lhs
- , text "rhs_fvs:" <+> ppr rhs_fvs
- , text "lhs1:" <+> ppr lhs1
- , text "lhs2:" <+> ppr lhs2
- , text "fun2:" <+> ppr fun2
- , text "args2:" <+> ppr args2
- ]) $
+ Nothing -> -- pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
+ -- , text "orig_lhs:" <+> ppr orig_lhs
+ -- , text "rhs_fvs:" <+> ppr rhs_fvs
+ -- , text "lhs1:" <+> ppr lhs1
+ -- , text "lhs2:" <+> ppr lhs2
+ -- , text "fun2:" <+> ppr fun2
+ -- , text "args2:" <+> ppr args2
+ -- ]) $
Left (DsRuleLhsTooComplicated orig_lhs lhs2)
Just (fn_id, args)
| not (null unbound) ->
-- Check for things unbound on LHS
-- See Note [Unused spec binders]
- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
- , text "orig_lhs:" <+> ppr orig_lhs
- , text "lhs_fvs:" <+> ppr lhs_fvs
- , text "rhs_fvs:" <+> ppr rhs_fvs
- , text "unbound:" <+> ppr unbound
- ]) $
+ -- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
+ -- , text "orig_lhs:" <+> ppr orig_lhs
+ -- , text "lhs_fvs:" <+> ppr lhs_fvs
+ -- , text "rhs_fvs:" <+> ppr rhs_fvs
+ -- , text "unbound:" <+> ppr unbound
+ -- ]) $
Left (DsRuleBindersNotBound unbound orig_bndrs orig_lhs lhs2)
| otherwise ->
- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
- , text "orig_lhs:" <+> ppr orig_lhs
- , text "lhs1:" <+> ppr lhs1
- , text "trimmed_bndrs:" <+> ppr trimmed_bndrs
- , text "extra_dicts:" <+> ppr extra_dicts
- , text "fn_id:" <+> ppr fn_id
- , text "args:" <+> ppr args
- , text "args fvs:" <+> ppr (exprsFreeVarsList args)
- ]) $
+ -- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
+ -- , text "orig_lhs:" <+> ppr orig_lhs
+ -- , text "lhs1:" <+> ppr lhs1
+ -- , text "trimmed_bndrs:" <+> ppr trimmed_bndrs
+ -- , text "extra_dicts:" <+> ppr extra_dicts
+ -- , text "fn_id:" <+> ppr fn_id
+ -- , text "args:" <+> ppr args
+ -- , text "args fvs:" <+> ppr (exprsFreeVarsList args)
+ -- ]) $
Right (trimmed_bndrs ++ extra_dicts, fn_id, args)
where -- See Note [Variables unbound on the LHS]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99ef3a43e3e6df491526890edf8dc64…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99ef3a43e3e6df491526890edf8dc64…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Teach `:reload` about multiple home units
by Marge Bot (＠marge-bot) 25 Jun '25
by Marge Bot (＠marge-bot) 25 Jun '25
25 Jun '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
2afba950 by Teo Camarasu at 2025-06-25T17:39:16-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
18a3cc81 by Bryan Richter at 2025-06-25T17:39:17-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
6c7d8f04 by Bryan Richter at 2025-06-25T17:39:17-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
f7591beb by Bryan Richter at 2025-06-25T17:39:17-04:00
CI: Add more collapsible sections
- - - - -
49 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Setup.hs
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/src/Rules/Generate.hs
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7889cc864b1d2f37e226c7044f90b1…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7889cc864b1d2f37e226c7044f90b1…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Implement `-fno-load-initial-targets` flag
by Marge Bot (＠marge-bot) 25 Jun '25
by Marge Bot (＠marge-bot) 25 Jun '25
25 Jun '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
35 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Unit/Module/Graph.hs
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/all.T
- − testsuite/tests/ghci/prog021/prog021.T
- testsuite/tests/ghci/prog021/prog021.script → testsuite/tests/ghci/prog021/prog021a.script
- testsuite/tests/ghci/prog021/prog021.stderr → testsuite/tests/ghci/prog021/prog021a.stderr
- testsuite/tests/ghci/prog021/prog021.stdout → testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3d97bb3fa88fcbf9189bb763211a3d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3d97bb3fa88fcbf9189bb763211a3d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0