Simon Peyton Jones pushed new branch wip/T25995 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T25995
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
43b0dfc2 by Matthew Pickering at 2025-04-24T16:06:35+01:00
Undo
- - - - -
2 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -2035,10 +2035,6 @@ instance Diagnostic TcRnMessage where
TcRnUnexpectedTypeSyntaxInTerms syntax -> mkSimpleDecorated $
text "Unexpected" <+> pprTypeSyntaxName syntax
- TcRnDeriveLiftWithoutImplicitStagePersistence{}
- -> mkSimpleDecorated $
- text "Deriving Lift is not possible when ImplicitStagePersistence is disabled."
-
diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
TcRnUnknownMessage m
@@ -2689,8 +2685,6 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnUnexpectedTypeSyntaxInTerms{}
-> ErrorWithoutFlag
- TcRnDeriveLiftWithoutImplicitStagePersistence{}
- -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -3380,8 +3374,6 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnUnexpectedTypeSyntaxInTerms syntax
-> [suggestExtension (typeSyntaxExtension syntax)]
- TcRnDeriveLiftWithoutImplicitStagePersistence{}
- -> noHints
diagnosticCode = constructorCode @GHC
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -4453,17 +4453,6 @@ data TcRnMessage where
Test cases: T24159_type_syntax_rn_fail
-}
TcRnUnexpectedTypeSyntaxInTerms :: TypeSyntax -> TcRnMessage
-
- {-| TcRnDeriveLiftWithoutImplicitStagePersistence is an error indicating that
- someone tried to derive a Lift instance when ImplicitStagePersistence is enabled.
-
-
- Test cases:
- None yet
- -}
- TcRnDeriveLiftWithoutImplicitStagePersistence :: !Name -- ^ The type for which Lift is being derived
- -> TcRnMessage
-
deriving Generic
----
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b0dfc20280180473b05b70892f2ad…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b0dfc20280180473b05b70892f2ad…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/splice-imports-2025] 5 commits: Refactor instances
by Matthew Pickering (＠mpickering) 24 Apr '25
by Matthew Pickering (＠mpickering) 24 Apr '25
24 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
c319ea08 by Matthew Pickering at 2025-04-24T10:43:56+01:00
Refactor instances
- - - - -
e443f033 by Matthew Pickering at 2025-04-24T10:45:07+01:00
Add support for ghc-debug to ghc executable
- - - - -
b434257a by Matthew Pickering at 2025-04-24T15:02:19+01:00
fixes
- - - - -
a676a4fa by Matthew Pickering at 2025-04-24T15:02:32+01:00
Revert "Add support for ghc-debug to ghc executable"
This reverts commit e443f0336b5497125d1e882255f515c84464cf59.
- - - - -
c54ecffa by Matthew Pickering at 2025-04-24T15:20:25+01:00
Add a proper error for trying to derive Lift instance
- - - - -
9 changed files:
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Error/Codes.hs
- testsuite/tests/splice-imports/SI14.stderr
- testsuite/tests/splice-imports/SI15.stderr
Changes:
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -245,10 +245,14 @@ downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
-- | Construct a module graph starting from the interactive context.
-- Produces, a thunk, which when forced will perform the downsweep.
-- This graph contains the current interactive module, and its dependencies.
-
+--
+-- Invariant: The hsc_mod_graph already contains the relevant home modules which
+-- might be imported by the interactive imports.
+--
-- This is a first approximation for this function.
downsweepInteractiveImports :: HscEnv -> InteractiveContext -> IO ModuleGraph
downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
+ debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
let imps = ic_imports (hsc_IC hsc_env)
let mn = icInteractiveModule ic
@@ -256,9 +260,11 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
let key = moduleToMnk mn NotBoot
let node_type = ModuleNodeFixed key ml
+ let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
+
let edges = map mkEdge imps
let env = DownsweepEnv hsc_env DownsweepUseCompile mempty []
- (module_edges, graph, _) <- runDownsweepM env $ loopImports edges M.empty Map.empty
+ (module_edges, graph) <- runDownsweepM env $ loopFromInteractive edges cached_nodes
let node = ModuleNode module_edges node_type
let all_nodes = M.elems graph
@@ -282,6 +288,36 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
unitId = homeUnitId $ hsc_home_unit hsc_env
in (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot)
+loopFromInteractive :: [(UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]
+ -> M.Map NodeKey ModuleGraphNode
+ -> DownsweepM ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
+loopFromInteractive [] cached_nodes = return ([], cached_nodes)
+loopFromInteractive (edge:edges) cached_nodes = do
+ hsc_env <- asks downsweep_hsc_env
+ let (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) = edge
+ let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
+ let k _ loc mod =
+ let key = moduleToMnk mod is_boot
+ in return $ FoundHome (ModuleNodeFixed key loc)
+ found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg []
+ case found of
+ -- Case 1: Home modules have to already be in the cache.
+ FoundHome (ModuleNodeFixed mod _) -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
+ (edges, cached_nodes') <- loopFromInteractive edges cached_nodes
+ return (edge : edges, cached_nodes')
+ -- Case 2: External units may not be in the cache, if we haven't already initialised the
+ -- module graph.
+ External uid -> do
+ let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
+ cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
+ edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
+ (edges, cached_nodes') <- loopFromInteractive edges cached_nodes'
+ return (edge : edges, cached_nodes')
+ -- And if it's not found.. just carry on and hope.
+ _ -> loopFromInteractive edges cached_nodes
+
+
-- | Create a module graph from a list of installed modules.
-- This is used by the loader when we need to load modules but there
-- isn't already an existing module graph. For example, when loading plugins
=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -927,6 +927,7 @@ stockSideConditions deriv_ctxt cls
cond_vanilla `andCond`
cond_Representable1Ok)
| sameUnique cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond`
+ checkFlag LangExt.ImplicitStagePersistence `andCond`
cond_vanilla `andCond`
cond_args cls)
| otherwise = Nothing
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -2035,6 +2035,10 @@ instance Diagnostic TcRnMessage where
TcRnUnexpectedTypeSyntaxInTerms syntax -> mkSimpleDecorated $
text "Unexpected" <+> pprTypeSyntaxName syntax
+ TcRnDeriveLiftWithoutImplicitStagePersistence{}
+ -> mkSimpleDecorated $
+ text "Deriving Lift is not possible when ImplicitStagePersistence is disabled."
+
diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
TcRnUnknownMessage m
@@ -2685,6 +2689,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnUnexpectedTypeSyntaxInTerms{}
-> ErrorWithoutFlag
+ TcRnDeriveLiftWithoutImplicitStagePersistence{}
+ -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -3374,6 +3380,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnUnexpectedTypeSyntaxInTerms syntax
-> [suggestExtension (typeSyntaxExtension syntax)]
+ TcRnDeriveLiftWithoutImplicitStagePersistence{}
+ -> noHints
diagnosticCode = constructorCode @GHC
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -4453,6 +4453,17 @@ data TcRnMessage where
Test cases: T24159_type_syntax_rn_fail
-}
TcRnUnexpectedTypeSyntaxInTerms :: TypeSyntax -> TcRnMessage
+
+ {-| TcRnDeriveLiftWithoutImplicitStagePersistence is an error indicating that
+ someone tried to derive a Lift instance when ImplicitStagePersistence is enabled.
+
+
+ Test cases:
+ None yet
+ -}
+ TcRnDeriveLiftWithoutImplicitStagePersistence :: !Name -- ^ The type for which Lift is being derived
+ -> TcRnMessage
+
deriving Generic
----
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -194,6 +194,8 @@ import GHC.Types.Var.Set
import GHC.Types.Unique.Supply
import GHC.Types.Unique.Set( elementOfUniqSet )
import GHC.Types.Id
+import GHC.Types.Basic (allImportLevels)
+import GHC.Types.ThLevelIndex (thLevelIndexFromImportLevel)
import GHC.Unit.Module
import qualified GHC.Rename.Env as TcM
@@ -1642,40 +1644,51 @@ checkCrossLevelClsInst dflags reason bind_lvls use_lvl_idx is_local
checkWellLevelledInstanceWhat :: HasCallStack => InstanceWhat -> TcS (Maybe (Set.Set ThLevelIndex, Bool))
checkWellLevelledInstanceWhat what
| TopLevInstance { iw_dfun_id = dfun_id } <- what
- = do
- -- MP: I am not sure if we have to only do this check for orphan instances.
- cur_mod <- extractModule <$> getGblEnv
- if nameIsLocalOrFrom cur_mod (idName dfun_id)
- then return $ Just ( (Set.singleton topLevelIndex, True) )
- else do
- hsc_env <- getTopEnv
- let q = mgQueryZero (hsc_mod_graph hsc_env)
- let mkKey s m = (Left (ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m), s))
- let scope_key s = mkKey s cur_mod
- let lkup :: ImportLevel -> Either (ModNodeKeyWithUid, ImportLevel) UnitId -> Bool
- lkup s k = q (scope_key s) k
- let splice_lvl = lkup SpliceLevel
- normal_lvl = lkup NormalLevel
- quote_lvl = lkup QuoteLevel
-
- name_module = nameModule (idName dfun_id)
- instance_key = if moduleUnitId name_module `Set.member` hsc_all_home_unit_ids hsc_env
- then (mkKey NormalLevel name_module)
- else Right (moduleUnitId name_module)
- let lvls = [ spliceLevelIndex | splice_lvl instance_key]
- ++ [ topLevelIndex | normal_lvl instance_key]
- ++ [ quoteLevelIndex | quote_lvl instance_key]
- return $ Just ( Set.fromList lvls, False )
-
+ = Just <$> checkNameVisibleLevels (idName dfun_id)
| BuiltinTypeableInstance tc <- what
- = do
- cur_mod <- extractModule <$> getGblEnv
- return $ Just (if nameIsLocalOrFrom cur_mod (tyConName tc)
- then (Set.singleton topLevelIndex, True)
- -- TODO, not correct, needs similar checks to normal instances
- else (Set.fromList [spliceLevelIndex, topLevelIndex], False))
+ -- The typeable instance is always defined in the same module as the TyCon.
+ = Just <$> checkNameVisibleLevels (tyConName tc)
| otherwise = return Nothing
+-- | Check the levels at which the given name is visible, including a boolean
+-- indicating if the name is local or not.
+checkNameVisibleLevels :: Name -> TcS (Set.Set ThLevelIndex, Bool)
+checkNameVisibleLevels name = do
+ cur_mod <- extractModule <$> getGblEnv
+ if nameIsLocalOrFrom cur_mod name
+ then return (Set.singleton topLevelIndex, True)
+ else do
+ lvls <- checkModuleVisibleLevels (nameModule name)
+ return (lvls, False)
+
+-- | This function checks which levels the given module is visible at.
+-- It does this by querying the module graph, hence it is suitable for usage
+-- in instance checking, where the reason an instance is brought into scope is
+-- implicit.
+checkModuleVisibleLevels :: Module -> TcS (Set.Set ThLevelIndex)
+checkModuleVisibleLevels check_mod = do
+ cur_mod <- extractModule <$> getGblEnv
+ hsc_env <- getTopEnv
+
+ -- 0. The keys for the scope of the current module.
+ let mkKey s m = (Left (moduleToMnk m NotBoot, s))
+ cur_mod_scope_key s = mkKey s cur_mod
+
+ -- 1. is_visible checks that a specific key is visible from the given level in the
+ -- current module.
+ let is_visible :: ImportLevel -> Either (ModNodeKeyWithUid, ImportLevel) UnitId -> Bool
+ is_visible s k = mgQueryZero (hsc_mod_graph hsc_env) (cur_mod_scope_key s) k
+
+ -- 2. The key we are looking for, either the module itself in the home package or the
+ -- module unit id of the module we are checking.
+ let instance_key = if moduleUnitId check_mod `Set.member` hsc_all_home_unit_ids hsc_env
+ then mkKey NormalLevel check_mod
+ else Right (moduleUnitId check_mod)
+
+ -- 3. For each level, check if the key is visible from that level.
+ let lvls = [ thLevelIndexFromImportLevel lvl | lvl <- allImportLevels, is_visible lvl instance_key]
+ return $ Set.fromList lvls
+
{-
Note [Well-levelled instance evidence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -123,7 +123,7 @@ module GHC.Types.Basic (
ForeignSrcLang (..),
- ImportLevel(..), convImportLevel, convImportLevelSpec,
+ ImportLevel(..), convImportLevel, convImportLevelSpec, allImportLevels
) where
import GHC.Prelude
@@ -2442,7 +2442,7 @@ instance Outputable DefaultingStrategy where
-- | ImportLevel
-data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (Eq, Ord, Data, Show, Enum)
+data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (Eq, Ord, Data, Show, Enum, Bounded)
instance Outputable ImportLevel where
ppr NormalLevel = text "normal"
@@ -2451,6 +2451,9 @@ instance Outputable ImportLevel where
deriving via (EnumBinary ImportLevel) instance Binary ImportLevel
+allImportLevels :: [ImportLevel]
+allImportLevels = [minBound..maxBound]
+
convImportLevel :: ImportDeclLevelStyle -> ImportLevel
convImportLevel (LevelStylePre level) = convImportLevelSpec level
convImportLevel (LevelStylePost level) = convImportLevelSpec level
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -700,6 +700,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIllegalTypeExpr" = 35499
GhcDiagnosticCode "TcRnUnexpectedTypeSyntaxInTerms" = 31244
GhcDiagnosticCode "TcRnTypeApplicationsDisabled" = 23482
+ GhcDiagnosticCode "TcRnDeriveLiftWithoutImplicitStagePersistence" = 87906
-- TcRnIllegalInvisibleTypePattern
GhcDiagnosticCode "InvisPatWithoutFlag" = 78249
=====================================
testsuite/tests/splice-imports/SI14.stderr
=====================================
@@ -1,12 +1,5 @@
-SI14.hs:9:21: error: [GHC-28914]
- • Level error: ‘A’ is bound at level 0 but used at level 1
- Hint: quoting [| A |] or an enclosing expression
- would allow the quotation to be used at an earlier level
- • In the Template Haskell quotation: 'A
-
-SI14.hs:9:21: error: [GHC-28914]
- • Level error: ‘A’ is bound at level 0 but used at level 1
- Hint: quoting [| A |] or an enclosing expression
- would allow the quotation to be used at an earlier level
- • In the Template Haskell quotation: 'A
+SI14.hs:9:21: error: [GHC-86639]
+ • Can't make a derived instance of ‘Lift A’:
+ You need ImplicitStagePersistence to derive an instance for this class
+ • In the data type declaration for ‘A’
=====================================
testsuite/tests/splice-imports/SI15.stderr
=====================================
@@ -1,12 +1,5 @@
-SI15.hs:9:21: error: [GHC-28914]
- • Level error: ‘A’ is bound at level 0 but used at level 1
- Hint: quoting [| A |] or an enclosing expression
- would allow the quotation to be used at an earlier level
- • In the Template Haskell quotation: 'A
-
-SI15.hs:9:21: error: [GHC-28914]
- • Level error: ‘A’ is bound at level 0 but used at level 1
- Hint: quoting [| A |] or an enclosing expression
- would allow the quotation to be used at an earlier level
- • In the Template Haskell quotation: 'A
+SI15.hs:9:21: error: [GHC-86639]
+ • Can't make a derived instance of ‘Lift A’:
+ You need ImplicitStagePersistence to derive an instance for this class
+ • In the data type declaration for ‘A’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0aac7dcc195371d7ce82eac0f10d42…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0aac7dcc195371d7ce82eac0f10d42…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Apr '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1bd3d13e by fendor at 2025-04-24T07:35:17-04:00
Add `UnitId` to `EvalBreakpoint`
The `EvalBreakpoint` is used to communicate that a breakpoint was
encountered during code evaluation.
This `EvalBreakpoint` needs to be converted to an `InternalBreakpointId`
which stores a `Module` to uniquely find the correct `Module` in the
Home Package Table.
The `EvalBreakpoint` used to store only a `ModuleName` which is then
converted to a `Module` based on the currently active home unit.
This is incorrect in the face of multiple home units, the break point
could be in an entirely other home unit!
To fix this, we additionally store the `UnitId` of the `Module` in
`EvalBreakpoint` to later reconstruct the correct `Module`
All of the changes are the consequence of extending `EvalBreakpoint`
with the additional `ShortByteString` of the `UnitId`.
For performance reasons, we store the `ShortByteString` backing the
`UnitId` directly, avoiding marshalling overhead.
- - - - -
11 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Exception.cmm
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -732,13 +732,16 @@ assembleI platform i = case i of
CCALL off m_addr i -> do np <- addr m_addr
emit_ bci_CCALL [wOp off, Op np, SmallOp i]
PRIMCALL -> emit_ bci_PRIMCALL []
- BRK_FUN arr tick_mod tickx info_mod infox cc ->
+ BRK_FUN arr tick_mod tick_mod_id tickx info_mod info_mod_id infox cc ->
do p1 <- ptr (BCOPtrBreakArray arr)
tick_addr <- addr tick_mod
+ tick_unitid_addr <- addr tick_mod_id
info_addr <- addr info_mod
+ info_unitid_addr <- addr info_mod_id
np <- addr cc
emit_ bci_BRK_FUN [ Op p1
, Op tick_addr, Op info_addr
+ , Op tick_unitid_addr, Op info_unitid_addr
, SmallOp tickx, SmallOp infox
, Op np
]
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -37,6 +37,7 @@ import GHC.Stg.Syntax
import GHCi.BreakArray (BreakArray)
import Language.Haskell.Syntax.Module.Name (ModuleName)
import GHC.Types.Unique
+import GHC.Unit.Types (UnitId)
-- ----------------------------------------------------------------------------
-- Bytecode instructions
@@ -233,8 +234,10 @@ data BCInstr
-- Breakpoints
| BRK_FUN (ForeignRef BreakArray)
(RemotePtr ModuleName) -- breakpoint tick module
+ (RemotePtr UnitId) -- breakpoint tick module unit id
!Word16 -- breakpoint tick index
(RemotePtr ModuleName) -- breakpoint info module
+ (RemotePtr UnitId) -- breakpoint info module unit id
!Word16 -- breakpoint info index
(RemotePtr CostCentre)
@@ -403,10 +406,10 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN _ _tick_mod tickx _info_mod infox _)
+ ppr (BRK_FUN _ _tick_mod _tick_mod_id tickx _info_mod _info_mod_id infox _)
= text "BRK_FUN" <+> text "<breakarray>"
- <+> text "<tick_module>" <+> ppr tickx
- <+> text "<info_module>" <+> ppr infox
+ <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
+ <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
<+> text "<cc>"
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -50,6 +50,7 @@ import GHC.Stack.CCS
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
import GHC.Iface.Syntax
import Language.Haskell.Syntax.Module.Name (ModuleName)
+import GHC.Unit.Types (UnitId)
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
@@ -263,6 +264,9 @@ data ModBreaks
, modBreaks_breakInfo :: IntMap CgBreakInfo
-- ^ info about each breakpoint from the bytecode generator
, modBreaks_module :: RemotePtr ModuleName
+ -- ^ info about the module in which we are setting the breakpoint
+ , modBreaks_module_unitid :: RemotePtr UnitId
+ -- ^ The 'UnitId' of the 'ModuleName'
}
seqModBreaks :: ModBreaks -> ()
@@ -273,7 +277,8 @@ seqModBreaks ModBreaks{..} =
rnf modBreaks_decls `seq`
rnf modBreaks_ccs `seq`
rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
- rnf modBreaks_module
+ rnf modBreaks_module `seq`
+ rnf modBreaks_module_unitid
-- | Construct an empty ModBreaks
emptyModBreaks :: ModBreaks
@@ -286,6 +291,7 @@ emptyModBreaks = ModBreaks
, modBreaks_ccs = array (0,-1) []
, modBreaks_breakInfo = IntMap.empty
, modBreaks_module = toRemotePtr nullPtr
+ , modBreaks_module_unitid = toRemotePtr nullPtr
}
{-
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -34,7 +34,7 @@ mkModBreaks interp mod extendedMixEntries
breakArray <- GHCi.newBreakArray interp count
ccs <- mkCCSArray interp mod count entries
- mod_ptr <- GHCi.newModuleName interp (moduleName mod)
+ (mod_ptr, mod_id_ptr) <- GHCi.newModule interp mod
let
locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
@@ -46,6 +46,7 @@ mkModBreaks interp mod extendedMixEntries
, modBreaks_decls = declsTicks
, modBreaks_ccs = ccs
, modBreaks_module = mod_ptr
+ , modBreaks_module_unitid = mod_id_ptr
}
mkCCSArray
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -345,7 +345,7 @@ handleRunStatus step expr bindings final_ids status history0 = do
-- Just case: we stopped at a breakpoint
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
- ibi <- liftIO $ evalBreakpointToId (hsc_HPT hsc_env) eval_break
+ let ibi = evalBreakpointToId eval_break
tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi)
let
span = modBreaks_locs tick_brks ! ibi_tick_index ibi
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -21,7 +21,7 @@ module GHC.Runtime.Interpreter
, mkCostCentres
, costCentreStackInfo
, newBreakArray
- , newModuleName
+ , newModule
, storeBreakpoint
, breakpointStatus
, getBreakpointVar
@@ -93,9 +93,8 @@ import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe)
import GHC.Utils.Fingerprint
import GHC.Unit.Module
-import GHC.Unit.Module.ModIface
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.PackageTable
+import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -377,9 +376,13 @@ newBreakArray interp size = do
breakArray <- interpCmd interp (NewBreakArray size)
mkFinalizedHValue interp breakArray
-newModuleName :: Interp -> ModuleName -> IO (RemotePtr ModuleName)
-newModuleName interp mod_name =
- castRemotePtr <$> interpCmd interp (NewBreakModule (moduleNameString mod_name))
+newModule :: Interp -> Module -> IO (RemotePtr ModuleName, RemotePtr UnitId)
+newModule interp mod = do
+ let
+ mod_name = moduleNameString $ moduleName mod
+ mod_id = fastStringToShortByteString $ unitIdFS $ toUnitId $ moduleUnit mod
+ (mod_ptr, mod_id_ptr) <- interpCmd interp (NewBreakModule mod_name mod_id)
+ pure (castRemotePtr mod_ptr, castRemotePtr mod_id_ptr)
storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
storeBreakpoint interp ref ix cnt = do -- #19157
@@ -415,19 +418,21 @@ seqHValue interp unit_env ref =
status <- interpCmd interp (Seq hval)
handleSeqHValueStatus interp unit_env status
-evalBreakpointToId :: HomePackageTable -> EvalBreakpoint -> IO InternalBreakpointId
-evalBreakpointToId hpt eval_break =
- let load_mod x = mi_module . hm_iface . expectJust <$> lookupHpt hpt (mkModuleName x)
- in do
- tickl <- load_mod (eb_tick_mod eval_break)
- infol <- load_mod (eb_info_mod eval_break)
- return
- InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
- , ibi_info_index = eb_info_index eval_break
- }
+evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
+evalBreakpointToId eval_break =
+ let
+ mkUnitId u = fsToUnit $ mkFastStringShortByteString u
+
+ toModule u n = mkModule (mkUnitId u) (mkModuleName n)
+ tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
+ infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
+ in
+ InternalBreakpointId
+ { ibi_tick_mod = tickl
+ , ibi_tick_index = eb_tick_index eval_break
+ , ibi_info_mod = infol
+ , ibi_info_index = eb_info_index eval_break
+ }
-- | Process the result of a Seq or ResumeSeq message. #2950
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
@@ -447,12 +452,12 @@ handleSeqHValueStatus interp unit_env eval_status =
mkGeneralSrcSpan (fsLit "<unknown>")
Just break -> do
- bi <- evalBreakpointToId (ue_hpt unit_env) break
+ let bi = evalBreakpointToId break
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
breaks_tick <- getModBreaks . expectJust <$>
- lookupHpt (ue_hpt unit_env) (moduleName (ibi_tick_mod bi))
+ lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
put $ brackets . ppr $
(modBreaks_locs breaks_tick) ! ibi_tick_index bi
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -416,7 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
Nothing -> pure code
Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
Nothing -> pure code
- Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_ccs = cc_arr} -> do
+ Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_module_unitid = tick_mod_id_ptr, modBreaks_ccs = cc_arr} -> do
platform <- profilePlatform <$> getProfile
let idOffSets = getVarOffSets platform d p fvs
ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
@@ -425,6 +425,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
let info_mod_ptr = modBreaks_module current_mod_breaks
+ info_mod_id_ptr = modBreaks_module_unitid current_mod_breaks
infox <- newBreakInfo breakInfo
let cc | Just interp <- hsc_interp hsc_env
@@ -437,7 +438,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- breakInstr = BRK_FUN breaks tick_mod_ptr (toW16 tick_no) info_mod_ptr (toW16 infox) cc
+ breakInstr = BRK_FUN breaks tick_mod_ptr tick_mod_id_ptr (toW16 tick_no) info_mod_ptr info_mod_id_ptr (toW16 infox) cc
return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -23,6 +23,7 @@ module GHCi.Message
, getMessage, putMessage, getTHMessage, putTHMessage
, Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe
, BreakModule
+ , BreakUnitId
, LoadedDLL
) where
@@ -51,6 +52,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as BS
import Data.Dynamic
import Data.Typeable (TypeRep)
import Data.IORef
@@ -245,8 +247,9 @@ data Message a where
-- | Allocate a string for a breakpoint module name.
-- This uses an empty dummy type because @ModuleName@ isn't available here.
NewBreakModule
- :: String
- -> Message (RemotePtr BreakModule)
+ :: String -- ^ @ModuleName@
+ -> BS.ShortByteString -- ^ @UnitId@ for the given @ModuleName@
+ -> Message (RemotePtr BreakModule, RemotePtr BreakUnitId)
deriving instance Show (Message a)
@@ -410,10 +413,12 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
- , eb_info_index :: Int -- ^ Breakpoint info index
+ { eb_tick_mod :: String -- ^ Breakpoint tick module
+ , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
+ , eb_tick_index :: Int -- ^ Breakpoint tick index
+ , eb_info_mod :: String -- ^ Breakpoint info module
+ , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
+ , eb_info_index :: Int -- ^ Breakpoint info index
}
deriving (Generic, Show)
@@ -430,6 +435,10 @@ instance Binary a => Binary (EvalResult a)
-- that type isn't available here.
data BreakModule
+-- | A dummy type that tags the pointer to a breakpoint's @UnitId@, because
+-- that type isn't available here.
+data BreakUnitId
+
-- | A dummy type that tags pointers returned by 'LoadDLL'.
data LoadedDLL
@@ -580,7 +589,7 @@ getMessage = do
36 -> Msg <$> (Seq <$> get)
37 -> Msg <$> return RtsRevertCAFs
38 -> Msg <$> (ResumeSeq <$> get)
- 39 -> Msg <$> (NewBreakModule <$> get)
+ 39 -> Msg <$> (NewBreakModule <$> get <*> get)
40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
41 -> Msg <$> (WhereFrom <$> get)
_ -> error $ "Unknown Message code " ++ (show b)
@@ -627,7 +636,7 @@ putMessage m = case m of
Seq a -> putWord8 36 >> put a
RtsRevertCAFs -> putWord8 37
ResumeSeq a -> putWord8 38 >> put a
- NewBreakModule name -> putWord8 39 >> put name
+ NewBreakModule name unitid -> putWord8 39 >> put name >> put unitid
LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str
WhereFrom a -> putWord8 41 >> put a
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -33,6 +33,7 @@ import Control.DeepSeq
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
+import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Unsafe as B
import GHC.Exts
import qualified GHC.Exts.Heap as Heap
@@ -95,7 +96,10 @@ run m = case m of
MkCostCentres mod ccs -> mkCostCentres mod ccs
CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr)
NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz
- NewBreakModule name -> newModuleName name
+ NewBreakModule name unitid -> do
+ namePtr <- newModuleName name
+ uidPtr <- newUnitId unitid
+ pure (namePtr, uidPtr)
SetupBreakpoint ref ix cnt -> do
arr <- localRef ref;
_ <- setupBreakpoint arr ix cnt
@@ -335,7 +339,7 @@ withBreakAction opts breakMVar statusMVar act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tickx# info_mod# infox# is_exception apStack = do
+ onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -349,8 +353,10 @@ withBreakAction opts breakMVar statusMVar act
then pure Nothing
else do
tick_mod <- peekCString (Ptr tick_mod#)
+ tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
- pure (Just (EvalBreakpoint tick_mod (I# tickx#) info_mod (I# infox#)))
+ info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
+ pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -400,8 +406,10 @@ resetStepFlag = poke stepFlag 0
type BreakpointCallback
= Addr# -- pointer to the breakpoint tick module name
+ -> Addr# -- pointer to the breakpoint tick module unit id
-> Int# -- breakpoint tick index
-> Addr# -- pointer to the breakpoint info module name
+ -> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
-> HValue -- the AP_STACK, or exception
@@ -414,8 +422,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
@@ -432,6 +440,13 @@ mkString0 bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do
pokeElemOff (ptr :: Ptr CChar) len 0
return (castRemotePtr (toRemotePtr ptr))
+mkShortByteString0 :: BS.ShortByteString -> IO (RemotePtr ())
+mkShortByteString0 bs = BS.useAsCStringLen bs $ \(cstr,len) -> do
+ ptr <- mallocBytes (len+1)
+ copyBytes ptr cstr len
+ pokeElemOff (ptr :: Ptr CChar) len 0
+ return (castRemotePtr (toRemotePtr ptr))
+
mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]
#if defined(PROFILING)
mkCostCentres mod ccs = do
@@ -453,6 +468,10 @@ newModuleName :: String -> IO (RemotePtr BreakModule)
newModuleName name =
castRemotePtr . toRemotePtr <$> newCString name
+newUnitId :: BS.ShortByteString -> IO (RemotePtr BreakUnitId)
+newUnitId name =
+ castRemotePtr <$> mkShortByteString0 name
+
getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
getIdValFromApStack apStack (I# stackDepth) = do
case getApStackVal# apStack stackDepth of
=====================================
rts/Exception.cmm
=====================================
@@ -535,12 +535,16 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(13);
- Sp(12) = exception;
- Sp(11) = stg_raise_ret_info;
- Sp(10) = exception;
- Sp(9) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(8) = stg_ap_ppv_info;
+ Sp = Sp - WDS(17);
+ Sp(16) = exception;
+ Sp(15) = stg_raise_ret_info;
+ Sp(14) = exception;
+ Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(12) = stg_ap_ppv_info;
+ Sp(11) = 0;
+ Sp(10) = stg_ap_n_info;
+ Sp(9) = 0;
+ Sp(8) = stg_ap_n_info;
Sp(7) = 0;
Sp(6) = stg_ap_n_info;
Sp(5) = 0;
=====================================
rts/Interpreter.c
=====================================
@@ -1245,9 +1245,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_index, arg5_info_index;
+ int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
#if defined(PROFILING)
- int arg6_cc;
+ int arg8_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break;
@@ -1264,10 +1264,12 @@ run_BCO:
arg1_brk_array = BCO_GET_LARGE_ARG;
arg2_tick_mod = BCO_GET_LARGE_ARG;
arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_index = BCO_NEXT;
- arg5_info_index = BCO_NEXT;
+ arg4_tick_mod_id = BCO_GET_LARGE_ARG;
+ arg5_info_mod_id = BCO_GET_LARGE_ARG;
+ arg6_tick_index = BCO_NEXT;
+ arg7_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg6_cc = BCO_GET_LARGE_ARG;
+ arg8_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1280,7 +1282,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg6_cc));
+ (CostCentre*)BCO_LIT(arg8_cc));
#endif
// if we are returning from a break then skip this section
@@ -1292,11 +1294,11 @@ run_BCO:
// stop the current thread if either the
// "rts_stop_next_breakpoint" flag is true OR if the
// ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
if (rts_stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg4_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
}
else if (rts_stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1330,8 +1332,10 @@ run_BCO:
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint tick module
+ // -> Addr# -- the breakpoint tick module unit id
// -> Int# -- the breakpoint tick index
// -> Addr# -- the breakpoint info module
+ // -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
// -> HValue -- the AP_STACK, or exception
@@ -1340,17 +1344,21 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(15);
- SpW(14) = (W_)obj;
- SpW(13) = (W_)&stg_apply_interp_info;
- SpW(12) = (W_)new_aps;
- SpW(11) = (W_)False_closure; // True <=> an exception
- SpW(10) = (W_)&stg_ap_ppv_info;
- SpW(9) = (W_)arg5_info_index;
+ Sp_subW(19);
+ SpW(18) = (W_)obj;
+ SpW(17) = (W_)&stg_apply_interp_info;
+ SpW(16) = (W_)new_aps;
+ SpW(15) = (W_)False_closure; // True <=> an exception
+ SpW(14) = (W_)&stg_ap_ppv_info;
+ SpW(13) = (W_)arg7_info_index;
+ SpW(12) = (W_)&stg_ap_n_info;
+ SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
+ SpW(10) = (W_)&stg_ap_n_info;
+ SpW(9) = (W_)BCO_LIT(arg3_info_mod);
SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)BCO_LIT(arg3_info_mod);
+ SpW(7) = (W_)arg6_tick_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)arg4_tick_index;
+ SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
SpW(2) = (W_)&stg_ap_n_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bd3d13eea53f1afdeb98caacf2b9b8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bd3d13eea53f1afdeb98caacf2b9b8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] RV64: Introduce J instruction (non-local jumps) and don't deallocate stack slots for J_TBL (#25738)
by Marge Bot (＠marge-bot) 24 Apr '25
by Marge Bot (＠marge-bot) 24 Apr '25
24 Apr '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0eef99b0 by Sven Tennie at 2025-04-24T07:34:36-04:00
RV64: Introduce J instruction (non-local jumps) and don't deallocate stack slots for J_TBL (#25738)
J_TBL result in local jumps, there should not deallocate stack slots
(see Note [extra spill slots].)
J is for non-local jumps, these may need to deallocate stack slots.
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1481,7 +1481,7 @@ assignReg_FltCode = assignReg_IntCode
genJump :: CmmExpr {-the branch target-} -> NatM InstrBlock
genJump expr = do
(target, _format, code) <- getSomeReg expr
- return (code `appOL` unitOL (annExpr expr (B (TReg target))))
+ return (code `appOL` unitOL (annExpr expr (J (TReg target))))
-- -----------------------------------------------------------------------------
-- Unconditional branches
@@ -2226,5 +2226,6 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
BCOND {} -> long_bc_jump_size
B (TBlock _) -> long_b_jump_size
B (TReg _) -> 1
+ J op -> instr_size (B op)
BL _ _ -> 1
J_TBL {} -> 1
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -97,6 +97,7 @@ regUsageOfInstr platform instr = case instr of
ORI dst src1 _ -> usage (regOp src1, regOp dst)
XORI dst src1 _ -> usage (regOp src1, regOp dst)
J_TBL _ _ t -> usage ([t], [])
+ J t -> usage (regTarget t, [])
B t -> usage (regTarget t, [])
BCOND _ l r t -> usage (regTarget t ++ regOp l ++ regOp r, [])
BL t ps -> usage (t : ps, callerSavedRegisters)
@@ -195,6 +196,7 @@ patchRegsOfInstr instr env = case instr of
ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3)
XORI o1 o2 o3 -> XORI (patchOp o1) (patchOp o2) (patchOp o3)
J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t)
+ J t -> J (patchTarget t)
B t -> B (patchTarget t)
BL t ps -> BL (patchReg t) ps
BCOND c o1 o2 t -> BCOND c (patchOp o1) (patchOp o2) (patchTarget t)
@@ -235,6 +237,7 @@ isJumpishInstr :: Instr -> Bool
isJumpishInstr instr = case instr of
ANN _ i -> isJumpishInstr i
J_TBL {} -> True
+ J {} -> True
B {} -> True
BL {} -> True
BCOND {} -> True
@@ -243,6 +246,7 @@ isJumpishInstr instr = case instr of
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo insn bid =
case insn of
+ J (TBlock target) -> bid == target
B (TBlock target) -> bid == target
BCOND _ _ _ (TBlock target) -> bid == target
J_TBL targets _ _ -> all isTargetBid targets
@@ -256,6 +260,7 @@ canFallthroughTo insn bid =
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (BCOND _ _ _ t) = [id | TBlock id <- [t]]
jumpDestsOfInstr _ = []
@@ -269,6 +274,7 @@ patchJumpInstr instr patchF =
case instr of
ANN d i -> ANN d (patchJumpInstr i patchF)
J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
+ J (TBlock bid) -> J (TBlock (patchF bid))
B (TBlock bid) -> B (TBlock (patchF bid))
BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid))
_ -> panic $ "patchJumpInstr: " ++ instrCon instr
@@ -475,7 +481,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
block' = foldr insert_dealloc [] insns
insert_dealloc insn r = case insn of
- J_TBL {} -> dealloc ++ (insn : r)
+ J {} -> dealloc ++ (insn : r)
ANN _ e -> insert_dealloc e r
_other
| jumpDestsOfInstr insn /= [] ->
@@ -591,6 +597,8 @@ data Instr
--
-- @if(o2 cond o3) op <- 1 else op <- 0@
CSET Operand Operand Operand Cond
+ -- | Like B, but only used for non-local jumps. Used to distinguish genJumps from others.
+ | J Target
| -- | A jump instruction with data for switch/jump tables
J_TBL [Maybe BlockId] (Maybe CLabel) Reg
| -- | Unconditional jump (no linking)
@@ -663,6 +671,7 @@ instrCon i =
LDRU {} -> "LDRU"
CSET {} -> "CSET"
J_TBL {} -> "J_TBL"
+ J {} -> "J"
B {} -> "B"
BL {} -> "BL"
BCOND {} -> "BCOND"
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -543,6 +543,7 @@ pprInstr platform instr = case instr of
| otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0))
ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3
XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3
+ J o1 -> pprInstr platform (B o1)
J_TBL _ _ r -> pprInstr platform (B (TReg r))
B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
B (TReg r) -> line $ text "\tjalr" <+> pprOp platform x0 <> comma <+> pprReg W64 r <> comma <+> text "0"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0eef99b07f80f81d463652d11bdc228…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0eef99b07f80f81d463652d11bdc228…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Apr '25
Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC
Commits:
ce5db8f6 by Simon Peyton Jones at 2025-04-24T11:39:08+01:00
Tiny change to saves_alloc
Float lambdas (and PAPs) out of lambdas to top level
This improves spectral/cse
But the old comment was
-- is_con_app: don't float PAPs to the top; they may well end
-- up getting eta-expanded and re-inlined
-- E.g. f = \x -> (++) ys
-- If we float, then eta-expand we get
-- lvl = (++) ys
-- f = \x \zs -> lvl zs
-- and now we'll inline lvl. Silly.
Let's see what CI says
- - - - -
1 changed file:
- compiler/GHC/Core/Opt/SetLevels.hs
Changes:
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -707,12 +707,12 @@ lvlMFE env strict_ctxt ann_expr
escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env)
-- See Note [Floating to the top]
- is_con_app = isSaturatedConApp expr -- True of literal strings too
+-- is_con_app = isSaturatedConApp expr -- True of literal strings too
saves_alloc = isTopLvl dest_lvl
&& (escapes_value_lam || floatConsts env)
-- Always float allocation out of a value lambda
-- if it gets to top level
- && (not strict_ctxt || is_con_app || is_bot_lam)
+ && (not strict_ctxt || is_hnf || is_bot_lam)
-- is_con_app: don't float PAPs to the top; they may well end
-- up getting eta-expanded and re-inlined
-- E.g. f = \x -> (++) ys
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce5db8f652b48a613e55d0738bcc7aa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce5db8f652b48a613e55d0738bcc7aa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/ghci-multiple-home-units] 22 commits: driver: Use ModuleGraph for oneshot and --make mode
by Hannes Siebenhandl (＠fendor) 24 Apr '25
by Hannes Siebenhandl (＠fendor) 24 Apr '25
24 Apr '25
Hannes Siebenhandl pushed to branch wip/fendor/ghci-multiple-home-units at Glasgow Haskell Compiler / GHC
Commits:
d47bf776 by Matthew Pickering at 2025-04-14T16:44:41+01:00
driver: Use ModuleGraph for oneshot and --make mode
This patch uses the `hsc_mod_graph` field for both oneshot and --make
mode. Therefore, if part of the compiler requires usage of the module
graph, you do so in a uniform way for the two different modes.
The `ModuleGraph` describes the relationship between the modules in the
home package and units in external packages. The `ModuleGraph` can be
queried when information about the transitive closure of a package is
needed. For example, the primary use of the ModuleGraph from within the
compiler is in the loader, which needs to know the transitive closure of
a module so it can load all the relevant objects for evaluation.
In --make mode, downsweep computes the ModuleGraph before any
compilation starts.
In oneshot mode, a thunk is created at the start of compilation, which
when forced will compute the module graph beneath the current module.
The thunk is only forced at the moment when the user uses Template
Haskell.
Finally, there are some situations where we need to discover what
dependencies to load but haven't loaded a module graph at all. In this
case, there is a fallback which computes the transitive closure on the
fly and doesn't cache the result. Presumably if you are going to call
getLinkDeps a lot, you would compute the right ModuleGraph before you
started.
Importantly, this removes the ExternalModuleGraph abstraction. This was quite
awkward to work with since it stored information about the home package
inside the EPS.
This patch will also be very useful when implementing explicit level
imports, which requires more significant use of the module graph in
order to determine which level instances are available at.
Towards #25795
-------------------------
Metric Decrease:
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
-------------------------
- - - - -
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
e0f3ff11 by Patrick at 2025-04-17T04:31:12-04:00
Refactor Handling of Multiple Default Declarations
Fixes: #25912, #25914, #25934
Previously, GHC discarded all loaded defaults (tcg_default) when local
defaults were encountered during typechecking. According to the
exportable-named-default proposal (sections 2.4.2 and 2.4.3), local
defaults should be merged into tcg_default, retaining any defaults
already present while overriding where necessary.
Key Changes:
* Introduce DefaultProvenance to track the origin of default declarations
(local, imported, or built-in), replacing the original cd_module
in ClassDefaults with cd_provenance :: DefaultProvenance.
* Rename tcDefaults to tcDefaultDecls, limiting its responsibility to only
converting renamed class defaults into ClassDefaults.
* Add extendDefaultEnvWithLocalDefaults to merge local defaults into the
environment, with proper duplication checks:
- Duplicate local defaults for a class trigger an error.
- Local defaults override imported or built-in defaults.
* Update and add related notes: Note [Builtin class defaults],
Note [DefaultProvenance].
* Add regression tests: T25912, T25914, T25934.
Thanks sam and simon for the help on this patch.
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
- - - - -
386f1854 by Teo Camarasu at 2025-04-17T04:31:55-04:00
template-haskell: Remove `addrToByteArrayName` and `addrToByteArray`
These were part of the implementation of the `Lift ByteArray` instance and were errornously exported because this module lacked an explicit export list. They have no usages on Hackage.
Resolves #24782
- - - - -
b96e2f77 by Sylvain Henry at 2025-04-18T20:46:33-04:00
RTS: remove target info and fix host info (#24058)
The RTS isn't a compiler, hence it doesn't have a target and we remove
the reported target info displayed by "+RTS --info". We also fix the
host info displayed by "+RTS --info": the host of the RTS is the
RTS-building compiler's target, not the compiler's host (wrong when
doing cross-compilation).
- - - - -
6d9965f4 by Sylvain Henry at 2025-04-18T20:46:33-04:00
RTS: remove build info
As per the discussion in !13967, there is no reason to tag the RTS with
information about the build platform.
- - - - -
d52e9b3f by Vladislav Zavialov at 2025-04-18T20:47:15-04:00
Diagnostics: remove the KindMismatch constructor (#25957)
The KindMismatch constructor was only used as an intermediate
representation in pretty-printing.
Its removal addresses a problem detected by the "codes" test case:
[GHC-89223] is untested (constructor = KindMismatch)
In a concious deviation from the usual procedure, the error code
GHC-89223 is removed entirely rather than marked as Outdated.
The reason is that it never was user-facing in the first place.
- - - - -
e2f2f9d0 by Vladislav Zavialov at 2025-04-20T10:53:39-04:00
Add name for -Wunusable-unpack-pragmas
This warning had no name or flag and was triggered unconditionally.
Now it is part of -Wdefault.
In GHC.Tc.TyCl.tcTyClGroupsPass's strict mode, we now have to
force-enable this warning to ensure that detection of flawed groups
continues to work even if the user disables the warning with the
-Wno-unusable-unpack-pragmas option. Test case: T3990c
Also, the misnamed BackpackUnpackAbstractType is now called
UnusableUnpackPragma.
- - - - -
6caa6508 by Adam Gundry at 2025-04-20T10:54:22-04:00
Fix specialisation of incoherent instances (fixes #25883)
GHC normally assumes that class constraints are canonical, meaning that
the specialiser is allowed to replace one dictionary argument with another
provided that they have the same type. The `-fno-specialise-incoherents`
flag alters INCOHERENT instance definitions so that they will prevent
specialisation in some cases, by inserting `nospec`.
This commit fixes a bug in 7124e4ad76d98f1fc246ada4fd7bf64413ff2f2e, which
treated some INCOHERENT instance matches as if `-fno-specialise-incoherents`
was in effect, thereby unnecessarily preventing specialisation. In addition
it updates the relevant `Note [Rules for instance lookup]` and adds a new
`Note [Canonicity for incoherent matches]`.
- - - - -
0426fd6c by Adam Gundry at 2025-04-20T10:54:23-04:00
Add regression test for #23429
- - - - -
eec96527 by Adam Gundry at 2025-04-20T10:54:23-04:00
user's guide: update specification of overlapping/incoherent instances
The description of the instance resolution algorithm in the user's
guide was slightly out of date, because it mentioned in-scope given
constraints only at the end, whereas the implementation checks for
their presence before any of the other steps.
This also adds a warning to the user's guide about the impact of
incoherent instances on specialisation, and more clearly documents
some of the other effects of `-XIncoherentInstances`.
- - - - -
a00eeaec by Matthew Craven at 2025-04-20T10:55:03-04:00
Fix bytecode generation for `tagToEnum# <LITERAL>`
Fixes #25975.
- - - - -
2e204269 by Andreas Klebinger at 2025-04-22T12:20:41+02:00
Simplifier: Constant fold invald tagToEnum# calls to bottom expr.
When applying tagToEnum# to a out-of-range value it's best to simply
constant fold it to a bottom expression. That potentially allows more
dead code elimination and makes debugging easier.
Fixes #25976
- - - - -
7250fc0c by Matthew Pickering at 2025-04-22T16:24:04-04:00
Move -fno-code note into Downsweep module
This note was left behind when all the code which referred to it was
moved into the GHC.Driver.Downsweep module
- - - - -
d2dc89b4 by Matthew Pickering at 2025-04-22T16:24:04-04:00
Apply editing notes to Note [-fno-code mode] suggested by sheaf
These notes were suggested in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/14241
- - - - -
91564daf by Matthew Pickering at 2025-04-24T00:29:02-04:00
ghci: Use loadInterfaceForModule rather than loadSrcInterface in mkTopLevEnv
loadSrcInterface takes a user given `ModuleName` and resolves it to the
module which needs to be loaded (taking into account module
renaming/visibility etc).
loadInterfaceForModule takes a specific module and loads it.
The modules in `ImpDeclSpec` have already been resolved to the actual
module to get the information from during renaming. Therefore we just
need to fetch the precise interface from disk (and not attempt to rename
it again).
Fixes #25951
- - - - -
2e0c07ab by Simon Peyton Jones at 2025-04-24T00:29:43-04:00
Test for #23298
- - - - -
f217392d by fendor at 2025-04-24T10:22:01+02:00
Add `UnitId` to `EvalBreakpoint`
The `EvalBreakpoint` is used to communicate that a breakpoint was
encountered during code evaluation.
This `EvalBreakpoint` needs to be converted to an `InternalBreakpointId`
which stores a `Module` to uniquely find the correct `Module` in the
Home Package Table.
The `EvalBreakpoint` used to store only a `ModuleName` which is then
converted to a `Module` based on the currently active home unit.
This is incorrect in the face of multiple home units, the break point
could be in an entirely other home unit!
To fix this, we additionally store the `UnitId` of the `Module` in
`EvalBreakpoint` to later reconstruct the correct `Module`
All of the changes are the consequence of extending `EvalBreakpoint`
with the additional `ShortByteString` of the `UnitId`.
For performance reasons, we store the `ShortByteString` backing the
`UnitId` directly, avoiding marshalling overhead.
- - - - -
5f3137cb by fendor at 2025-04-24T10:22:01+02:00
Make GHCi commands compatible with multiple home units
FIXME: proper commit message
- - - - -
83141897 by fendor at 2025-04-24T10:22:01+02:00
Add testcases for GHCi multiple home units
Adds the following testcases:
* Evaluate code with a single home unit using 'initMulti' initialisation
logic
* More complicated testcase with multiple home units, testing reload
logic and code evaluation.
- - - - -
9f25d0ba by fendor at 2025-04-24T10:22:01+02:00
Use Module in IIModule
- - - - -
a0736fd5 by fendor at 2025-04-24T10:55:45+02:00
WIP
- - - - -
164 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeAction.hs
- + compiler/GHC/Driver/Messager.hs
- compiler/GHC/Driver/Pipeline.hs-boot
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Runtime/Context.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Home/Graph.hs
- − compiler/GHC/Unit/Module/External/Graph.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/ModNodeKey.hs
- compiler/GHC/Unit/Types.hs
- compiler/ghc.cabal.in
- configure.ac
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/exts/instances.rst
- docs/users_guide/using-warnings.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- ghc/GHCi/UI/Monad.hs
- ghc/Main.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- rts/Exception.cmm
- rts/Interpreter.c
- rts/RtsUtils.c
- testsuite/driver/testlib.py
- testsuite/ghc-config/ghc-config.hs
- + testsuite/tests/bytecode/T25975.hs
- + testsuite/tests/bytecode/T25975.stdout
- testsuite/tests/bytecode/all.T
- + testsuite/tests/default/T25912.hs
- + testsuite/tests/default/T25912.stdout
- + testsuite/tests/default/T25912_helper.hs
- + testsuite/tests/default/T25914.hs
- + testsuite/tests/default/T25934.hs
- testsuite/tests/default/all.T
- testsuite/tests/default/default-fail03.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- + testsuite/tests/gadt/T23298.hs
- + testsuite/tests/gadt/T23298.stderr
- testsuite/tests/gadt/all.T
- testsuite/tests/ghc-api/T6145.hs
- testsuite/tests/ghc-api/annotations-literals/literals.hs
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.stdout
- testsuite/tests/ghc-api/fixed-nodes/T1.hs
- testsuite/tests/ghc-api/fixed-nodes/all.T
- testsuite/tests/ghci/linking/dyn/T3372.hs
- + testsuite/tests/ghci/prog-mhu001/Makefile
- + testsuite/tests/ghci/prog-mhu001/e/E.hs
- + testsuite/tests/ghci/prog-mhu001/prog-mhu001.T
- + testsuite/tests/ghci/prog-mhu001/prog-mhu001.script
- + testsuite/tests/ghci/prog-mhu001/prog-mhu001.stdout
- + testsuite/tests/ghci/prog-mhu001/unitE
- + testsuite/tests/ghci/prog-mhu002/Makefile
- + testsuite/tests/ghci/prog-mhu002/a/A.hs
- + testsuite/tests/ghci/prog-mhu002/b/B.hs
- + testsuite/tests/ghci/prog-mhu002/c/C.hs
- + testsuite/tests/ghci/prog-mhu002/d/Main.hs
- + testsuite/tests/ghci/prog-mhu002/prog-mhu002.T
- + testsuite/tests/ghci/prog-mhu002/prog-mhu002.script
- + testsuite/tests/ghci/prog-mhu002/prog-mhu002.stderr
- + testsuite/tests/ghci/prog-mhu002/prog-mhu002.stdout
- + testsuite/tests/ghci/prog-mhu002/unitA
- + testsuite/tests/ghci/prog-mhu002/unitB
- + testsuite/tests/ghci/prog-mhu002/unitC
- + testsuite/tests/ghci/prog-mhu002/unitD
- testsuite/tests/ghci/prog018/prog018.stdout
- + testsuite/tests/ghci/scripts/GhciPackageRename.hs
- + testsuite/tests/ghci/scripts/GhciPackageRename.script
- + testsuite/tests/ghci/scripts/GhciPackageRename.stdout
- testsuite/tests/ghci/scripts/T13869.stdout
- testsuite/tests/ghci/scripts/T13997.stdout
- testsuite/tests/ghci/scripts/T17669.stdout
- testsuite/tests/ghci/scripts/T18330.stdout
- testsuite/tests/ghci/scripts/T1914.stdout
- testsuite/tests/ghci/scripts/T20217.stdout
- testsuite/tests/ghci/scripts/T20587.stdout
- testsuite/tests/ghci/scripts/T6105.stdout
- testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/T8042recomp.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/ghci/should_run/TopEnvIface.stdout
- 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/template-haskell-exports.stdout
- testsuite/tests/linters/notes.stdout
- testsuite/tests/module/mod58.stderr
- testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
- testsuite/tests/quasiquotation/T7918.hs
- testsuite/tests/simplCore/should_compile/Makefile
- testsuite/tests/simplCore/should_compile/T23307c.stderr
- + testsuite/tests/simplCore/should_compile/T25883.hs
- + testsuite/tests/simplCore/should_compile/T25883.substr-simpl
- + testsuite/tests/simplCore/should_compile/T25883b.hs
- + testsuite/tests/simplCore/should_compile/T25883b.substr-simpl
- + testsuite/tests/simplCore/should_compile/T25883c.hs
- + testsuite/tests/simplCore/should_compile/T25883c.substr-simpl
- + testsuite/tests/simplCore/should_compile/T25883d.hs
- + testsuite/tests/simplCore/should_compile/T25883d.stderr
- + testsuite/tests/simplCore/should_compile/T25883d_import.hs
- + testsuite/tests/simplCore/should_compile/T25976.hs
- + testsuite/tests/simplCore/should_compile/T3990c.hs
- + testsuite/tests/simplCore/should_compile/T3990c.stdout
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_fail/T25672.stderr
- + testsuite/tests/simplCore/should_run/T23429.hs
- + testsuite/tests/simplCore/should_run/T23429.stdout
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/typecheck/should_compile/T7050.stderr
- testsuite/tests/typecheck/should_fail/T3966.stderr
- + testsuite/tests/typecheck/should_fail/T3966b.hs
- + testsuite/tests/typecheck/should_fail/T3966b.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/unboxedsums/unpack_sums_5.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e49609d42c3442306c6205117c55f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e49609d42c3442306c6205117c55f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ghci: Use loadInterfaceForModule rather than loadSrcInterface in mkTopLevEnv
by Marge Bot (＠marge-bot) 24 Apr '25
by Marge Bot (＠marge-bot) 24 Apr '25
24 Apr '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
91564daf by Matthew Pickering at 2025-04-24T00:29:02-04:00
ghci: Use loadInterfaceForModule rather than loadSrcInterface in mkTopLevEnv
loadSrcInterface takes a user given `ModuleName` and resolves it to the
module which needs to be loaded (taking into account module
renaming/visibility etc).
loadInterfaceForModule takes a specific module and loads it.
The modules in `ImpDeclSpec` have already been resolved to the actual
module to get the information from during renaming. Therefore we just
need to fetch the precise interface from disk (and not attempt to rename
it again).
Fixes #25951
- - - - -
2e0c07ab by Simon Peyton Jones at 2025-04-24T00:29:43-04:00
Test for #23298
- - - - -
fc85e73f by Sven Tennie at 2025-04-24T03:04:18-04:00
RV64: Introduce J instruction (non-local jumps) and don't deallocate stack slots for J_TBL (#25738)
J_TBL result in local jumps, there should not deallocate stack slots
(see Note [extra spill slots].)
J is for non-local jumps, these may need to deallocate stack slots.
- - - - -
52e76dbd by fendor at 2025-04-24T03:04:18-04:00
Add `UnitId` to `EvalBreakpoint`
The `EvalBreakpoint` is used to communicate that a breakpoint was
encountered during code evaluation.
This `EvalBreakpoint` needs to be converted to an `InternalBreakpointId`
which stores a `Module` to uniquely find the correct `Module` in the
Home Package Table.
The `EvalBreakpoint` used to store only a `ModuleName` which is then
converted to a `Module` based on the currently active home unit.
This is incorrect in the face of multiple home units, the break point
could be in an entirely other home unit!
To fix this, we additionally store the `UnitId` of the `Module` in
`EvalBreakpoint` to later reconstruct the correct `Module`
All of the changes are the consequence of extending `EvalBreakpoint`
with the additional `ShortByteString` of the `UnitId`.
For performance reasons, we store the `ShortByteString` backing the
`UnitId` directly, avoiding marshalling overhead.
- - - - -
21 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/StgToByteCode.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Exception.cmm
- rts/Interpreter.c
- + testsuite/tests/gadt/T23298.hs
- + testsuite/tests/gadt/T23298.stderr
- testsuite/tests/gadt/all.T
- + testsuite/tests/ghci/scripts/GhciPackageRename.hs
- + testsuite/tests/ghci/scripts/GhciPackageRename.script
- + testsuite/tests/ghci/scripts/GhciPackageRename.stdout
- testsuite/tests/ghci/scripts/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -732,13 +732,16 @@ assembleI platform i = case i of
CCALL off m_addr i -> do np <- addr m_addr
emit_ bci_CCALL [wOp off, Op np, SmallOp i]
PRIMCALL -> emit_ bci_PRIMCALL []
- BRK_FUN arr tick_mod tickx info_mod infox cc ->
+ BRK_FUN arr tick_mod tick_mod_id tickx info_mod info_mod_id infox cc ->
do p1 <- ptr (BCOPtrBreakArray arr)
tick_addr <- addr tick_mod
+ tick_unitid_addr <- addr tick_mod_id
info_addr <- addr info_mod
+ info_unitid_addr <- addr info_mod_id
np <- addr cc
emit_ bci_BRK_FUN [ Op p1
, Op tick_addr, Op info_addr
+ , Op tick_unitid_addr, Op info_unitid_addr
, SmallOp tickx, SmallOp infox
, Op np
]
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -37,6 +37,7 @@ import GHC.Stg.Syntax
import GHCi.BreakArray (BreakArray)
import Language.Haskell.Syntax.Module.Name (ModuleName)
import GHC.Types.Unique
+import GHC.Unit.Types (UnitId)
-- ----------------------------------------------------------------------------
-- Bytecode instructions
@@ -233,8 +234,10 @@ data BCInstr
-- Breakpoints
| BRK_FUN (ForeignRef BreakArray)
(RemotePtr ModuleName) -- breakpoint tick module
+ (RemotePtr UnitId) -- breakpoint tick module unit id
!Word16 -- breakpoint tick index
(RemotePtr ModuleName) -- breakpoint info module
+ (RemotePtr UnitId) -- breakpoint info module unit id
!Word16 -- breakpoint info index
(RemotePtr CostCentre)
@@ -403,10 +406,10 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN _ _tick_mod tickx _info_mod infox _)
+ ppr (BRK_FUN _ _tick_mod _tick_mod_id tickx _info_mod _info_mod_id infox _)
= text "BRK_FUN" <+> text "<breakarray>"
- <+> text "<tick_module>" <+> ppr tickx
- <+> text "<info_module>" <+> ppr infox
+ <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
+ <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
<+> text "<cc>"
#if MIN_VERSION_rts(1,0,3)
ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm)
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -50,6 +50,7 @@ import GHC.Stack.CCS
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
import GHC.Iface.Syntax
import Language.Haskell.Syntax.Module.Name (ModuleName)
+import GHC.Unit.Types (UnitId)
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
@@ -263,6 +264,9 @@ data ModBreaks
, modBreaks_breakInfo :: IntMap CgBreakInfo
-- ^ info about each breakpoint from the bytecode generator
, modBreaks_module :: RemotePtr ModuleName
+ -- ^ info about the module in which we are setting the breakpoint
+ , modBreaks_module_unitid :: RemotePtr UnitId
+ -- ^ The 'UnitId' of the 'ModuleName'
}
seqModBreaks :: ModBreaks -> ()
@@ -273,7 +277,8 @@ seqModBreaks ModBreaks{..} =
rnf modBreaks_decls `seq`
rnf modBreaks_ccs `seq`
rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`
- rnf modBreaks_module
+ rnf modBreaks_module `seq`
+ rnf modBreaks_module_unitid
-- | Construct an empty ModBreaks
emptyModBreaks :: ModBreaks
@@ -286,6 +291,7 @@ emptyModBreaks = ModBreaks
, modBreaks_ccs = array (0,-1) []
, modBreaks_breakInfo = IntMap.empty
, modBreaks_module = toRemotePtr nullPtr
+ , modBreaks_module_unitid = toRemotePtr nullPtr
}
{-
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1481,7 +1481,7 @@ assignReg_FltCode = assignReg_IntCode
genJump :: CmmExpr {-the branch target-} -> NatM InstrBlock
genJump expr = do
(target, _format, code) <- getSomeReg expr
- return (code `appOL` unitOL (annExpr expr (B (TReg target))))
+ return (code `appOL` unitOL (annExpr expr (J (TReg target))))
-- -----------------------------------------------------------------------------
-- Unconditional branches
@@ -2226,5 +2226,6 @@ makeFarBranches {- only used when debugging -} _platform statics basic_blocks =
BCOND {} -> long_bc_jump_size
B (TBlock _) -> long_b_jump_size
B (TReg _) -> 1
+ J op -> instr_size (B op)
BL _ _ -> 1
J_TBL {} -> 1
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -97,6 +97,7 @@ regUsageOfInstr platform instr = case instr of
ORI dst src1 _ -> usage (regOp src1, regOp dst)
XORI dst src1 _ -> usage (regOp src1, regOp dst)
J_TBL _ _ t -> usage ([t], [])
+ J t -> usage (regTarget t, [])
B t -> usage (regTarget t, [])
BCOND _ l r t -> usage (regTarget t ++ regOp l ++ regOp r, [])
BL t ps -> usage (t : ps, callerSavedRegisters)
@@ -195,6 +196,7 @@ patchRegsOfInstr instr env = case instr of
ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3)
XORI o1 o2 o3 -> XORI (patchOp o1) (patchOp o2) (patchOp o3)
J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t)
+ J t -> J (patchTarget t)
B t -> B (patchTarget t)
BL t ps -> BL (patchReg t) ps
BCOND c o1 o2 t -> BCOND c (patchOp o1) (patchOp o2) (patchTarget t)
@@ -235,6 +237,7 @@ isJumpishInstr :: Instr -> Bool
isJumpishInstr instr = case instr of
ANN _ i -> isJumpishInstr i
J_TBL {} -> True
+ J {} -> True
B {} -> True
BL {} -> True
BCOND {} -> True
@@ -243,6 +246,7 @@ isJumpishInstr instr = case instr of
canFallthroughTo :: Instr -> BlockId -> Bool
canFallthroughTo insn bid =
case insn of
+ J (TBlock target) -> bid == target
B (TBlock target) -> bid == target
BCOND _ _ _ (TBlock target) -> bid == target
J_TBL targets _ _ -> all isTargetBid targets
@@ -256,6 +260,7 @@ canFallthroughTo insn bid =
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (BCOND _ _ _ t) = [id | TBlock id <- [t]]
jumpDestsOfInstr _ = []
@@ -269,6 +274,7 @@ patchJumpInstr instr patchF =
case instr of
ANN d i -> ANN d (patchJumpInstr i patchF)
J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
+ J (TBlock bid) -> J (TBlock (patchF bid))
B (TBlock bid) -> B (TBlock (patchF bid))
BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid))
_ -> panic $ "patchJumpInstr: " ++ instrCon instr
@@ -475,7 +481,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
block' = foldr insert_dealloc [] insns
insert_dealloc insn r = case insn of
- J_TBL {} -> dealloc ++ (insn : r)
+ J {} -> dealloc ++ (insn : r)
ANN _ e -> insert_dealloc e r
_other
| jumpDestsOfInstr insn /= [] ->
@@ -591,6 +597,8 @@ data Instr
--
-- @if(o2 cond o3) op <- 1 else op <- 0@
CSET Operand Operand Operand Cond
+ -- | Like B, but only used for non-local jumps. Used to distinguish genJumps from others.
+ | J Target
| -- | A jump instruction with data for switch/jump tables
J_TBL [Maybe BlockId] (Maybe CLabel) Reg
| -- | Unconditional jump (no linking)
@@ -663,6 +671,7 @@ instrCon i =
LDRU {} -> "LDRU"
CSET {} -> "CSET"
J_TBL {} -> "J_TBL"
+ J {} -> "J"
B {} -> "B"
BL {} -> "BL"
BCOND {} -> "BCOND"
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -543,6 +543,7 @@ pprInstr platform instr = case instr of
| otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0))
ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3
XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3
+ J o1 -> pprInstr platform (B o1)
J_TBL _ _ r -> pprInstr platform (B (TReg r))
B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
B (TReg r) -> line $ text "\tjalr" <+> pprOp platform x0 <> comma <+> pprReg W64 r <> comma <+> text "0"
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -34,7 +34,7 @@ mkModBreaks interp mod extendedMixEntries
breakArray <- GHCi.newBreakArray interp count
ccs <- mkCCSArray interp mod count entries
- mod_ptr <- GHCi.newModuleName interp (moduleName mod)
+ (mod_ptr, mod_id_ptr) <- GHCi.newModule interp mod
let
locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
@@ -46,6 +46,7 @@ mkModBreaks interp mod extendedMixEntries
, modBreaks_decls = declsTicks
, modBreaks_ccs = ccs
, modBreaks_module = mod_ptr
+ , modBreaks_module_unitid = mod_id_ptr
}
mkCCSArray
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -78,7 +78,7 @@ import GHC.Core.Type hiding( typeKind )
import qualified GHC.Core.Type as Type
import GHC.Iface.Env ( newInteractiveBinder )
-import GHC.Iface.Load ( loadSrcInterface )
+import GHC.Iface.Load ( loadInterfaceForModule )
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
@@ -345,7 +345,7 @@ handleRunStatus step expr bindings final_ids status history0 = do
-- Just case: we stopped at a breakpoint
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
- ibi <- liftIO $ evalBreakpointToId (hsc_HPT hsc_env) eval_break
+ let ibi = evalBreakpointToId eval_break
tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi)
let
span = modBreaks_locs tick_brks ! ibi_tick_index ibi
@@ -843,7 +843,7 @@ mkTopLevEnv hsc_env modl
$ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
$ forM imports $ \iface_import -> do
let ImpUserSpec spec details = tcIfaceImport iface_import
- iface <- loadSrcInterface (text "imported by GHCi") (moduleName $ is_mod spec) (is_isboot spec) (is_pkg_qual spec)
+ iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec)
pure $ case details of
ImpUserAll -> importsFromIface hsc_env iface spec Nothing
ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -21,7 +21,7 @@ module GHC.Runtime.Interpreter
, mkCostCentres
, costCentreStackInfo
, newBreakArray
- , newModuleName
+ , newModule
, storeBreakpoint
, breakpointStatus
, getBreakpointVar
@@ -93,9 +93,8 @@ import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe)
import GHC.Utils.Fingerprint
import GHC.Unit.Module
-import GHC.Unit.Module.ModIface
import GHC.Unit.Home.ModInfo
-import GHC.Unit.Home.PackageTable
+import GHC.Unit.Home.Graph (lookupHugByModule)
import GHC.Unit.Env
#if defined(HAVE_INTERNAL_INTERPRETER)
@@ -377,9 +376,13 @@ newBreakArray interp size = do
breakArray <- interpCmd interp (NewBreakArray size)
mkFinalizedHValue interp breakArray
-newModuleName :: Interp -> ModuleName -> IO (RemotePtr ModuleName)
-newModuleName interp mod_name =
- castRemotePtr <$> interpCmd interp (NewBreakModule (moduleNameString mod_name))
+newModule :: Interp -> Module -> IO (RemotePtr ModuleName, RemotePtr UnitId)
+newModule interp mod = do
+ let
+ mod_name = moduleNameString $ moduleName mod
+ mod_id = fastStringToShortByteString $ unitIdFS $ toUnitId $ moduleUnit mod
+ (mod_ptr, mod_id_ptr) <- interpCmd interp (NewBreakModule mod_name mod_id)
+ pure (castRemotePtr mod_ptr, castRemotePtr mod_id_ptr)
storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO ()
storeBreakpoint interp ref ix cnt = do -- #19157
@@ -415,19 +418,21 @@ seqHValue interp unit_env ref =
status <- interpCmd interp (Seq hval)
handleSeqHValueStatus interp unit_env status
-evalBreakpointToId :: HomePackageTable -> EvalBreakpoint -> IO InternalBreakpointId
-evalBreakpointToId hpt eval_break =
- let load_mod x = mi_module . hm_iface . expectJust <$> lookupHpt hpt (mkModuleName x)
- in do
- tickl <- load_mod (eb_tick_mod eval_break)
- infol <- load_mod (eb_info_mod eval_break)
- return
- InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
- , ibi_info_index = eb_info_index eval_break
- }
+evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
+evalBreakpointToId eval_break =
+ let
+ mkUnitId u = fsToUnit $ mkFastStringShortByteString u
+
+ toModule u n = mkModule (mkUnitId u) (mkModuleName n)
+ tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
+ infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
+ in
+ InternalBreakpointId
+ { ibi_tick_mod = tickl
+ , ibi_tick_index = eb_tick_index eval_break
+ , ibi_info_mod = infol
+ , ibi_info_index = eb_info_index eval_break
+ }
-- | Process the result of a Seq or ResumeSeq message. #2950
handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
@@ -447,12 +452,12 @@ handleSeqHValueStatus interp unit_env eval_status =
mkGeneralSrcSpan (fsLit "<unknown>")
Just break -> do
- bi <- evalBreakpointToId (ue_hpt unit_env) break
+ let bi = evalBreakpointToId break
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
breaks_tick <- getModBreaks . expectJust <$>
- lookupHpt (ue_hpt unit_env) (moduleName (ibi_tick_mod bi))
+ lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
put $ brackets . ppr $
(modBreaks_locs breaks_tick) ! ibi_tick_index bi
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -416,7 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
Nothing -> pure code
Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
Nothing -> pure code
- Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_ccs = cc_arr} -> do
+ Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_module_unitid = tick_mod_id_ptr, modBreaks_ccs = cc_arr} -> do
platform <- profilePlatform <$> getProfile
let idOffSets = getVarOffSets platform d p fvs
ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
@@ -425,6 +425,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
let info_mod_ptr = modBreaks_module current_mod_breaks
+ info_mod_id_ptr = modBreaks_module_unitid current_mod_breaks
infox <- newBreakInfo breakInfo
let cc | Just interp <- hsc_interp hsc_env
@@ -437,7 +438,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do
in if fromIntegral r == x
then r
else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- breakInstr = BRK_FUN breaks tick_mod_ptr (toW16 tick_no) info_mod_ptr (toW16 infox) cc
+ breakInstr = BRK_FUN breaks tick_mod_ptr tick_mod_id_ptr (toW16 tick_no) info_mod_ptr info_mod_id_ptr (toW16 infox) cc
return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -23,6 +23,7 @@ module GHCi.Message
, getMessage, putMessage, getTHMessage, putTHMessage
, Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe
, BreakModule
+ , BreakUnitId
, LoadedDLL
) where
@@ -51,6 +52,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Short as BS
import Data.Dynamic
import Data.Typeable (TypeRep)
import Data.IORef
@@ -245,8 +247,9 @@ data Message a where
-- | Allocate a string for a breakpoint module name.
-- This uses an empty dummy type because @ModuleName@ isn't available here.
NewBreakModule
- :: String
- -> Message (RemotePtr BreakModule)
+ :: String -- ^ @ModuleName@
+ -> BS.ShortByteString -- ^ @UnitId@ for the given @ModuleName@
+ -> Message (RemotePtr BreakModule, RemotePtr BreakUnitId)
deriving instance Show (Message a)
@@ -410,10 +413,12 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
- , eb_info_index :: Int -- ^ Breakpoint info index
+ { eb_tick_mod :: String -- ^ Breakpoint tick module
+ , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
+ , eb_tick_index :: Int -- ^ Breakpoint tick index
+ , eb_info_mod :: String -- ^ Breakpoint info module
+ , eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
+ , eb_info_index :: Int -- ^ Breakpoint info index
}
deriving (Generic, Show)
@@ -430,6 +435,10 @@ instance Binary a => Binary (EvalResult a)
-- that type isn't available here.
data BreakModule
+-- | A dummy type that tags the pointer to a breakpoint's @UnitId@, because
+-- that type isn't available here.
+data BreakUnitId
+
-- | A dummy type that tags pointers returned by 'LoadDLL'.
data LoadedDLL
@@ -580,7 +589,7 @@ getMessage = do
36 -> Msg <$> (Seq <$> get)
37 -> Msg <$> return RtsRevertCAFs
38 -> Msg <$> (ResumeSeq <$> get)
- 39 -> Msg <$> (NewBreakModule <$> get)
+ 39 -> Msg <$> (NewBreakModule <$> get <*> get)
40 -> Msg <$> (LookupSymbolInDLL <$> get <*> get)
41 -> Msg <$> (WhereFrom <$> get)
_ -> error $ "Unknown Message code " ++ (show b)
@@ -627,7 +636,7 @@ putMessage m = case m of
Seq a -> putWord8 36 >> put a
RtsRevertCAFs -> putWord8 37
ResumeSeq a -> putWord8 38 >> put a
- NewBreakModule name -> putWord8 39 >> put name
+ NewBreakModule name unitid -> putWord8 39 >> put name >> put unitid
LookupSymbolInDLL dll str -> putWord8 40 >> put dll >> put str
WhereFrom a -> putWord8 41 >> put a
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -33,6 +33,7 @@ import Control.DeepSeq
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
+import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Unsafe as B
import GHC.Exts
import qualified GHC.Exts.Heap as Heap
@@ -95,7 +96,10 @@ run m = case m of
MkCostCentres mod ccs -> mkCostCentres mod ccs
CostCentreStackInfo ptr -> ccsToStrings (fromRemotePtr ptr)
NewBreakArray sz -> mkRemoteRef =<< newBreakArray sz
- NewBreakModule name -> newModuleName name
+ NewBreakModule name unitid -> do
+ namePtr <- newModuleName name
+ uidPtr <- newUnitId unitid
+ pure (namePtr, uidPtr)
SetupBreakpoint ref ix cnt -> do
arr <- localRef ref;
_ <- setupBreakpoint arr ix cnt
@@ -335,7 +339,7 @@ withBreakAction opts breakMVar statusMVar act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tickx# info_mod# infox# is_exception apStack = do
+ onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -349,8 +353,10 @@ withBreakAction opts breakMVar statusMVar act
then pure Nothing
else do
tick_mod <- peekCString (Ptr tick_mod#)
+ tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
- pure (Just (EvalBreakpoint tick_mod (I# tickx#) info_mod (I# infox#)))
+ info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
+ pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -400,8 +406,10 @@ resetStepFlag = poke stepFlag 0
type BreakpointCallback
= Addr# -- pointer to the breakpoint tick module name
+ -> Addr# -- pointer to the breakpoint tick module unit id
-> Int# -- breakpoint tick index
-> Addr# -- pointer to the breakpoint info module name
+ -> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
-> HValue -- the AP_STACK, or exception
@@ -414,8 +422,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
@@ -432,6 +440,13 @@ mkString0 bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do
pokeElemOff (ptr :: Ptr CChar) len 0
return (castRemotePtr (toRemotePtr ptr))
+mkShortByteString0 :: BS.ShortByteString -> IO (RemotePtr ())
+mkShortByteString0 bs = BS.useAsCStringLen bs $ \(cstr,len) -> do
+ ptr <- mallocBytes (len+1)
+ copyBytes ptr cstr len
+ pokeElemOff (ptr :: Ptr CChar) len 0
+ return (castRemotePtr (toRemotePtr ptr))
+
mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]
#if defined(PROFILING)
mkCostCentres mod ccs = do
@@ -453,6 +468,10 @@ newModuleName :: String -> IO (RemotePtr BreakModule)
newModuleName name =
castRemotePtr . toRemotePtr <$> newCString name
+newUnitId :: BS.ShortByteString -> IO (RemotePtr BreakUnitId)
+newUnitId name =
+ castRemotePtr <$> mkShortByteString0 name
+
getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
getIdValFromApStack apStack (I# stackDepth) = do
case getApStackVal# apStack stackDepth of
=====================================
rts/Exception.cmm
=====================================
@@ -535,12 +535,16 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(13);
- Sp(12) = exception;
- Sp(11) = stg_raise_ret_info;
- Sp(10) = exception;
- Sp(9) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(8) = stg_ap_ppv_info;
+ Sp = Sp - WDS(17);
+ Sp(16) = exception;
+ Sp(15) = stg_raise_ret_info;
+ Sp(14) = exception;
+ Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(12) = stg_ap_ppv_info;
+ Sp(11) = 0;
+ Sp(10) = stg_ap_n_info;
+ Sp(9) = 0;
+ Sp(8) = stg_ap_n_info;
Sp(7) = 0;
Sp(6) = stg_ap_n_info;
Sp(5) = 0;
=====================================
rts/Interpreter.c
=====================================
@@ -1245,9 +1245,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_index, arg5_info_index;
+ int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
#if defined(PROFILING)
- int arg6_cc;
+ int arg8_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break;
@@ -1264,10 +1264,12 @@ run_BCO:
arg1_brk_array = BCO_GET_LARGE_ARG;
arg2_tick_mod = BCO_GET_LARGE_ARG;
arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_index = BCO_NEXT;
- arg5_info_index = BCO_NEXT;
+ arg4_tick_mod_id = BCO_GET_LARGE_ARG;
+ arg5_info_mod_id = BCO_GET_LARGE_ARG;
+ arg6_tick_index = BCO_NEXT;
+ arg7_info_index = BCO_NEXT;
#if defined(PROFILING)
- arg6_cc = BCO_GET_LARGE_ARG;
+ arg8_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1280,7 +1282,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg6_cc));
+ (CostCentre*)BCO_LIT(arg8_cc));
#endif
// if we are returning from a break then skip this section
@@ -1292,11 +1294,11 @@ run_BCO:
// stop the current thread if either the
// "rts_stop_next_breakpoint" flag is true OR if the
// ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
if (rts_stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg4_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
}
else if (rts_stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1330,8 +1332,10 @@ run_BCO:
// continue execution of this BCO when the IO action returns.
//
// ioAction :: Addr# -- the breakpoint tick module
+ // -> Addr# -- the breakpoint tick module unit id
// -> Int# -- the breakpoint tick index
// -> Addr# -- the breakpoint info module
+ // -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
// -> HValue -- the AP_STACK, or exception
@@ -1340,17 +1344,21 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(15);
- SpW(14) = (W_)obj;
- SpW(13) = (W_)&stg_apply_interp_info;
- SpW(12) = (W_)new_aps;
- SpW(11) = (W_)False_closure; // True <=> an exception
- SpW(10) = (W_)&stg_ap_ppv_info;
- SpW(9) = (W_)arg5_info_index;
+ Sp_subW(19);
+ SpW(18) = (W_)obj;
+ SpW(17) = (W_)&stg_apply_interp_info;
+ SpW(16) = (W_)new_aps;
+ SpW(15) = (W_)False_closure; // True <=> an exception
+ SpW(14) = (W_)&stg_ap_ppv_info;
+ SpW(13) = (W_)arg7_info_index;
+ SpW(12) = (W_)&stg_ap_n_info;
+ SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
+ SpW(10) = (W_)&stg_ap_n_info;
+ SpW(9) = (W_)BCO_LIT(arg3_info_mod);
SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)BCO_LIT(arg3_info_mod);
+ SpW(7) = (W_)arg6_tick_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)arg4_tick_index;
+ SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
SpW(2) = (W_)&stg_ap_n_info;
=====================================
testsuite/tests/gadt/T23298.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE GADTs #-}
+module T23298 where
+
+import Data.Kind (Type)
+
+type HList :: Type -> Type
+data HList a where
+ HCons :: HList x -> HList (Maybe x)
+
+eq :: HList a -> Bool
+eq x = case x of
+ HCons ms -> True
+
+go (HCons x) = go x
+
+{- go :: HList alpha -> beta
+
+Under HCons
+ [G] alpha ~ Maybe x
+ [W] HList x ~ HList alpha
+==>
+ [W] x ~ alpha
+==>
+ [W] x ~ Maybe x
+-}
=====================================
testsuite/tests/gadt/T23298.stderr
=====================================
@@ -0,0 +1,12 @@
+ T23298.hs:14:16: error: [GHC-25897]
+ • Couldn't match type ‘x’ with ‘Maybe x’
+ Expected: HList x -> t
+ Actual: HList a -> t
+ ‘x’ is a rigid type variable bound by
+ a pattern with constructor:
+ HCons :: forall x. HList x -> HList (Maybe x),
+ in an equation for ‘go’
+ at T23298.hs:14:5-11
+ • In the expression: go x
+ In an equation for ‘go’: go (HCons x) = go x
+ • Relevant bindings include x :: HList x (bound at T23298.hs:14:11)
=====================================
testsuite/tests/gadt/all.T
=====================================
@@ -131,3 +131,4 @@ test('T19847a', normalise_version('base'), compile, ['-ddump-types'])
test('T19847b', normal, compile, [''])
test('T23022', normal, compile, ['-dcore-lint'])
test('T23023', normal, compile_fail, ['-O -dcore-lint']) # todo: move this test?
+test('T23298', normal, compile_fail, [''])
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.hs
=====================================
@@ -0,0 +1,4 @@
+module GhciPackageRename where
+
+foo :: Map k v
+foo = empty
\ No newline at end of file
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.script
=====================================
@@ -0,0 +1,6 @@
+:l GhciPackageRename.hs
+-- Test that Data.Map is available as Prelude
+:t fromList
+
+-- Test using a Map function
+fromList [(1,"a"), (2,"b")]
\ No newline at end of file
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.stdout
=====================================
@@ -0,0 +1,3 @@
+fromList
+ :: ghc-internal:GHC.Internal.Classes.Ord k => [(k, a)] -> Map k a
+fromList [(1,"a"),(2,"b")]
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -386,3 +386,9 @@ test('T13869', extra_files(['T13869a.hs', 'T13869b.hs']), ghci_script, ['T13869.
test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script'])
test('ListTuplePunsPprNoAbbrevTuple', [expect_broken(23135), limit_stdout_lines(13)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script'])
test('T24459', normal, ghci_script, ['T24459.script'])
+
+# Test package renaming in GHCi session
+test('GhciPackageRename',
+ [extra_hc_opts("-hide-all-packages -package 'containers (Data.Map as Prelude)'")],
+ ghci_script,
+ ['GhciPackageRename.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df8442ae955e81bf3516c03c128874…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df8442ae955e81bf3516c03c128874…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
2e0c07ab by Simon Peyton Jones at 2025-04-24T00:29:43-04:00
Test for #23298
- - - - -
3 changed files:
- + testsuite/tests/gadt/T23298.hs
- + testsuite/tests/gadt/T23298.stderr
- testsuite/tests/gadt/all.T
Changes:
=====================================
testsuite/tests/gadt/T23298.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE GADTs #-}
+module T23298 where
+
+import Data.Kind (Type)
+
+type HList :: Type -> Type
+data HList a where
+ HCons :: HList x -> HList (Maybe x)
+
+eq :: HList a -> Bool
+eq x = case x of
+ HCons ms -> True
+
+go (HCons x) = go x
+
+{- go :: HList alpha -> beta
+
+Under HCons
+ [G] alpha ~ Maybe x
+ [W] HList x ~ HList alpha
+==>
+ [W] x ~ alpha
+==>
+ [W] x ~ Maybe x
+-}
=====================================
testsuite/tests/gadt/T23298.stderr
=====================================
@@ -0,0 +1,12 @@
+ T23298.hs:14:16: error: [GHC-25897]
+ • Couldn't match type ‘x’ with ‘Maybe x’
+ Expected: HList x -> t
+ Actual: HList a -> t
+ ‘x’ is a rigid type variable bound by
+ a pattern with constructor:
+ HCons :: forall x. HList x -> HList (Maybe x),
+ in an equation for ‘go’
+ at T23298.hs:14:5-11
+ • In the expression: go x
+ In an equation for ‘go’: go (HCons x) = go x
+ • Relevant bindings include x :: HList x (bound at T23298.hs:14:11)
=====================================
testsuite/tests/gadt/all.T
=====================================
@@ -131,3 +131,4 @@ test('T19847a', normalise_version('base'), compile, ['-ddump-types'])
test('T19847b', normal, compile, [''])
test('T23022', normal, compile, ['-dcore-lint'])
test('T23023', normal, compile_fail, ['-O -dcore-lint']) # todo: move this test?
+test('T23298', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e0c07abc166560a974c0fc34efddc6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e0c07abc166560a974c0fc34efddc6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] ghci: Use loadInterfaceForModule rather than loadSrcInterface in mkTopLevEnv
by Marge Bot (＠marge-bot) 24 Apr '25
by Marge Bot (＠marge-bot) 24 Apr '25
24 Apr '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
91564daf by Matthew Pickering at 2025-04-24T00:29:02-04:00
ghci: Use loadInterfaceForModule rather than loadSrcInterface in mkTopLevEnv
loadSrcInterface takes a user given `ModuleName` and resolves it to the
module which needs to be loaded (taking into account module
renaming/visibility etc).
loadInterfaceForModule takes a specific module and loads it.
The modules in `ImpDeclSpec` have already been resolved to the actual
module to get the information from during renaming. Therefore we just
need to fetch the precise interface from disk (and not attempt to rename
it again).
Fixes #25951
- - - - -
5 changed files:
- compiler/GHC/Runtime/Eval.hs
- + testsuite/tests/ghci/scripts/GhciPackageRename.hs
- + testsuite/tests/ghci/scripts/GhciPackageRename.script
- + testsuite/tests/ghci/scripts/GhciPackageRename.stdout
- testsuite/tests/ghci/scripts/all.T
Changes:
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -78,7 +78,7 @@ import GHC.Core.Type hiding( typeKind )
import qualified GHC.Core.Type as Type
import GHC.Iface.Env ( newInteractiveBinder )
-import GHC.Iface.Load ( loadSrcInterface )
+import GHC.Iface.Load ( loadInterfaceForModule )
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
@@ -843,7 +843,7 @@ mkTopLevEnv hsc_env modl
$ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
$ forM imports $ \iface_import -> do
let ImpUserSpec spec details = tcIfaceImport iface_import
- iface <- loadSrcInterface (text "imported by GHCi") (moduleName $ is_mod spec) (is_isboot spec) (is_pkg_qual spec)
+ iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec)
pure $ case details of
ImpUserAll -> importsFromIface hsc_env iface spec Nothing
ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.hs
=====================================
@@ -0,0 +1,4 @@
+module GhciPackageRename where
+
+foo :: Map k v
+foo = empty
\ No newline at end of file
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.script
=====================================
@@ -0,0 +1,6 @@
+:l GhciPackageRename.hs
+-- Test that Data.Map is available as Prelude
+:t fromList
+
+-- Test using a Map function
+fromList [(1,"a"), (2,"b")]
\ No newline at end of file
=====================================
testsuite/tests/ghci/scripts/GhciPackageRename.stdout
=====================================
@@ -0,0 +1,3 @@
+fromList
+ :: ghc-internal:GHC.Internal.Classes.Ord k => [(k, a)] -> Map k a
+fromList [(1,"a"),(2,"b")]
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -386,3 +386,9 @@ test('T13869', extra_files(['T13869a.hs', 'T13869b.hs']), ghci_script, ['T13869.
test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script'])
test('ListTuplePunsPprNoAbbrevTuple', [expect_broken(23135), limit_stdout_lines(13)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script'])
test('T24459', normal, ghci_script, ['T24459.script'])
+
+# Test package renaming in GHCi session
+test('GhciPackageRename',
+ [extra_hc_opts("-hide-all-packages -package 'containers (Data.Map as Prelude)'")],
+ ghci_script,
+ ['GhciPackageRename.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91564dafd60445f03025c3fee4f9802…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91564dafd60445f03025c3fee4f9802…
You're receiving this email because of your account on gitlab.haskell.org.
1
0