Rodrigo Mesquita pushed to branch wip/romes/interactive-ids-refactor at Glasgow Haskell Compiler / GHC Commits: 26fbcce5 by Rodrigo Mesquita at 2026-10-28T14:16:37+00:00 refactor: Keep the interactive Ids directly rather than Name Removes things like names <- map idName ids map (\i -> let id = find (\x -> i==idName x) names) idso and is more straightforward because there's less state going around (no more updating HscEnv as an output) It also kills `printTypeOfNames` completely, since now we just have the Ids. No longer `lookupName` names to get back the ids... ``` printTypeOfName :: GHC.GhcMonad m => Name -> m () printTypeOfName n = do maybe_tything <- GHC.lookupName n case maybe_tything of Nothing -> return () Just thing -> printTyThing thing ``` now is just `printTyThing . AnId` Also: ```diff - tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted - docs <- mapM pprTypeAndContents [i | AnId i <- tythings] + docs <- mapM pprTypeAndContents idsSorted ``` (and yes, in ExecBreaks there are only Ids, no TyThings, bc they are only constructed by the interpreter execution which can only bind ids. for TyThings use runDecls which doesn't return execBreaks.) There's some care to be had to make sure we use the "most refined" Ids, whereas when using `Name`s we'd always fetch the most refined Id from scratch. Fixes #28052 - - - - - 12 changed files: - + changelog.d/ghc-api-interactive-ids - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Debugger.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Heap/Inspect.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Monad.hs - + testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.hs - + testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.script - + testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.stdout - testsuite/tests/ghci.debugger/scripts/all.T Changes: ===================================== changelog.d/ghc-api-interactive-ids ===================================== @@ -0,0 +1,15 @@ +section: ghc-lib +synopsis: The GHCi evaluation API now returns ``Id``\s and ``TyThing``\s rather than ``Name``\s +issues: #28052 +mrs: !16883 + +description: { +The results of interactive evaluation are now returned directly, rather than as +``Name``\s that had to be looked up again in the interactive context: + +- ``ExecComplete``'s ``execResult`` and ``ExecBreak``'s ``breakNames`` now hold ``[Id]``. +- ``runDecls``, ``runDeclsWithLocation`` and ``runParsedDecls`` now return ``[TyThing]`` rather than ``[Name]``. +- ``rttiEnvironment`` now returns a Subst with the inferred types. + +The returned ``Id``\s carry the types refined by runtime type inference. +} ===================================== compiler/GHC/Runtime/Context.hs ===================================== @@ -6,6 +6,8 @@ module GHC.Runtime.Context , extendInteractiveContextWithIds , setInteractivePrintName , substInteractiveContext + , substInteractiveTyThing + , substInteractiveId , replaceImportEnv , icReaderEnv , icExtendGblRdrEnv @@ -496,15 +498,18 @@ icExtendGblRdrEnv drop_only_qualified env tythings substInteractiveContext :: InteractiveContext -> Subst -> InteractiveContext substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst | isEmptyTCvSubst subst = ictxt - | otherwise = ictxt { ic_tythings = map subst_ty tts } - where - subst_ty (AnId id) - = AnId $ updateIdTypeAndMult (substTyAddInScope subst) id - -- Variables in the interactive context *can* mention free type variables - -- because of the runtime debugger. Otherwise you'd expect all - -- variables bound in the interactive context to be closed. - subst_ty tt - = tt + | otherwise = ictxt { ic_tythings = map (substInteractiveTyThing subst) tts } + +substInteractiveTyThing :: Subst -> TyThing -> TyThing +substInteractiveTyThing subst (AnId id) = AnId $ substInteractiveId subst id +substInteractiveTyThing _ tt = tt + +substInteractiveId :: Subst -> Id -> Id +substInteractiveId subst id = + -- Variables in the interactive context *can* mention free type variables + -- because of the runtime debugger. Otherwise you'd expect all + -- variables bound in the interactive context to be closed. + updateIdTypeAndMult (substTyAddInScope subst) id instance Outputable InteractiveImport where ppr (IIModule m) = char '*' <> ppr m ===================================== compiler/GHC/Runtime/Debugger.hs ===================================== @@ -121,8 +121,7 @@ pprintClosureCommand bindThings force str = do -- Then, we extract a substitution, -- mapping the old tyvars to the reconstructed types. let reconstructed_type = termType term - hsc_env <- getSession - case (improveRTTIType hsc_env id_ty' reconstructed_type) of + case improveRTTIType id_ty' reconstructed_type of Nothing -> return (subst, term') Just subst' -> do { logger <- getLogger ; liftIO $ ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -131,7 +131,7 @@ import GHC.ByteCode.Breakpoints import Control.Monad import Data.Dynamic import Data.IntMap (IntMap) -import Data.List (find,intercalate) +import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG @@ -241,12 +241,12 @@ execStmt' stmt stmt_text ExecOptions{..} = do handleRunStatus execSingleStep stmt_text bindings ids status (emptyHistory size) -runDecls :: GhcMonad m => String -> m [Name] +runDecls :: GhcMonad m => String -> m [TyThing] runDecls = runDeclsWithLocation "<interactive>" 1 -- | Run some declarations and return any user-visible names that were brought -- into scope. -runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name] +runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [TyThing] runDeclsWithLocation source line_num input = do hsc_env <- getSession decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input) @@ -255,18 +255,18 @@ runDeclsWithLocation source line_num input = do -- | Like `runDeclsWithLocation`, but takes parsed declarations as argument. -- Useful when doing preprocessing on the AST before execution, e.g. in GHCi -- (see GHCi.UI.runStmt). -runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name] +runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [TyThing] runParsedDecls decls = do - hsc_env <- getSession - (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls) - + hsc_env <- getSession + (tyThings, ic) <- liftIO $ hscParsedDecls hsc_env decls setSession $ hsc_env { hsc_IC = ic } hsc_env <- getSession - hsc_env' <- liftIO $ rttiEnvironment hsc_env + (hsc_env', subst) <- liftIO $ rttiEnvironment hsc_env setSession hsc_env' - return $ filter (not . isDerivedOccName . nameOccName) + return $ map (substInteractiveTyThing subst) + $ filter (not . isDerivedOccName . nameOccName . getName) -- For this filter, see Note [What to show to users] - $ map getName tyThings + $ tyThings {- Note [What to show to users] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -310,9 +310,10 @@ handleRunStatus step expr bindings final_ids status history0 = do final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids final_names = map getName final_ids liftIO $ Loader.extendLoadedEnv interp modifyHomePackageBytecodeState (zip final_names hvals) - hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic} + (hsc_env', subst) <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic} + let improved_final_ids = map (substInteractiveId subst) final_ids setSession hsc_env' - return (ExecComplete (Right final_names) allocs) + return (ExecComplete (Right improved_final_ids) allocs) -- Completed with an exception EvalComplete alloc (EvalException e) -> @@ -323,7 +324,7 @@ handleRunStatus step expr bindings final_ids status history0 = do resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref let span = mkGeneralSrcSpan (fsLit "<unknown>") - (hsc_env1, names) <- liftIO $ + (hsc_env1, break_ids) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack_fhv span Nothing let resume = Resume @@ -342,7 +343,7 @@ handleRunStatus step expr bindings final_ids status history0 = do hsc_env2 = pushResume hsc_env1 resume setSession hsc_env2 - return (ExecBreak names Nothing) + return (ExecBreak break_ids Nothing) -- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint -- @@ -370,7 +371,7 @@ handleRunStatus step expr bindings final_ids status history0 = do -- This function only returns control to ghci with 'ExecBreak' when it is really meant to break. -- Specifically, for :steplocal or :stepmodule, don't return control -- and simply resume execution from here until we hit a breakpoint we do want to stop at. - (hsc_env1, names) <- liftIO $ + (hsc_env1, break_ids) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) let resume = Resume @@ -388,7 +389,7 @@ handleRunStatus step expr bindings final_ids status history0 = do } hsc_env2 = pushResume hsc_env1 resume setSession hsc_env2 - return (ExecBreak names (Just ibi)) + return (ExecBreak break_ids (Just ibi)) else do -- resume with the same step type let eval_opts = initEvalOpts dflags (enableGhcStepMode step) @@ -491,13 +492,13 @@ getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do ( ld_st' , ba ) -back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) +back :: GhcMonad m => Int -> m ([Id], Int, SrcSpan) back n = moveHist (+n) -forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) +forward :: GhcMonad m => Int -> m ([Id], Int, SrcSpan) forward n = moveHist (subtract n) -moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan) +moveHist :: GhcMonad m => (Int -> Int) -> m ([Id], Int, SrcSpan) moveHist fn = do hsc_env <- getSession case ic_resume (hsc_IC hsc_env) of @@ -521,7 +522,7 @@ moveHist fn = do let hug = hsc_HUG hsc_env brks <- readIModBreaks hug ibi getBreakLoc (readIModModBreaks hug) ibi brks - (hsc_env1, names) <- + (hsc_env1, final_ids) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info let ic = hsc_IC hsc_env1 r' = r { resumeHistoryIx = new_ix } @@ -529,7 +530,7 @@ moveHist fn = do setSession hsc_env1{ hsc_IC = ic' } - return (names, new_ix, span) + return (final_ids, new_ix, span) -- careful: we want apStack to be the AP_STACK itself, not a thunk -- around it, hence the cases are carefully constructed below to @@ -555,7 +556,7 @@ bindLocalsAtBreakpoint -> ForeignHValue -> SrcSpan -> Maybe InternalBreakpointId - -> IO (HscEnv, [Name]) + -> IO (HscEnv, [Id]) -- Nothing case: we stopped when an exception was raised, not at a -- breakpoint. We have no location information or local variables to @@ -575,7 +576,7 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do interp = hscInterp hsc_env -- Loader.extendLoadedEnv interp modifyHomePackageBytecodeState [(exn_name, apStack)] - return (hsc_env{ hsc_IC = ictxt1 }, [exn_name]) + return (hsc_env{ hsc_IC = ictxt1 }, [exn_id]) -- Just case: we stopped at a breakpoint, we have information about the location -- of the breakpoint and the free variables of the expression. @@ -635,8 +636,9 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do let fhvs = catMaybes mb_hValues Loader.extendLoadedEnv interp modifyHomePackageBytecodeState (zip names fhvs) when result_ok $ Loader.extendLoadedEnv interp modifyHomePackageBytecodeState [(result_name, apStack_fhv)] - hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 } - return (hsc_env1, if result_ok then result_name:names else names) + (hsc_env1, subst) <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 } + let improved_final_ids = map (substInteractiveId subst) final_ids + return (hsc_env1, improved_final_ids) where -- We need a fresh Unique for each Id we bind, because the linker -- state is single-threaded and otherwise we'd spam old bindings @@ -676,34 +678,33 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do joinOccs = zipWithEqual joinOcc joinOcc mbV oc = (\(a,b) c -> (a,b,c)) <$> mbV <*> pure oc -rttiEnvironment :: HscEnv -> IO HscEnv +rttiEnvironment :: HscEnv -> IO (HscEnv, Subst) rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do let tmp_ids = [id | AnId id <- ic_tythings ic] incompletelyTypedIds = [id | id <- tmp_ids , not $ noSkolems id , (occNameFS.nameOccName.idName) id /= result_fs] - foldM improveTypes hsc_env (map idName incompletelyTypedIds) + foldM improveTypes (hsc_env, emptySubst) incompletelyTypedIds where noSkolems = noFreeVarsOfType . idType - improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do - let tmp_ids = [id | AnId id <- ic_tythings ic] - id = expectJust $ find (\i -> idName i == name) tmp_ids + improveTypes (hsc_env@HscEnv{hsc_IC=ic}, last_subst) id0 = do + let id = substInteractiveId last_subst id0 if noSkolems id - then return hsc_env + then return (hsc_env, last_subst) else do mb_new_ty <- reconstructType hsc_env 10 id let old_ty = idType id case mb_new_ty of - Nothing -> return hsc_env + Nothing -> return (hsc_env, last_subst) Just new_ty -> do - case improveRTTIType hsc_env old_ty new_ty of + case improveRTTIType old_ty new_ty of Nothing -> warnPprTrace True (":print failed to calculate the " ++ "improvement for a type") (vcat [ text "id" <+> ppr id , text "old_ty" <+> debugPprType old_ty , text "new_ty" <+> debugPprType new_ty ]) $ - return hsc_env + return (hsc_env, last_subst) Just subst -> do let logger = hsc_logger hsc_env putDumpFileMaybe logger Opt_D_dump_rtti "RTTI" @@ -712,7 +713,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do ppr subst]) let ic' = substInteractiveContext ic subst - return hsc_env{hsc_IC=ic'} + return (hsc_env{hsc_IC=ic'}, subst `composeTCvSubst` last_subst) pushResume :: HscEnv -> Resume -> HscEnv pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 } ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -19,7 +19,6 @@ import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) import GHC.ByteCode.Types (InternalBreakpointId(..)) import GHC.Types.Id -import GHC.Types.Name import GHC.Types.TyThing import GHC.Types.Name.Reader import GHC.Types.SrcLoc @@ -150,7 +149,7 @@ data ExecResult -- | Execution is complete with either an exception or the list of -- user-visible names that were brought into scope. = ExecComplete - { execResult :: Either SomeException [Name] + { execResult :: Either SomeException [Id] , execAllocation :: Word64 } @@ -161,7 +160,7 @@ data ExecResult -- subsequently deciding whether to really stop here. -- `ExecBreak` always means GHCi breaks. | ExecBreak - { breakNames :: [Name] + { breakNames :: [Id] , breakPointId :: Maybe InternalBreakpointId } ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -1163,8 +1163,8 @@ findPtrTyss i tys = foldM step (i, []) tys -- improveType <base_type> <rtti_type> -- The types can contain skolem type variables, which need to be treated as normal vars. -- In particular, we want them to unify with things. -improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe Subst -improveRTTIType _ base_ty new_ty = U.tcUnifyDebugger base_ty new_ty +improveRTTIType :: RttiType -> RttiType -> Maybe Subst +improveRTTIType base_ty new_ty = U.tcUnifyDebugger base_ty new_ty getDataConArgTys :: DataCon -> Type -> TR [Type] -- Given the result type ty of a constructor application (D a b c :: ty) ===================================== ghc/GHCi/UI.hs ===================================== @@ -1495,7 +1495,7 @@ runOneCommand eh gCmd = do -- runStmt wrapper for temporarily overridden line-number runStmtWithLineNum :: Int -> String -> SingleStep - -> GHCi (Maybe GHC.ExecResult) + -> GHCi (Maybe RunResult) runStmtWithLineNum lnum stmt step = do st0 <- getGHCiState setGHCiState st0 { line_number = lnum } @@ -1560,7 +1560,7 @@ enqueueCommands cmds = do -- | Entry point to execute some haskell code from user. -- The return value True indicates success, as in `runOneCommand`. -runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult) +runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe RunResult) runStmt input step = do dflags <- GHC.getInteractiveDynFlags let pflags = initParserOpts dflags @@ -1582,7 +1582,7 @@ runStmt input step = do case mb_stmt of Nothing -> -- empty statement / comment - return (Just exec_complete) + return (Just (RunDeclsResult [])) Just stmt -> run_stmt stmt @@ -1605,8 +1605,6 @@ runStmt input step = do run_imports imports run_decls decls where - exec_complete = GHC.ExecComplete (Right []) 0 - run_imports imports = mapM_ (addImportToContext . unLoc) imports set_pragmas pflags sec supported = @@ -1615,12 +1613,12 @@ runStmt input step = do opts = unLoc <$> loc_opts in setOptions opts - run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe GHC.ExecResult) + run_stmt :: GhciMonad m => GhciLStmt GhcPs -> m (Maybe RunResult) run_stmt stmt = do m_result <- GhciMonad.runStmt stmt input step case m_result of Nothing -> return Nothing - Just result -> Just <$> afterRunStmt step result + Just result -> Just <$> afterRunStmt step (RunStmtResult result) -- `x = y` (a declaration) should be treated as `let x = y` (a statement). -- The reason is because GHCi wasn't designed to support `x = y`, but then @@ -1636,7 +1634,7 @@ runStmt input step = do -- -- Instead of dealing with all these problems individually here we fix this -- mess by just treating `x = y` as `let x = y`. - run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe GHC.ExecResult) + run_decls :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe RunResult) -- Only turn `FunBind` and `VarBind` into statements, other bindings -- (e.g. `PatBind`) need to stay as decls. run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt (locA l) bind) @@ -1651,8 +1649,8 @@ runStmt input step = do -- a file, otherwise the read buffer can't be flushed). _ <- liftIO $ tryIO $ hFlushAll stdin m_result <- GhciMonad.runDecls' decls - forM m_result $ \result -> - afterRunStmt step (GHC.ExecComplete (Right result) 0) + forM m_result $ \result -> do + afterRunStmt step (RunDeclsResult result) mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs mk_stmt loc bind = @@ -1668,32 +1666,39 @@ runStmt input step = do where modStr = moduleNameString $ moduleName $ icInteractiveModule $ ic +data RunResult + = RunStmtResult GHC.ExecResult + | RunDeclsResult [TyThing] + -- | Clean up the GHCi environment after a statement has run afterRunStmt :: GhciMonad m => SingleStep {-^ Type of step we took just before -} - -> GHC.ExecResult -> m GHC.ExecResult + -> RunResult -> m RunResult afterRunStmt step run_result = do resumes <- GHC.getResumeContext case run_result of - GHC.ExecComplete{..} -> - case execResult of - Left ex -> liftIO $ Exception.throwIO ex - Right names -> do - show_types <- isOptionSet ShowType - when show_types $ printTypeOfNames names - GHC.ExecBreak names mb_info - | first_resume : _ <- resumes - -> do mb_id_loc <- toBreakIdAndLocation mb_info - let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc - if (null bCmd) - then printStoppedAtBreakInfo first_resume names - else enqueueCommands [bCmd] - -- run the command set with ":set stop <cmd>" - st <- getGHCiState - enqueueCommands [stop st] - return () - - | otherwise -> resume step Nothing >>= - afterRunStmt step >> return () + RunDeclsResult things -> do + show_types <- isOptionSet ShowType + when show_types $ printTypeOfThings things + RunStmtResult GHC.ExecComplete{..} -> + case execResult of + Left ex -> liftIO $ Exception.throwIO ex + Right ids -> do + show_types <- isOptionSet ShowType + when show_types $ printTypeOfIds ids + RunStmtResult (GHC.ExecBreak ids mb_info) + | first_resume : _ <- resumes + -> do mb_id_loc <- toBreakIdAndLocation mb_info + let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc + if (null bCmd) + then printStoppedAtBreakInfo first_resume ids + else enqueueCommands [bCmd] + -- run the command set with ":set stop <cmd>" + st <- getGHCiState + enqueueCommands [stop st] + return () + + | otherwise -> resume step Nothing >>= + afterRunStmt step . RunStmtResult >> return () flushInterpBuffers withSignalHandlers $ do @@ -1702,16 +1707,19 @@ afterRunStmt step run_result = do return run_result -runSuccess :: Maybe GHC.ExecResult -> Bool +runSuccess :: Maybe RunResult -> Bool runSuccess run_result - | Just (GHC.ExecComplete { execResult = Right _ }) <- run_result = True + | Just (RunDeclsResult _) <- run_result = True + | Just (RunStmtResult GHC.ExecComplete { execResult = Right _ }) + <- run_result = True | otherwise = False -runAllocs :: Maybe GHC.ExecResult -> Maybe Integer +runAllocs :: Maybe RunResult -> Maybe Integer runAllocs m = do res <- m case res of - GHC.ExecComplete{..} -> Just (fromIntegral execAllocation) + RunDeclsResult _ -> Just 0 + RunStmtResult GHC.ExecComplete{..} -> Just (fromIntegral execAllocation) _ -> Nothing toBreakIdAndLocation :: GhciMonad m @@ -1725,30 +1733,23 @@ toBreakIdAndLocation (Just inf) = do return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st), breakId loc == bi ] -printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m () -printStoppedAtBreakInfo res names = do +printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [GHC.Id] -> m () +printStoppedAtBreakInfo res ids = do printForUser =<< pprStopped res - -- printTypeOfNames session names - let namesSorted = sortBy compareNames names - tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted - docs <- mapM pprTypeAndContents [i | AnId i <- tythings] + let idsSorted = sortBy (compareNames `on` getName) ids + docs <- mapM pprTypeAndContents idsSorted printForUserPartWay $ vcat docs -printTypeOfNames :: GHC.GhcMonad m => [Name] -> m () -printTypeOfNames names - = mapM_ (printTypeOfName ) $ sortBy compareNames names +printTypeOfIds :: GHC.GhcMonad m => [GHC.Id] -> m () +printTypeOfIds = printTypeOfThings . map AnId + +printTypeOfThings :: GHC.GhcMonad m => [GHC.TyThing] -> m () +printTypeOfThings things + = mapM_ printTyThing $ sortBy (compareNames `on` getName) things compareNames :: Name -> Name -> Ordering compareNames = on compare getOccString S.<> on SrcLoc.leftmost_smallest getSrcSpan -printTypeOfName :: GHC.GhcMonad m => Name -> m () -printTypeOfName n - = do maybe_tything <- GHC.lookupName n - case maybe_tything of - Nothing -> return () - Just thing -> printTyThing thing - - data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand -- | Entry point for execution a ':<command>' input from user @@ -4400,7 +4401,7 @@ doContinue step = doContinue' step Nothing doContinue' :: GhciMonad m => SingleStep -> Maybe Int -> m () doContinue' step mbCnt= do runResult <- resume step mbCnt - _ <- afterRunStmt step runResult + _ <- afterRunStmt step (RunStmtResult runResult) return () abandonCmd :: GhciMonad m => String -> m () @@ -4551,9 +4552,9 @@ backCmd arg | otherwise = liftIO $ putStrLn "Syntax: :back [num]" where back num = withSandboxOnly ":back" $ do - (names, _, pan) <- GHC.back num + (ids, _, pan) <- GHC.back num printForUser $ text "Logged breakpoint at" <+> ppr pan - printTypeOfNames names + printTypeOfIds ids -- run the command set with ":set stop <cmd>" st <- getGHCiState enqueueCommands [stop st] @@ -4565,11 +4566,11 @@ forwardCmd arg | otherwise = liftIO $ putStrLn "Syntax: :forward [num]" where forward num = withSandboxOnly ":forward" $ do - (names, ix, pan) <- GHC.forward num + (ids, ix, pan) <- GHC.forward num printForUser $ (if (ix == 0) then text "Stopped at" else text "Logged breakpoint at") <+> ppr pan - printTypeOfNames names + printTypeOfIds ids -- run the command set with ":set stop <cmd>" st <- getGHCiState enqueueCommands [stop st] ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -381,7 +381,7 @@ runStmt stmt stmt_text step = do (EvalThis fhv) } Just <$> GHC.execStmt' stmt stmt_text opts -runDecls :: GhciMonad m => String -> m (Maybe [GHC.Name]) +runDecls :: GhciMonad m => String -> m (Maybe [GHC.TyThing]) runDecls decls = do st <- getGHCiState reifyGHCi $ \x -> @@ -393,7 +393,7 @@ runDecls decls = do r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls return (Just r) -runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.Name]) +runDecls' :: GhciMonad m => [LHsDecl GhcPs] -> m (Maybe [GHC.TyThing]) runDecls' decls = do st <- getGHCiState reifyGHCi $ \x -> ===================================== testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.hs ===================================== @@ -0,0 +1,4 @@ +module RttiSharedTyVar where + +f :: a -> a -> () +f x y = x `seq` y `seq` () ===================================== testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.script ===================================== @@ -0,0 +1,9 @@ +:l RttiSharedTyVar +let a = Just undefined :: Maybe Int +let b = Just 5 :: Maybe Int +a `seq` b `seq` () +:break f +-- should say x y have type Maybe Int, not Maybe a +f a b +:t x +:t y ===================================== testsuite/tests/ghci.debugger/scripts/RttiSharedTyVar.stdout ===================================== @@ -0,0 +1,8 @@ +() +Breakpoint 0 activated at RttiSharedTyVar.hs:4:9-26 +Stopped in RttiSharedTyVar.f, RttiSharedTyVar.hs:4:9-26 +_result :: () = _ +x :: Maybe Int = Just _ +y :: Maybe Int = Just 5 +x :: Maybe Int +y :: Maybe Int ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -155,3 +155,5 @@ test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), ext test('T26042g', extra_files(['T26042g.hs']), ghci_script, ['T26042g.script']) test('T27633c', extra_files(['T27633c_obj.hs']), ghci_script, ['T27633c.script']) + +test('RttiSharedTyVar', extra_files(['RttiSharedTyVar.hs']), ghci_script, ['RttiSharedTyVar.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26fbcce5413b6b9a39c2b9714c3c80cb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26fbcce5413b6b9a39c2b9714c3c80cb... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help