- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/romes/step-out] debugger: Implement step-out feature
by Rodrigo Mesquita (＠alt-romes) 16 May '25

16 May '25

Rodrigo Mesquita pushed to branch wip/romes/step-out at Glasgow Haskell Compiler / GHC Commits: 1cb33002 by Rodrigo Mesquita at 2025-05-16T14:05:17+01:00 debugger: Implement step-out feature Implements support for stepping-out of a function (aka breaking right after returning from a function) in the interactive debugger. It also introduces a GHCi command :stepout to step-out of a function being debugged in the interpreter. The feature is described as: Stop at the first breakpoint immediately after returning from the current function scope. Known limitations: because a function tail-call does not push a stack frame, if step-out is used inside of a function that was tail-called, execution will not be returned to its caller, but rather its caller's first non-tail caller. On the other hand, it means the debugger follows the more realistic execution of the program. In the following example: .. code-block:: none f = do a b <--- (1) set breakpoint then step in here c b = do ... d <--- (2) step-into this tail call d = do ... something <--- (3) step-out here ... Stepping-out will stop execution at the `c` invokation in `f`, rather than stopping at `b`. The key implementation bit is simple: When step-out is set and the interpreter hits a RETURN instruction, enable "stop at the immediate next breakpoint" (aka single-step). See also `Note [Debugger Step-out]` in `rts/Interpreter.c` Note [Debugger Step-out] ~~~~~~~~~~~~~~~~~~~~~~~~ When the global debugger step-out flag is set (`rts_stop_after_return`), the interpreter must yield execution right after the first RETURN. When stepping-out, we simply enable `rts_stop_next_breakpoint` when we hit a return instruction (in `do_return_pointer` and `do_return_nonpointer`). The step-out flag is cleared and must be re-enabled explicitly to step-out again. A limitation of this approach is that stepping-out of a function that was tail-called will skip its caller since no stack frame is pushed for a tail call (i.e. a tail call returns directly to its caller's first non-tail caller). Fixes #26042 - - - - - 20 changed files: - compiler/GHC/Driver/Config.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/ghci.debugger/scripts/T26042a.hs - + testsuite/tests/ghci.debugger/scripts/T26042a.script - + testsuite/tests/ghci.debugger/scripts/T26042a.stdout - + testsuite/tests/ghci.debugger/scripts/T26042b.hs - + testsuite/tests/ghci.debugger/scripts/T26042b.script - + testsuite/tests/ghci.debugger/scripts/T26042b.stdout - + testsuite/tests/ghci.debugger/scripts/T26042c.hs - + testsuite/tests/ghci.debugger/scripts/T26042c.script - + testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/all.T Changes: ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts , initEvalOpts + , EvalStep(..) ) where @@ -28,13 +29,28 @@ initSimpleOpts dflags = SimpleOpts , so_inline = True } +-- | Instruct the interpreter evaluation to break... +data EvalStep + -- | ... at every breakpoint tick + = EvalStepSingle + -- | ... after every return stmt + | EvalStepOut + -- | ... only on explicit breakpoints + | EvalStepNone + -- | Extract GHCi options from DynFlags and step -initEvalOpts :: DynFlags -> Bool -> EvalOpts +initEvalOpts :: DynFlags -> EvalStep -> EvalOpts initEvalOpts dflags step = EvalOpts { useSandboxThread = gopt Opt_GhciSandbox dflags - , singleStep = step + , singleStep = singleStep + , stepOut = stepOut , breakOnException = gopt Opt_BreakOnException dflags , breakOnError = gopt Opt_BreakOnError dflags } + where + (singleStep, stepOut) = case step of + EvalStepSingle -> (True, False) + EvalStepOut -> (False, True) + EvalStepNone -> (False, False) ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -343,7 +343,12 @@ handleRunStatus step expr bindings final_ids status history0 = do setSession hsc_env2 return (ExecBreak names Nothing) - -- Just case: we stopped at a breakpoint + -- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint + -- + -- The interpreter yields on a breakpoint if: + -- - the breakpoint was explicitly enabled (in @BreakArray@) + -- - or @singleStep = True@ in EvalOpts + -- - or @stepOut = True@ in EvalOpts EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do let ibi = evalBreakpointToId eval_break tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi) @@ -351,13 +356,14 @@ handleRunStatus step expr bindings final_ids status history0 = do span = modBreaks_locs tick_brks ! ibi_tick_index ibi decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi + -- Was the breakpoint explicitly enabled? b <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - -- This breakpoint is explicitly enabled; we want to stop - -- instead of just logging it. + -- This breakpoint is enabled or we mean to break here; + -- we want to stop instead of just logging it. if b || breakHere step span then 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 @@ -1247,7 +1253,7 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do _ -> panic "compileParsedExprRemote" updateFixityEnv fix_env - let eval_opts = initEvalOpts dflags False + let eval_opts = initEvalOpts dflags EvalStepNone status <- liftIO $ evalStmt interp eval_opts (EvalThis hvals_io) case status of EvalComplete _ (EvalSuccess [hval]) -> return hval ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -17,6 +17,7 @@ import GHC.Prelude import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) +import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id import GHC.Types.Name import GHC.Types.TyThing @@ -46,6 +47,9 @@ data SingleStep -- | :step [expr] | SingleStep + -- | :stepout [expr] + | StepOut + -- | :steplocal [expr] | LocalStep { breakAt :: SrcSpan } @@ -55,10 +59,12 @@ data SingleStep { breakAt :: SrcSpan } -- | Whether this 'SingleStep' mode requires instructing the interpreter to --- step at every breakpoint. -enableGhcStepMode :: SingleStep -> Bool -enableGhcStepMode RunToCompletion = False -enableGhcStepMode _ = True +-- step at every breakpoint or after every return (see @'EvalStep'@). +enableGhcStepMode :: SingleStep -> EvalStep +enableGhcStepMode RunToCompletion = EvalStepNone +enableGhcStepMode StepOut = EvalStepOut +-- for the remaining step modes we need to stop at every single breakpoint. +enableGhcStepMode _ = EvalStepSingle -- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return -- @True@ if based on the step-mode alone we should stop at this breakpoint. @@ -70,6 +76,7 @@ breakHere :: SingleStep -> SrcSpan -> Bool breakHere step break_span = case step of RunToCompletion -> False RunAndLogSteps -> False + StepOut -> True SingleStep -> True LocalStep span -> break_span `isSubspanOf` span ModuleStep span -> srcSpanFileName_maybe span == srcSpanFileName_maybe break_span ===================================== docs/users_guide/ghci.rst ===================================== @@ -2980,6 +2980,35 @@ commonly used commands. hit by an error (:ghc-flag:`-fbreak-on-error`) or an exception (:ghc-flag:`-fbreak-on-exception`). +.. ghci-cmd:: :stepout + + Stop at the first breakpoint immediately after returning from the current + function scope. + + Known limitations: because a function tail-call does not push a stack + frame, if step-out is used inside of a function that was tail-called, + execution will not be returned to its caller, but rather its caller's + first non-tail caller. On the other hand, it means the debugger + follows the more realistic execution of the program. + In the following example: + + .. code-block:: none + + f = do + a + b <--- (1) set breakpoint then step in here + c + b = do + ... + d <--- (2) step-into this tail call + d = do + ... + something <--- (3) step-out here + ... + + Stepping-out will stop execution at the `c` invokation in `f`, rather than + stopping at `b`. + .. ghci-cmd:: :stepmodule Enable only breakpoints in the current module and resume evaluation ===================================== ghc/GHCi/UI.hs ===================================== @@ -247,6 +247,7 @@ ghciCommands = map mkCmd [ ("sprint", keepGoing sprintCmd, completeExpression), ("step", keepGoing stepCmd, completeIdentifier), ("steplocal", keepGoing stepLocalCmd, completeIdentifier), + ("stepout", keepGoing stepOutCmd, completeIdentifier), ("stepmodule",keepGoing stepModuleCmd, completeIdentifier), ("type", keepGoingMulti' typeOfExpr, completeExpression), ("trace", keepGoing traceCmd, completeExpression), @@ -407,6 +408,7 @@ defFullHelpText = " :step single-step after stopping at a breakpoint\n"++ " :step <expr> single-step into <expr>\n"++ " :steplocal single-step within the current top-level binding\n"++ + " :stepout stop at the first breakpoint after returning from the current scope\n"++ " :stepmodule single-step restricted to the current module\n"++ " :trace trace after stopping at a breakpoint\n"++ " :trace <expr> evaluate <expr> with tracing on (see :history)\n"++ @@ -3793,6 +3795,12 @@ stepCmd arg = withSandboxOnly ":step" $ step arg step [] = doContinue GHC.SingleStep step expression = runStmt expression GHC.SingleStep >> return () +stepOutCmd :: GhciMonad m => String -> m () +stepOutCmd arg = withSandboxOnly ":stepout" $ step arg + where + step [] = doContinue GHC.StepOut + step expression = stepCmd expression + stepLocalCmd :: GhciMonad m => String -> m () stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg where ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -374,6 +374,7 @@ putTHMessage m = case m of data EvalOpts = EvalOpts { useSandboxThread :: Bool , singleStep :: Bool + , stepOut :: Bool , breakOnException :: Bool , breakOnError :: Bool } ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -210,6 +210,7 @@ evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts { useSandboxThread = True , singleStep = False + , stepOut = False , breakOnException = False , breakOnError = False } @@ -333,6 +334,7 @@ withBreakAction opts breakMVar statusMVar act poke breakPointIOAction stablePtr when (breakOnException opts) $ poke exceptionFlag 1 when (singleStep opts) $ setStepFlag + when (stepOut opts) $ poke stepOutFlag 1 return stablePtr -- Breaking on exceptions is not enabled by default, since it -- might be a bit surprising. The exception flag is turned off @@ -363,6 +365,7 @@ withBreakAction opts breakMVar statusMVar act resetBreakAction stablePtr = do poke breakPointIOAction noBreakStablePtr poke exceptionFlag 0 + poke stepOutFlag 0 resetStepFlag freeStablePtr stablePtr @@ -398,6 +401,7 @@ abandonStmt hvref = do foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt +foreign import ccall "&rts_stop_after_return" stepOutFlag :: Ptr CInt setStepFlag :: IO () setStepFlag = poke stepFlag 1 ===================================== rts/Interpreter.c ===================================== @@ -194,6 +194,24 @@ See also Note [Width of parameters] for some more motivation. #define WITHIN_CHUNK_BOUNDS(n, s) \ (RTS_LIKELY((StgWord*)(Sp_plusW(n)) < ((s)->stack + (s)->stack_size - sizeofW(StgUnderflowFrame)))) +// Note [Debugger Step-out] +// ~~~~~~~~~~~~~~~~~~~~~~~~ +// When the global debugger step-out flag is set (`rts_stop_after_return`), +// the interpreter must yield execution right after the first RETURN. +// +// When stepping-out, we simply enable `rts_stop_next_breakpoint` when we hit a +// return instruction (in `do_return_pointer` and `do_return_nonpointer`). +// The step-out flag is cleared and must be re-enabled explicitly to step-out again. +// +// A limitation of this approach is that stepping-out of a function that was +// tail-called will skip its caller since no stack frame is pushed for a tail +// call (i.e. a tail call returns directly to its caller's first non-tail caller). +#define CHECK_BRK_AFTER_RET() \ + if (rts_stop_after_return) \ + { \ + rts_stop_next_breakpoint = true; \ + rts_stop_after_return = false; \ + } \ /* Note [PUSH_L underflow] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -245,6 +263,7 @@ allocate_NONUPD (Capability *cap, int n_words) int rts_stop_next_breakpoint = 0; int rts_stop_on_exception = 0; +int rts_stop_after_return = 0; #if defined(INTERP_STATS) @@ -734,6 +753,8 @@ do_return_pointer: IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size)); + CHECK_BRK_AFTER_RET(); + switch (get_itbl((StgClosure *)Sp)->type) { case RET_SMALL: { @@ -883,6 +904,8 @@ do_return_nonpointer: // get the offset of the header of the next stack frame offset = stack_frame_sizeW((StgClosure *)Sp); + CHECK_BRK_AFTER_RET(); + switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) { case RET_BCO: ===================================== rts/RtsSymbols.c ===================================== @@ -908,6 +908,7 @@ extern char **environ; SymI_NeedsDataProto(rts_breakpoint_io_action) \ SymI_NeedsDataProto(rts_stop_next_breakpoint) \ SymI_NeedsDataProto(rts_stop_on_exception) \ + SymI_NeedsDataProto(rts_stop_after_return) \ SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(max_n_capabilities) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -619,6 +619,7 @@ RTS_FUN_DECL(stg_castFloatToWord32zh); // Interpreter.c extern StgWord rts_stop_next_breakpoint[]; extern StgWord rts_stop_on_exception[]; +extern StgWord rts_stop_after_return[]; extern StgWord rts_breakpoint_io_action[]; // Schedule.c ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.hs ===================================== @@ -0,0 +1,17 @@ +module Main where + +main :: IO () +main = do + a <- foo + print a + +foo :: IO Int +foo = do + let x = 3 + y = 4 + b <- bar (x + y) + return b + +bar :: Int -> IO Int +bar z = return (z * 2) + ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.script ===================================== @@ -0,0 +1,20 @@ +:load T26042a.hs +-- simple use of stepout +:break bar +main +:list +:stepout +:list +:stepout +:list +-- from here on we're going to evaluate the thunks for `a` in `print a` +:stepout +:list +:stepout +:list +:stepout +:list +:stepout +:list +-- finish execution +:stepout ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.stdout ===================================== @@ -0,0 +1,50 @@ +Breakpoint 0 activated at T26042a.hs:16:9-22 +Stopped in Main.bar, T26042a.hs:16:9-22 +_result :: IO Int = _ +z :: Int = _ +15 bar :: Int -> IO Int +16 bar z = return (z * 2) + ^^^^^^^^^^^^^^ +17 +Stopped in Main.foo, T26042a.hs:13:3-10 +_result :: IO Int = _ +b :: Int = _ +12 b <- bar (x + y) +13 return b + ^^^^^^^^ +14 +Stopped in Main.main, T26042a.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo +6 print a + ^^^^^^^ +7 +Stopped in Main.bar, T26042a.hs:16:17-21 +_result :: Int = _ +z :: Int = _ +15 bar :: Int -> IO Int +16 bar z = return (z * 2) + ^^^^^ +17 +Stopped in Main.foo, T26042a.hs:12:13-17 +_result :: Int = _ +x :: Int = _ +y :: Int = _ +11 y = 4 +12 b <- bar (x + y) + ^^^^^ +13 return b +Stopped in Main.foo.x, T26042a.hs:10:11 +_result :: Int = _ +9 foo = do +10 let x = 3 + ^ +11 y = 4 +Stopped in Main.foo.y, T26042a.hs:11:11 +_result :: Int = _ +10 let x = 3 +11 y = 4 + ^ +12 b <- bar (x + y) +14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.hs ===================================== @@ -0,0 +1,22 @@ +module Main where + +main :: IO () +main = do + a <- foo False undefined + print a + +foo :: Bool -> Int -> IO Int +foo True i = return i +foo False _ = do + let x = 3 + y = 4 + n <- bar (x + y) + return n + +bar :: Int -> IO Int +bar z = do + let t = z * 2 + y <- foo True t + return y + + ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.script ===================================== @@ -0,0 +1,16 @@ +:load T26042b.hs +-- break on the True branch of foo +:break 9 +main +:list +-- stepout of foo True to caller (ie bar) +:stepout +:list +-- stepout of bar (to branch of foo False, where bar was called) +:stepout +:list +-- stepout to right after the call to foo False in main +:stepout +:list +-- done +:continue ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.stdout ===================================== @@ -0,0 +1,30 @@ +Breakpoint 0 activated at T26042b.hs:9:15-22 +Stopped in Main.foo, T26042b.hs:9:15-22 +_result :: IO Int = _ +i :: Int = _ +8 foo :: Bool -> Int -> IO Int +9 foo True i = return i + ^^^^^^^^ +10 foo False _ = do +Stopped in Main.bar, T26042b.hs:20:3-10 +_result :: IO Int = _ +y :: Int = _ +19 y <- foo True t +20 return y + ^^^^^^^^ +21 +Stopped in Main.foo, T26042b.hs:14:3-10 +_result :: IO Int = _ +n :: Int = _ +13 n <- bar (x + y) +14 return n + ^^^^^^^^ +15 +Stopped in Main.main, T26042b.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo False undefined +6 print a + ^^^^^^^ +7 +14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.hs ===================================== @@ -0,0 +1,19 @@ +module Main where + +main :: IO () +main = do + a <- foo False undefined + print a + +foo :: Bool -> Int -> IO Int +foo True i = return i +foo False _ = do + let x = 3 + y = 4 + bar (x + y) + +bar :: Int -> IO Int +bar z = do + let t = z * 2 + foo True t + ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.script ===================================== @@ -0,0 +1,24 @@ +:load T26042c.hs +-- similar to T26042b, but uses tail calls +-- recall: for step-out, we skip the caller of tail calls +-- (because we don't push a stack frame for tail calls, so +-- there's no RET instruction to stop after) + +-- break on foo True branch +:break 9 +main +:list +-- step out of foo True and observe that we have skipped its call in bar, +-- and the call of bar in foo False. +-- we go straight to `main`. +:stepout +:list +-- stepping out from here will jump into the thunk because it's where we'll +-- go after returning. +:stepout +:list +-- and so on +:stepout +:list +-- finish +:continue ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.stdout ===================================== @@ -0,0 +1,31 @@ +Breakpoint 0 activated at T26042c.hs:9:15-22 +Stopped in Main.foo, T26042c.hs:9:15-22 +_result :: IO Int = _ +i :: Int = _ +8 foo :: Bool -> Int -> IO Int +9 foo True i = return i + ^^^^^^^^ +10 foo False _ = do +Stopped in Main.main, T26042c.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo False undefined +6 print a + ^^^^^^^ +7 +Stopped in Main.bar.t, T26042c.hs:17:11-15 +_result :: Int = _ +z :: Int = _ +16 bar z = do +17 let t = z * 2 + ^^^^^ +18 foo True t +Stopped in Main.foo, T26042c.hs:13:8-12 +_result :: Int = _ +x :: Int = _ +y :: Int = _ +12 y = 4 +13 bar (x + y) + ^^^^^ +14 +14 ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -144,3 +144,6 @@ test('T24306', normal, ghci_script, ['T24306.script']) test('T24712', normal, ghci_script, ['T24712.script']) test('T25109', normal, ghci_script, ['T25109.script']) test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script']) +test('T26042a', extra_files(['T26042a.hs']), ghci_script, ['T26042a.script']) +test('T26042b', extra_files(['T26042b.hs']), ghci_script, ['T26042b.script']) +test('T26042c', extra_files(['T26042c.hs']), ghci_script, ['T26042c.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cb330020a43ac0b7098744f56a6d4a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cb330020a43ac0b7098744f56a6d4a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out] debugger: Implement step-out feature
by Rodrigo Mesquita (＠alt-romes) 16 May '25

16 May '25

Rodrigo Mesquita pushed to branch wip/romes/step-out at Glasgow Haskell Compiler / GHC Commits: cb62ba50 by Rodrigo Mesquita at 2025-05-16T14:02:46+01:00 debugger: Implement step-out feature Implements support for stepping-out of a function (aka breaking right after returning from a function) in the interactive debugger. It also introduces a GHCi command :stepout to step-out of a function being debugged in the interpreter. The feature is described as: Stop at the first breakpoint immediately after returning from the current function scope. Known limitations: because a function tail-call does not push a stack frame, if step-out is used inside of a function that was tail-called, execution will not be returned to its caller, but rather its caller's first non-tail caller. On the other hand, it means the debugger follows the more realistic execution of the program. In the following example: .. code-block:: none f = do a b <--- (1) set breakpoint then step in here c b = do ... d <--- (2) step-into this tail call d = do ... something <--- (3) step-out here ... Stepping-out will stop execution at the `c` invokation in `f`, rather than stopping at `b`. The key implementation bit is simple: When step-out is set and the interpreter hits a RETURN instruction, enable "stop at the immediate next breakpoint" (aka single-step). See also `Note [Debugger Step-out]` in `rts/Interpreter.c` Note [Debugger Step-out] ~~~~~~~~~~~~~~~~~~~~~~~~ When the global debugger step-out flag is set (`rts_stop_after_return`), the interpreter must yield execution right after the first RETURN. When stepping-out, we simply enable `rts_stop_next_breakpoint` when we hit a return instruction (in `do_return_pointer` and `do_return_nonpointer`). The step-out flag is cleared and must be re-enabled explicitly to step-out again. A limitation of this approach is that stepping-out of a function that was tail-called will skip its caller since no stack frame is pushed for a tail call (i.e. a tail call returns directly to its caller's first non-tail caller). Fixes #26042 - - - - - 20 changed files: - compiler/GHC/Driver/Config.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/stg/MiscClosures.h - + testsuite/tests/ghci.debugger/scripts/T26042a.hs - + testsuite/tests/ghci.debugger/scripts/T26042a.script - + testsuite/tests/ghci.debugger/scripts/T26042a.stdout - + testsuite/tests/ghci.debugger/scripts/T26042b.hs - + testsuite/tests/ghci.debugger/scripts/T26042b.script - + testsuite/tests/ghci.debugger/scripts/T26042b.stdout - + testsuite/tests/ghci.debugger/scripts/T26042c.hs - + testsuite/tests/ghci.debugger/scripts/T26042c.script - + testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/all.T Changes: ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts , initEvalOpts + , EvalStep(..) ) where @@ -28,13 +29,28 @@ initSimpleOpts dflags = SimpleOpts , so_inline = True } +-- | Instruct the interpreter evaluation to break... +data EvalStep + -- | ... at every breakpoint tick + = EvalStepSingle + -- | ... after every return stmt + | EvalStepOut + -- | ... only on explicit breakpoints + | EvalStepNone + -- | Extract GHCi options from DynFlags and step -initEvalOpts :: DynFlags -> Bool -> EvalOpts +initEvalOpts :: DynFlags -> EvalStep -> EvalOpts initEvalOpts dflags step = EvalOpts { useSandboxThread = gopt Opt_GhciSandbox dflags - , singleStep = step + , singleStep = singleStep + , stepOut = stepOut , breakOnException = gopt Opt_BreakOnException dflags , breakOnError = gopt Opt_BreakOnError dflags } + where + (singleStep, stepOut) = case step of + EvalStepSingle -> (True, False) + EvalStepOut -> (False, True) + EvalStepNone -> (False, False) ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -343,7 +343,12 @@ handleRunStatus step expr bindings final_ids status history0 = do setSession hsc_env2 return (ExecBreak names Nothing) - -- Just case: we stopped at a breakpoint + -- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint + -- + -- The interpreter yields on a breakpoint if: + -- - the breakpoint was explicitly enabled (in @BreakArray@) + -- - or @singleStep = True@ in EvalOpts + -- - or @stepOut = True@ in EvalOpts EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do let ibi = evalBreakpointToId eval_break tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi) @@ -351,13 +356,14 @@ handleRunStatus step expr bindings final_ids status history0 = do span = modBreaks_locs tick_brks ! ibi_tick_index ibi decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi + -- Was the breakpoint explicitly enabled? b <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - -- This breakpoint is explicitly enabled; we want to stop - -- instead of just logging it. + -- This breakpoint is enabled or we mean to break here; + -- we want to stop instead of just logging it. if b || breakHere step span then 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 @@ -1247,7 +1253,7 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do _ -> panic "compileParsedExprRemote" updateFixityEnv fix_env - let eval_opts = initEvalOpts dflags False + let eval_opts = initEvalOpts dflags EvalStepNone status <- liftIO $ evalStmt interp eval_opts (EvalThis hvals_io) case status of EvalComplete _ (EvalSuccess [hval]) -> return hval ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -17,6 +17,7 @@ import GHC.Prelude import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) +import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id import GHC.Types.Name import GHC.Types.TyThing @@ -46,6 +47,9 @@ data SingleStep -- | :step [expr] | SingleStep + -- | :stepout [expr] + | StepOut + -- | :steplocal [expr] | LocalStep { breakAt :: SrcSpan } @@ -55,10 +59,12 @@ data SingleStep { breakAt :: SrcSpan } -- | Whether this 'SingleStep' mode requires instructing the interpreter to --- step at every breakpoint. -enableGhcStepMode :: SingleStep -> Bool -enableGhcStepMode RunToCompletion = False -enableGhcStepMode _ = True +-- step at every breakpoint or after every return (see @'EvalStep'@). +enableGhcStepMode :: SingleStep -> EvalStep +enableGhcStepMode RunToCompletion = EvalStepNone +enableGhcStepMode StepOut = EvalStepOut +-- for the remaining step modes we need to stop at every single breakpoint. +enableGhcStepMode _ = EvalStepSingle -- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return -- @True@ if based on the step-mode alone we should stop at this breakpoint. @@ -70,6 +76,7 @@ breakHere :: SingleStep -> SrcSpan -> Bool breakHere step break_span = case step of RunToCompletion -> False RunAndLogSteps -> False + StepOut -> True -- hmm. this function may not be a good abstraction? SingleStep -> True LocalStep span -> break_span `isSubspanOf` span ModuleStep span -> srcSpanFileName_maybe span == srcSpanFileName_maybe break_span ===================================== docs/users_guide/ghci.rst ===================================== @@ -2980,6 +2980,35 @@ commonly used commands. hit by an error (:ghc-flag:`-fbreak-on-error`) or an exception (:ghc-flag:`-fbreak-on-exception`). +.. ghci-cmd:: :stepout + + Stop at the first breakpoint immediately after returning from the current + function scope. + + Known limitations: because a function tail-call does not push a stack + frame, if step-out is used inside of a function that was tail-called, + execution will not be returned to its caller, but rather its caller's + first non-tail caller. On the other hand, it means the debugger + follows the more realistic execution of the program. + In the following example: + + .. code-block:: none + + f = do + a + b <--- (1) set breakpoint then step in here + c + b = do + ... + d <--- (2) step-into this tail call + d = do + ... + something <--- (3) step-out here + ... + + Stepping-out will stop execution at the `c` invokation in `f`, rather than + stopping at `b`. + .. ghci-cmd:: :stepmodule Enable only breakpoints in the current module and resume evaluation ===================================== ghc/GHCi/UI.hs ===================================== @@ -247,6 +247,7 @@ ghciCommands = map mkCmd [ ("sprint", keepGoing sprintCmd, completeExpression), ("step", keepGoing stepCmd, completeIdentifier), ("steplocal", keepGoing stepLocalCmd, completeIdentifier), + ("stepout", keepGoing stepOutCmd, completeIdentifier), ("stepmodule",keepGoing stepModuleCmd, completeIdentifier), ("type", keepGoingMulti' typeOfExpr, completeExpression), ("trace", keepGoing traceCmd, completeExpression), @@ -407,6 +408,7 @@ defFullHelpText = " :step single-step after stopping at a breakpoint\n"++ " :step <expr> single-step into <expr>\n"++ " :steplocal single-step within the current top-level binding\n"++ + " :stepout stop at the first breakpoint after returning from the current scope\n"++ " :stepmodule single-step restricted to the current module\n"++ " :trace trace after stopping at a breakpoint\n"++ " :trace <expr> evaluate <expr> with tracing on (see :history)\n"++ @@ -3793,6 +3795,12 @@ stepCmd arg = withSandboxOnly ":step" $ step arg step [] = doContinue GHC.SingleStep step expression = runStmt expression GHC.SingleStep >> return () +stepOutCmd :: GhciMonad m => String -> m () +stepOutCmd arg = withSandboxOnly ":stepout" $ step arg + where + step [] = doContinue GHC.StepOut + step expression = stepCmd expression + stepLocalCmd :: GhciMonad m => String -> m () stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg where ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -374,6 +374,7 @@ putTHMessage m = case m of data EvalOpts = EvalOpts { useSandboxThread :: Bool , singleStep :: Bool + , stepOut :: Bool , breakOnException :: Bool , breakOnError :: Bool } ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -210,6 +210,7 @@ evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts { useSandboxThread = True , singleStep = False + , stepOut = False , breakOnException = False , breakOnError = False } @@ -333,6 +334,7 @@ withBreakAction opts breakMVar statusMVar act poke breakPointIOAction stablePtr when (breakOnException opts) $ poke exceptionFlag 1 when (singleStep opts) $ setStepFlag + when (stepOut opts) $ poke stepOutFlag 1 return stablePtr -- Breaking on exceptions is not enabled by default, since it -- might be a bit surprising. The exception flag is turned off @@ -363,6 +365,7 @@ withBreakAction opts breakMVar statusMVar act resetBreakAction stablePtr = do poke breakPointIOAction noBreakStablePtr poke exceptionFlag 0 + poke stepOutFlag 0 resetStepFlag freeStablePtr stablePtr @@ -398,6 +401,7 @@ abandonStmt hvref = do foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt +foreign import ccall "&rts_stop_after_return" stepOutFlag :: Ptr CInt setStepFlag :: IO () setStepFlag = poke stepFlag 1 ===================================== rts/Interpreter.c ===================================== @@ -194,6 +194,24 @@ See also Note [Width of parameters] for some more motivation. #define WITHIN_CHUNK_BOUNDS(n, s) \ (RTS_LIKELY((StgWord*)(Sp_plusW(n)) < ((s)->stack + (s)->stack_size - sizeofW(StgUnderflowFrame)))) +// Note [Debugger Step-out] +// ~~~~~~~~~~~~~~~~~~~~~~~~ +// When the global debugger step-out flag is set (`rts_stop_after_return`), +// the interpreter must yield execution right after the first RETURN. +// +// When stepping-out, we simply enable `rts_stop_next_breakpoint` when we hit a +// return instruction (in `do_return_pointer` and `do_return_nonpointer`). +// The step-out flag is cleared and must be re-enabled explicitly to step-out again. +// +// A limitation of this approach is that stepping-out of a function that was +// tail-called will skip its caller since no stack frame is pushed for a tail +// call (i.e. a tail call returns directly to its caller's first non-tail caller). +#define CHECK_BRK_AFTER_RET() \ + if (rts_stop_after_return) \ + { \ + rts_stop_next_breakpoint = true; \ + rts_stop_after_return = false; \ + } \ /* Note [PUSH_L underflow] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -245,6 +263,7 @@ allocate_NONUPD (Capability *cap, int n_words) int rts_stop_next_breakpoint = 0; int rts_stop_on_exception = 0; +int rts_stop_after_return = 0; #if defined(INTERP_STATS) @@ -734,6 +753,8 @@ do_return_pointer: IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size)); + CHECK_BRK_AFTER_RET(); + switch (get_itbl((StgClosure *)Sp)->type) { case RET_SMALL: { @@ -883,6 +904,8 @@ do_return_nonpointer: // get the offset of the header of the next stack frame offset = stack_frame_sizeW((StgClosure *)Sp); + CHECK_BRK_AFTER_RET(); + switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) { case RET_BCO: ===================================== rts/RtsSymbols.c ===================================== @@ -908,6 +908,7 @@ extern char **environ; SymI_NeedsDataProto(rts_breakpoint_io_action) \ SymI_NeedsDataProto(rts_stop_next_breakpoint) \ SymI_NeedsDataProto(rts_stop_on_exception) \ + SymI_NeedsDataProto(rts_stop_after_return) \ SymI_HasProto(stopTimer) \ SymI_HasProto(n_capabilities) \ SymI_HasProto(max_n_capabilities) \ ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -619,6 +619,7 @@ RTS_FUN_DECL(stg_castFloatToWord32zh); // Interpreter.c extern StgWord rts_stop_next_breakpoint[]; extern StgWord rts_stop_on_exception[]; +extern StgWord rts_stop_after_return[]; extern StgWord rts_breakpoint_io_action[]; // Schedule.c ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.hs ===================================== @@ -0,0 +1,17 @@ +module Main where + +main :: IO () +main = do + a <- foo + print a + +foo :: IO Int +foo = do + let x = 3 + y = 4 + b <- bar (x + y) + return b + +bar :: Int -> IO Int +bar z = return (z * 2) + ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.script ===================================== @@ -0,0 +1,20 @@ +:load T26042a.hs +-- simple use of stepout +:break bar +main +:list +:stepout +:list +:stepout +:list +-- from here on we're going to evaluate the thunks for `a` in `print a` +:stepout +:list +:stepout +:list +:stepout +:list +:stepout +:list +-- finish execution +:stepout ===================================== testsuite/tests/ghci.debugger/scripts/T26042a.stdout ===================================== @@ -0,0 +1,50 @@ +Breakpoint 0 activated at T26042a.hs:16:9-22 +Stopped in Main.bar, T26042a.hs:16:9-22 +_result :: IO Int = _ +z :: Int = _ +15 bar :: Int -> IO Int +16 bar z = return (z * 2) + ^^^^^^^^^^^^^^ +17 +Stopped in Main.foo, T26042a.hs:13:3-10 +_result :: IO Int = _ +b :: Int = _ +12 b <- bar (x + y) +13 return b + ^^^^^^^^ +14 +Stopped in Main.main, T26042a.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo +6 print a + ^^^^^^^ +7 +Stopped in Main.bar, T26042a.hs:16:17-21 +_result :: Int = _ +z :: Int = _ +15 bar :: Int -> IO Int +16 bar z = return (z * 2) + ^^^^^ +17 +Stopped in Main.foo, T26042a.hs:12:13-17 +_result :: Int = _ +x :: Int = _ +y :: Int = _ +11 y = 4 +12 b <- bar (x + y) + ^^^^^ +13 return b +Stopped in Main.foo.x, T26042a.hs:10:11 +_result :: Int = _ +9 foo = do +10 let x = 3 + ^ +11 y = 4 +Stopped in Main.foo.y, T26042a.hs:11:11 +_result :: Int = _ +10 let x = 3 +11 y = 4 + ^ +12 b <- bar (x + y) +14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.hs ===================================== @@ -0,0 +1,22 @@ +module Main where + +main :: IO () +main = do + a <- foo False undefined + print a + +foo :: Bool -> Int -> IO Int +foo True i = return i +foo False _ = do + let x = 3 + y = 4 + n <- bar (x + y) + return n + +bar :: Int -> IO Int +bar z = do + let t = z * 2 + y <- foo True t + return y + + ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.script ===================================== @@ -0,0 +1,16 @@ +:load T26042b.hs +-- break on the True branch of foo +:break 9 +main +:list +-- stepout of foo True to caller (ie bar) +:stepout +:list +-- stepout of bar (to branch of foo False, where bar was called) +:stepout +:list +-- stepout to right after the call to foo False in main +:stepout +:list +-- done +:continue ===================================== testsuite/tests/ghci.debugger/scripts/T26042b.stdout ===================================== @@ -0,0 +1,30 @@ +Breakpoint 0 activated at T26042b.hs:9:15-22 +Stopped in Main.foo, T26042b.hs:9:15-22 +_result :: IO Int = _ +i :: Int = _ +8 foo :: Bool -> Int -> IO Int +9 foo True i = return i + ^^^^^^^^ +10 foo False _ = do +Stopped in Main.bar, T26042b.hs:20:3-10 +_result :: IO Int = _ +y :: Int = _ +19 y <- foo True t +20 return y + ^^^^^^^^ +21 +Stopped in Main.foo, T26042b.hs:14:3-10 +_result :: IO Int = _ +n :: Int = _ +13 n <- bar (x + y) +14 return n + ^^^^^^^^ +15 +Stopped in Main.main, T26042b.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo False undefined +6 print a + ^^^^^^^ +7 +14 ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.hs ===================================== @@ -0,0 +1,19 @@ +module Main where + +main :: IO () +main = do + a <- foo False undefined + print a + +foo :: Bool -> Int -> IO Int +foo True i = return i +foo False _ = do + let x = 3 + y = 4 + bar (x + y) + +bar :: Int -> IO Int +bar z = do + let t = z * 2 + foo True t + ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.script ===================================== @@ -0,0 +1,24 @@ +:load T26042c.hs +-- similar to T26042b, but uses tail calls +-- recall: for step-out, we skip the caller of tail calls +-- (because we don't push a stack frame for tail calls, so +-- there's no RET instruction to stop after) + +-- break on foo True branch +:break 9 +main +:list +-- step out of foo True and observe that we have skipped its call in bar, +-- and the call of bar in foo False. +-- we go straight to `main`. +:stepout +:list +-- stepping out from here will jump into the thunk because it's where we'll +-- go after returning. +:stepout +:list +-- and so on +:stepout +:list +-- finish +:continue ===================================== testsuite/tests/ghci.debugger/scripts/T26042c.stdout ===================================== @@ -0,0 +1,31 @@ +Breakpoint 0 activated at T26042c.hs:9:15-22 +Stopped in Main.foo, T26042c.hs:9:15-22 +_result :: IO Int = _ +i :: Int = _ +8 foo :: Bool -> Int -> IO Int +9 foo True i = return i + ^^^^^^^^ +10 foo False _ = do +Stopped in Main.main, T26042c.hs:6:3-9 +_result :: IO () = _ +a :: Int = _ +5 a <- foo False undefined +6 print a + ^^^^^^^ +7 +Stopped in Main.bar.t, T26042c.hs:17:11-15 +_result :: Int = _ +z :: Int = _ +16 bar z = do +17 let t = z * 2 + ^^^^^ +18 foo True t +Stopped in Main.foo, T26042c.hs:13:8-12 +_result :: Int = _ +x :: Int = _ +y :: Int = _ +12 y = 4 +13 bar (x + y) + ^^^^^ +14 +14 ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -144,3 +144,6 @@ test('T24306', normal, ghci_script, ['T24306.script']) test('T24712', normal, ghci_script, ['T24712.script']) test('T25109', normal, ghci_script, ['T25109.script']) test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script']) +test('T26042a', extra_files(['T26042a.hs']), ghci_script, ['T26042a.script']) +test('T26042b', extra_files(['T26042b.hs']), ghci_script, ['T26042b.script']) +test('T26042c', extra_files(['T26042c.hs']), ghci_script, ['T26042c.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb62ba5054fccd5ac49a41bfc6c6733… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb62ba5054fccd5ac49a41bfc6c6733… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23109a] Always try rules and inlining before simplifying args
by Simon Peyton Jones (＠simonpj) 16 May '25

16 May '25

Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: 29117fad by Simon Peyton Jones at 2025-05-16T07:41:41-04:00 Always try rules and inlining before simplifying args - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2349,12 +2349,15 @@ simplOutId env fun cont -- If we are not in the first iteration, we have already tried rules and inlining -- at the end of the previous iteration; no need to repeat that - ; if not (sm_first_iter (seMode env)) - then rebuildCall env arg_info cont - else +-- ; if not (sm_first_iter (seMode env)) +-- then rebuildCall env arg_info cont +-- else +-- Do this BEFORE so that we can take advantage of single-occ inlines +-- Example: T21839c which takes an extra Simplifier iteration after w/w +-- if you don't do this -- Try rewrite rules: Plan (BEFORE) in Note [When to apply rewrite rules] - do { mb_match <- if not (null rules_for_me) && + ; mb_match <- if not (null rules_for_me) && (isClassOpId fun || activeUnfolding (seMode env) fun) then tryRules env rules_for_me fun out_args else return Nothing @@ -2372,7 +2375,7 @@ simplOutId env fun cont -- Neither worked, so just rebuild rebuildCall env arg_info cont - } } } } } + } } } } --------------------------------------------------------- -- Dealing with a call site View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29117fad96e827f1768ca0ac2ba8119… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29117fad96e827f1768ca0ac2ba8119… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Add LoongArch NCG support
by Marge Bot (＠marge-bot) 16 May '25

16 May '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 652cba7e by Peng Fan at 2025-05-14T04:24:35-04:00 Add LoongArch NCG support Not supported before. - - - - - c01f4374 by Lin Runze at 2025-05-14T04:24:35-04:00 ci: Add LoongArch64 cross-compile CI for testing - - - - - ce6cf240 by Ben Gamari at 2025-05-14T04:25:18-04:00 rts/linker: Don't fail due to RTLD_NOW In !12264 we started using the NativeObj machinery introduced some time ago for loading of shared objects. One of the side-effects of this change is shared objects are now loaded eagerly (i.e. with `RTLD_NOW`). This is needed by NativeObj to ensure full visibility of the mappings of the loaded object, which is in turn needed for safe shared object unloading. Unfortunately, this change subtly regressed, causing compilation failures in some programs. Specifically, shared objects which refer to undefined symbols (e.g. which may be usually provided by either the executable image or libraries loaded via `dlopen`) will fail to load with eager binding. This is problematic as GHC loads all package dependencies while, e.g., evaluating TemplateHaskell splices. This results in compilation failures in programs depending upon (but not using at compile-time) packages with undefined symbol references. To mitigate this NativeObj now first attempts to load an object via eager binding, reverting to lazy binding (and disabling unloading) on failure. See Note [Don't fail due to RTLD_NOW]. Fixes #25943. - - - - - 88ee8bb5 by Sylvain Henry at 2025-05-14T04:26:15-04:00 Deprecate GHC.JS.Prim.Internal.Build (#23432) Deprecated as per CLC proposal 329 (https://github.com/haskell/core-libraries-committee/issues/329) - - - - - b4ed465b by Cheng Shao at 2025-05-14T04:26:57-04:00 libffi: update to 3.4.8 Bumps libffi submodule. - - - - - a3e71296 by Matthew Pickering at 2025-05-14T04:27:38-04:00 Remove leftover trace - - - - - 2d0ecdc6 by Cheng Shao at 2025-05-14T04:28:19-04:00 Revert "ci: re-enable chrome for wasm ghci browser tests" This reverts commit fee9b351fa5a35d5778d1252789eacaaf5663ae8. Unfortunately the chrome test jobs may still timeout on certain runners (e.g. OpenCape) for unknown reasons. - - - - - 3b3a5dec by Ben Gamari at 2025-05-15T16:10:01-04:00 Don't emit unprintable characters when printing Uniques When faced with an unprintable tag we now instead print the codepoint number. Fixes #25989. (cherry picked from commit e832b1fadee66e8d6dd7b019368974756f8f8c46) - - - - - d4e2fa16 by Mike Pilgrem at 2025-05-16T07:27:53-04:00 Translate iff in Haddock documentation into everyday English - - - - - 37 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/CodeGen.Platform.h - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Constants.hs - + compiler/GHC/CmmToAsm/LA64.hs - + compiler/GHC/CmmToAsm/LA64/CodeGen.hs - + compiler/GHC/CmmToAsm/LA64/Cond.hs - + compiler/GHC/CmmToAsm/LA64/Instr.hs - + compiler/GHC/CmmToAsm/LA64/Ppr.hs - + compiler/GHC/CmmToAsm/LA64/RegInfo.hs - + compiler/GHC/CmmToAsm/LA64/Regs.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - + compiler/GHC/CmmToAsm/Reg/Linear/LA64.hs - compiler/GHC/CmmToAsm/Reg/Target.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Platform/LoongArch64.hs → compiler/GHC/Platform/LA64.hs - compiler/GHC/Platform/Regs.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/ghc.cabal.in - hadrian/bindist/config.mk.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/RunTest.hs - libffi-tarballs - libraries/base/changelog.md - libraries/base/src/GHC/JS/Prim/Internal/Build.hs - libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs - rts/linker/LoadNativeObjPosix.c - testsuite/tests/rts/all.T - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/392d1ab1d46c4952cae406613ccbd2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/392d1ab1d46c4952cae406613ccbd2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ann-frame] WIP: come up with a proper API for annotateStac
by Hannes Siebenhandl (＠fendor) 16 May '25

16 May '25

Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC Commits: 7fc6bb03 by fendor at 2025-05-16T11:58:49+02:00 WIP: come up with a proper API for annotateStac - - - - - 4 changed files: - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - libraries/ghc-heap/tests/ann_frame.hs - + libraries/ghc-heap/tests/ann_frame.stdout Changes: ===================================== libraries/ghc-experimental/ghc-experimental.cabal.in ===================================== @@ -36,6 +36,7 @@ library GHC.TypeLits.Experimental GHC.TypeNats.Experimental GHC.RTS.Flags.Experimental + GHC.Stack.Annotation.Experimental GHC.Stats.Experimental Prelude.Experimental if arch(wasm32) ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -0,0 +1,47 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ImplicitParams #-} +module GHC.Stack.Annotation.Experimental where + +import Data.Typeable +import GHC.Exts +import GHC.Internal.Stack.Types + +data StackAnnotation where + StackAnnotation :: forall a. (Typeable a, Show a) => a -> StackAnnotation + +class IsStackAnnotation a where + display :: a -> String + +newtype SrcLocAnno = MkSrcLocAnno SrcLoc + +instance Show SrcLocAnno where + show (MkSrcLocAnno l) = + concat + [ srcLocPackage l + , ":" + , srcLocModule l + , " " + , srcLocFile l + , ":" + , show $ srcLocStartLine l + , "-" + , show $ srcLocStartCol l + , ":" + , show $ srcLocEndLine l + , "-" + , show $ srcLocEndCol l + ] + +annotateStackWith :: forall a b. (Typeable a, Show a) => a -> b -> b +annotateStackWith ann = + annotateStack# (StackAnnotation ann) + +annotateCallStack :: HasCallStack => a -> a +annotateCallStack = + let + cs = getCallStack ?callStack + in case cs of + [] -> id + ((_, srcLoc):_) -> annotateStackWith (MkSrcLocAnno srcLoc) ===================================== libraries/ghc-heap/tests/ann_frame.hs ===================================== @@ -20,17 +20,36 @@ annotateStack ann = annotateStack# (StackAnnotation ann) hello :: Int -> Int -> Int -hello x y = annotateStack (x,y) $ unsafePerformIO $ do +hello x y = annotateStack (x,y) $ + decodeAndPrintAnnotationFrames $ + x + y + 42 +{-# OPAQUE hello #-} + +{-# NOINLINE decodeAndPrintAnnotationFrames #-} +decodeAndPrintAnnotationFrames :: a -> a +decodeAndPrintAnnotationFrames a = unsafePerformIO $ do stack <- GHC.Stack.CloneStack.cloneMyStack decoded <- GHC.Exts.Stack.Decode.decodeStack stack - print [ show x + print [ show a | Closures.AnnFrame _ (Box ann) <- Closures.ssc_stack decoded - , StackAnnotation x <- pure $ unsafeCoerce ann + , StackAnnotation a <- pure $ unsafeCoerce ann ] - return $ x + y + 42 -{-# OPAQUE hello #-} + pure a main :: IO () -main = +main = do print $ hello 2 3 + print $ tailCallEx 4 5 + +{-# INLINE tailCallEx #-} +tailCallEx :: Int -> Int -> Int +tailCallEx a b = annotateStack "tailCallEx" $ foo a b + +{-# INLINE foo #-} +foo :: Int -> Int -> Int +foo a b = annotateStack "foo" $ bar $ a * b + +bar c = annotateStack "bar" $ + decodeAndPrintAnnotationFrames $ + c + c ===================================== libraries/ghc-heap/tests/ann_frame.stdout ===================================== @@ -0,0 +1,2 @@ +["(2,3)"] +47 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fc6bb03edccb8a06df85de26dd7853… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fc6bb03edccb8a06df85de26dd7853… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23109a] Try inlining after simplifying the arguments
by Simon Peyton Jones (＠simonpj) 16 May '25

16 May '25

Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: fb2d5dee by Simon Peyton Jones at 2025-05-15T23:17:57-04:00 Try inlining after simplifying the arguments - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -156,7 +156,7 @@ simplifyPgm logger unit_env name_ppr_ctx opts && logHasDumpFlag logger Opt_D_dump_simpl_stats) $ logDumpMsg logger "Simplifier statistics for following pass" - (vcat [text termination_msg <+> text "after" <+> ppr it_count + (vcat [text termination_msg <+> text "after" <+> ppr (it_count-1) <+> text "iterations", blankLine, pprSimplCount counts_out]) @@ -240,7 +240,8 @@ simplifyPgm logger unit_env name_ppr_ctx opts ; read_rule_env = updExternalPackageRules base_rule_env <$> read_eps_rules ; fam_envs = (eps_fam_inst_env eps, fam_inst_env) - ; simpl_env = mkSimplEnv mode fam_envs } ; + ; iter_mode = mode { sm_first_iter = iteration_no ==1 } + ; simpl_env = mkSimplEnv iter_mode fam_envs } ; -- Simplify the program ((binds1, rules1), counts1) <- ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -272,32 +272,35 @@ seUnfoldingOpts env = sm_uf_opts (seMode env) -- See Note [The environments of the Simplify pass] data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad - { sm_phase :: !CompilerPhase - , sm_names :: ![String] -- ^ Name(s) of the phase - , sm_rules :: !Bool -- ^ Whether RULES are enabled - , sm_inline :: !Bool -- ^ Whether inlining is enabled - , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled - , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? - , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options - , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled - , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + { sm_phase :: !CompilerPhase + , sm_names :: ![String] -- ^ Name(s) of the phase + , sm_first_iter :: !Bool -- ^ True <=> first iteration + -- False <=> second or subsequent iteration + , sm_rules :: !Bool -- ^ Whether RULES are enabled + , sm_inline :: !Bool -- ^ Whether inlining is enabled + , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled + , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? + , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options + , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled + , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where ppr (SimplMode { sm_phase = p , sm_names = ss - , sm_rules = r, sm_inline = i + , sm_first_iter = fi, sm_rules = r, sm_inline = i , sm_cast_swizzle = cs , sm_eta_expand = eta, sm_case_case = cc }) = text "SimplMode" <+> braces ( sep [ text "Phase =" <+> ppr p <+> brackets (text (concat $ intersperse "," ss)) <> comma + , pp_flag fi (text "first-iter") <> comma , pp_flag i (text "inline") <> comma , pp_flag r (text "rules") <> comma , pp_flag eta (text "eta-expand") <> comma ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2342,11 +2342,19 @@ simplOutId env fun cont -- Normal case for (f e1 .. en) simplOutId env fun cont - = -- Try rewrite rules: Plan (BEFORE) in Note [When to apply rewrite rules] - do { rule_base <- getSimplRules + = do { rule_base <- getSimplRules ; let rules_for_me = getRules rule_base fun + arg_info = mkArgInfo env fun rules_for_me cont out_args = contOutArgs env cont :: [OutExpr] - ; mb_match <- if not (null rules_for_me) && + + -- If we are not in the first iteration, we have already tried rules and inlining + -- at the end of the previous iteration; no need to repeat that + ; if not (sm_first_iter (seMode env)) + then rebuildCall env arg_info cont + else + + -- Try rewrite rules: Plan (BEFORE) in Note [When to apply rewrite rules] + do { mb_match <- if not (null rules_for_me) && (isClassOpId fun || activeUnfolding (seMode env) fun) then tryRules env rules_for_me fun out_args else return Nothing @@ -2357,15 +2365,13 @@ simplOutId env fun cont -- Try inlining do { logger <- getLogger - ; mb_inline <- tryInlining env logger fun cont + ; mb_inline <- tryInlining env logger fun (contArgs cont) ; case mb_inline of{ - Just expr -> do { checkedTick (UnfoldingDone fun) - ; simplExprF env expr cont } ; + Just expr -> simplExprF env expr cont ; Nothing -> -- Neither worked, so just rebuild - do { let arg_info = mkArgInfo env fun rules_for_me cont - ; rebuildCall env arg_info cont + rebuildCall env arg_info cont } } } } } --------------------------------------------------------- @@ -2438,28 +2444,39 @@ rebuildCall env fun_info ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_rules = rules }) cont - | null rules - = rebuild env (argInfoExpr fun rev_args) cont - | otherwise -- Try rules again: Plan (AFTER) in Note [When to apply rewrite rules] = do { let args = reverse rev_args - ; mb_match <- tryRules env rules fun (map argSpecArg args) - ; case mb_match of + + -- Try rules again: Plan (AFTER) in Note [When to apply rewrite rules] + ; mb_match <- if null rules + then return Nothing + else tryRules env rules fun (map argSpecArg args) + ; case mb_match of { Just (rule_arity, rhs) -> simplExprF env rhs $ - pushSimplifiedArgs env (drop rule_arity args) cont - Nothing -> rebuild env (argInfoExpr fun rev_args) cont } + pushSimplifiedArgs env (drop rule_arity args) cont ; + Nothing -> + + do { logger <- getLogger + ; mb_inline <- tryInlining env logger fun (null args, argSummaries env args, cont) + ; case mb_inline of + Just body -> simplExprF env body $ + pushSimplifiedArgs env args cont + Nothing -> rebuild env (argInfoExpr fun rev_args) cont + } } } ----------------------------------- -tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) -tryInlining env logger var cont - | Just expr <- callSiteInline env logger var lone_variable arg_infos interesting_cont - = do { dump_inline expr cont +tryInlining :: SimplEnv -> Logger -> OutId + -> (Bool, [ArgSummary], SimplCont) + -> SimplM (Maybe OutExpr) +tryInlining env logger fun (lone_variable, arg_infos, call_cont) + | Just expr <- callSiteInline env logger fun lone_variable arg_infos interesting_cont + = do { dump_inline expr call_cont + ; checkedTick (UnfoldingDone fun) ; return (Just expr) } | otherwise = return Nothing where - (lone_variable, arg_infos, call_cont) = contArgs cont interesting_cont = interestingCallContext env call_cont log_inlining doc @@ -2470,12 +2487,12 @@ tryInlining env logger var cont dump_inline unfolding cont | not (logHasDumpFlag logger Opt_D_dump_inlinings) = return () | not (logHasDumpFlag logger Opt_D_verbose_core2core) - = when (isExternalName (idName var)) $ + = when (isExternalName (idName fun)) $ log_inlining $ - sep [text "Inlining done:", nest 4 (ppr var)] + sep [text "Inlining done:", nest 4 (ppr fun)] | otherwise = log_inlining $ - sep [text "Inlining done: " <> ppr var, + sep [text "Inlining done: " <> ppr fun, nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont])] ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -24,7 +24,7 @@ module GHC.Core.Opt.Simplify.Utils ( SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv, isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, - contIsTrivial, contArgs, contIsRhs, + contIsTrivial, contArgs, contIsRhs, argSummaries, countArgs, contOutArgs, dropContArgs, mkBoringStop, mkRhsStop, mkLazyArgStop, interestingCallContext, @@ -537,15 +537,11 @@ contArgs cont lone _ = True go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k }) - = go (is_interesting arg se : args) k + = go (argSummary se arg : args) k go args (ApplyToTy { sc_cont = k }) = go args k go args (CastIt { sc_cont = k }) = go args k go args k = (False, reverse args, k) - is_interesting arg se = interestingArg se arg - -- Do *not* use short-cutting substitution here - -- because we want to get as much IdInfo as possible - contOutArgs :: SimplEnv -> SimplCont -> [OutExpr] -- Get the leading arguments from the `SimplCont`, as /OutExprs/ contOutArgs env cont @@ -887,6 +883,15 @@ strictArgContext (ArgInfo { ai_encl = encl_rules, ai_discs = discs }) -- Why NonRecursive? Becuase it's a bit like -- let a = g x in f a +argSummaries :: SimplEnv -> [ArgSpec] -> [ArgSummary] +argSummaries env args + = go args + where + env' = zapSubstEnv env -- The args are simplified already + go [] = [] + go (TyArg {} : args) = go args + go (ValArg { as_arg = arg } : args) = argSummary env' arg : go args + interestingCallContext :: SimplEnv -> SimplCont -> CallCtxt -- See Note [Interesting call context] interestingCallContext env cont @@ -990,9 +995,9 @@ rule for (*) (df d) can fire. To do this b) we say that a con-like argument (eg (df d)) is interesting -} -interestingArg :: SimplEnv -> CoreExpr -> ArgSummary +argSummary :: SimplEnv -> CoreExpr -> ArgSummary -- See Note [Interesting arguments] -interestingArg env e = go env 0 e +argSummary env e = go env 0 e where -- n is # value args to which the expression is applied go env n (Var v) @@ -1000,6 +1005,8 @@ interestingArg env e = go env 0 e DoneId v' -> go_var n v' DoneEx e _ -> go (zapSubstEnv env) n e ContEx tvs cvs ids e -> go (setSubstEnv env tvs cvs ids) n e + -- NB: substId looks up in the InScopeSet: + -- we want to get as much IdInfo as possible go _ _ (Lit l) | isLitRubbish l = TrivArg -- Leads to unproductive inlining in WWRec, #20035 ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -60,6 +60,7 @@ initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode initSimplMode dflags phase name = SimplMode { sm_names = [name] , sm_phase = phase + , sm_first_iter = True , sm_rules = gopt Opt_EnableRewriteRules dflags , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb2d5dee8f50052bb3cc0bcaec37de7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb2d5dee8f50052bb3cc0bcaec37de7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/data-namespace-specifier] 4 commits: Rename ieNameWrapper to ieLIEWrappedName
by Vladislav Zavialov (＠int-index) 15 May '25

15 May '25

Vladislav Zavialov pushed to branch wip/int-index/data-namespace-specifier at Glasgow Haskell Compiler / GHC Commits: 75581dc4 by Vladislav Zavialov at 2025-05-12T16:19:44+03:00 Rename ieNameWrapper to ieLIEWrappedName - - - - - 5e1622f6 by Vladislav Zavialov at 2025-05-12T18:32:40+03:00 Comments for the BadImportAvailTyCon case - - - - - d193cd14 by Vladislav Zavialov at 2025-05-15T15:39:44+03:00 Documentation edits - - - - - bbd4f1e2 by Vladislav Zavialov at 2025-05-16T01:16:52+03:00 Rewrite import suggestions - - - - - 14 changed files: - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/exts/explicit_namespaces.rst - testsuite/tests/rename/should_compile/T22581d.stdout - testsuite/tests/rename/should_compile/T25899d.stdout - testsuite/tests/rename/should_fail/T22581a.stderr - testsuite/tests/rename/should_fail/T22581b.stderr - + testsuite/tests/rename/should_fail/T25899f.hs - + testsuite/tests/rename/should_fail/T25899f.stderr - + testsuite/tests/rename/should_fail/T25899f_helper.hs - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -255,15 +255,15 @@ type instance XXIE (GhcPass _) = DataConCantHappen type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA -ieNameWrapper :: IE (GhcPass p) -> LIEWrappedName (GhcPass p) -ieNameWrapper (IEVar _ n _) = n -ieNameWrapper (IEThingAbs _ n _) = n -ieNameWrapper (IEThingWith _ n _ _ _) = n -ieNameWrapper (IEThingAll _ n _) = n -ieNameWrapper _ = panic "ieNameWrapper failed pattern match!" +ieLIEWrappedName :: IE (GhcPass p) -> LIEWrappedName (GhcPass p) +ieLIEWrappedName (IEVar _ n _) = n +ieLIEWrappedName (IEThingAbs _ n _) = n +ieLIEWrappedName (IEThingWith _ n _ _ _) = n +ieLIEWrappedName (IEThingAll _ n _) = n +ieLIEWrappedName _ = panic "ieLIEWrappedName failed pattern match!" ieName :: IE (GhcPass p) -> IdP (GhcPass p) -ieName = lieWrappedName . ieNameWrapper +ieName = lieWrappedName . ieLIEWrappedName ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)] ieNames (IEVar _ (L _ n) _) = [ieWrappedName n] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3294,19 +3294,46 @@ instance Diagnostic TcRnMessage where TcRnImportLookup (ImportLookupBad k _ is ie exts) -> let mod_name = moduleName $ is_mod is occ = rdrNameOcc $ ieName ie - could_remove kw = [ImportSuggestion occ $ CouldRemoveImportItemKeyword mod_name kw] + could_change_item item_suggestion = + [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | suggest_ext] ++ + [ ImportSuggestion occ $ + CouldChangeImportItem mod_name item_suggestion ] + where + suggest_ext + | ile_explicit_namespaces exts = False -- extension already on + | otherwise = + case item_suggestion of + -- ImportItemRemove* -> False + ImportItemRemoveType{} -> False + ImportItemRemoveData{} -> False + ImportItemRemovePattern{} -> False + ImportItemRemoveSubordinateType{} -> False + ImportItemRemoveSubordinateData{} -> False + -- ImportItemAdd* -> True + ImportItemAddType{} -> True in case k of - BadImportAvailVar -> could_remove ImportItemUnwantedKeywordType + BadImportAvailVar -> could_change_item ImportItemRemoveType BadImportNotExported suggs -> suggs BadImportAvailTyCon - | isSymOcc occ -> -- type operators always require the 'type' keyword - [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not (ile_explicit_namespaces exts) ] - ++ [ ImportSuggestion occ $ CouldAddTypeKeyword mod_name ] - | otherwise -> - case unLoc (ieNameWrapper ie) of - IEData{} -> could_remove ImportItemUnwantedKeywordData - IEPattern{} -> could_remove ImportItemUnwantedKeywordPattern - _ -> noHints + -- BadImportAvailTyCon means a name is available in the TcCls namespace + -- but name resolution could not use it. Possible reasons for that: + -- 1. Case (TyOp) `import M ((#))` or `import M (data (#))` + -- The user tried to import a type operator without using the `type` keyword, + -- or using a different keyword. Suggested fix: add 'type'. + -- 2. Case (DataKw) `import M (data T)` + -- The user tried to import a non-operator type constructor, but mistakenly + -- used the `data` keyword, which restricted the lookup to the value namespace. + -- Suggested fix: remove 'data'; no need to add 'type' for non-operators. + -- 3. Case (PatternKw) `import M (pattern T)` + -- Same as the (DataKw) case, mutatis mutandis. + -- Any other case would not have resulted in BadImportAvailTyCon. + | isSymOcc occ -> could_change_item ImportItemAddType -- Case (TyOp) + | otherwise -> -- Non-operator cases + case unLoc (ieLIEWrappedName ie) of + IEData{} -> could_change_item ImportItemRemoveData -- Case (DataKw) + IEPattern{} -> could_change_item ImportItemRemovePattern -- Case (PatternKw) + _ -> panic "diagnosticHints: unexpected BadImportAvailTyCon" + BadImportAvailDataCon par -> [ ImportSuggestion occ $ ImportDataCon { ies_suggest_import_from = Just mod_name @@ -3315,8 +3342,10 @@ instance Diagnostic TcRnMessage where , ies_suggest_data_keyword = ile_explicit_namespaces exts , ies_parent = par } ] BadImportNotExportedSubordinates{} -> noHints - BadImportNonTypeSubordinates{} -> noHints - BadImportNonDataSubordinates{} -> noHints + BadImportNonTypeSubordinates _ nontype1 -> + could_change_item (ImportItemRemoveSubordinateType (nameOccName . greName <$> nontype1)) + BadImportNonDataSubordinates _ nondata1 -> + could_change_item (ImportItemRemoveSubordinateData (nameOccName . greName <$> nondata1)) TcRnImportLookup{} -> noHints TcRnUnusedImport{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5841,9 +5841,9 @@ data BadImportKind | BadImportNotExportedSubordinates !GlobalRdrElt (NonEmpty FastString) -- | Incorrect @type@ keyword when importing subordinates that aren't types. | BadImportNonTypeSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt) - -- | Incorrect @type@ keyword when importing something which isn't a type. - | BadImportNonDataSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt) -- | Incorrect @data@ keyword when importing something which isn't a term. + | BadImportNonDataSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt) + -- | Incorrect @type@ keyword when importing something which isn't a type. | BadImportAvailVar deriving Generic ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -5,7 +5,7 @@ module GHC.Types.Hint ( , AvailableBindings(..) , InstantiationSuggestion(..) , LanguageExtensionHint(..) - , ImportItemUnwantedKeyword(..) + , ImportItemSuggestion(..) , ImportSuggestion(..) , HowInScope(..) , SimilarName(..) @@ -538,10 +538,13 @@ instance Outputable AssumedDerivingStrategy where -- replacing <MyStr> as necessary.) data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module -data ImportItemUnwantedKeyword = - ImportItemUnwantedKeywordType - | ImportItemUnwantedKeywordData - | ImportItemUnwantedKeywordPattern +data ImportItemSuggestion = + ImportItemRemoveType + | ImportItemRemoveData + | ImportItemRemovePattern + | ImportItemRemoveSubordinateType (NE.NonEmpty OccName) + | ImportItemRemoveSubordinateData (NE.NonEmpty OccName) + | ImportItemAddType -- | Suggest how to fix an import. data ImportSuggestion @@ -549,10 +552,8 @@ data ImportSuggestion = CouldImportFrom (NE.NonEmpty (Module, ImportedModsVal)) -- | Some module exports what we want, but we are explicitly hiding it. | CouldUnhideFrom (NE.NonEmpty (Module, ImportedModsVal)) - -- | The module exports what we want, but it isn't in the requested namespace. - | CouldRemoveImportItemKeyword ModuleName ImportItemUnwantedKeyword - -- | The module exports what we want, but it's a type and we have @ExplicitNamespaces@ on. - | CouldAddTypeKeyword ModuleName + -- | The module exports what we want, but the import item requires modification. + | CouldChangeImportItem ModuleName ImportItemSuggestion -- | Suggest importing a data constructor to bring it into scope | ImportDataCon -- | Where to suggest importing the 'DataCon' from. ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -340,27 +340,39 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods) [ quotes (ppr mod) <+> parens (text "at" <+> ppr (imv_span imv)) | (mod,imv) <- NE.toList mods ]) -pprImportSuggestion occ_name (CouldAddTypeKeyword mod) - = vcat [ text "Add the" <+> quotes (text "type") - <+> text "keyword to the import statement:" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) - ] +pprImportSuggestion occ_name (CouldChangeImportItem mod kw) + = case kw of + ImportItemRemoveType -> remove "type" + ImportItemRemoveData -> remove "data" + ImportItemRemovePattern -> remove "pattern" + ImportItemRemoveSubordinateType nontype1 -> remove_subordinate "type" (NE.toList nontype1) + ImportItemRemoveSubordinateData nondata1 -> remove_subordinate "data" (NE.toList nondata1) + ImportItemAddType -> add "type" where parens_sp d = parens (space <> d <> space) -pprImportSuggestion occ_name (CouldRemoveImportItemKeyword mod kw) - = vcat [ text "Remove the" <+> quotes (text kw_str) - <+> text "keyword from the import statement:" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (pprPrefixOcc occ_name) ] - where - parens_sp d = parens (space <> d <> space) - kw_str = case kw of - ImportItemUnwantedKeywordType -> "type" - ImportItemUnwantedKeywordData -> "data" - ImportItemUnwantedKeywordPattern -> "pattern" + remove kw = + vcat [ text "Remove the" <+> quotes (text kw) + <+> text "keyword from the import statement:" + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + import_list = parens_sp (pprPrefixOcc occ_name) + add kw = + vcat [ text "Add the" <+> quotes (text kw) + <+> text "keyword to the import statement:" + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + import_list = parens_sp (text kw <+> pprPrefixOcc occ_name) + remove_subordinate kw sub_occs = + vcat [ text "Remove the" <+> quotes (text kw) + <+> text "keyword" <> plural sub_occs + <+> text "from the subordinate import item" <> plural sub_occs <> colon + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + parent_item + | isSymOcc occ_name = text "type" <+> pprPrefixOcc occ_name + | otherwise = pprPrefixOcc occ_name + import_list = parens_sp (parent_item <+> sub_import_list) + sub_import_list = parens_sp (hsep (punctuate comma (map pprPrefixOcc sub_occs))) pprImportSuggestion dc_occ (ImportDataCon { ies_suggest_import_from = Nothing , ies_parent = parent_occ} ) = text "Import the data constructor" <+> quotes (ppr dc_occ) <+> ===================================== docs/users_guide/exts/explicit_namespaces.rst ===================================== @@ -1,17 +1,25 @@ .. _explicit-namespaces: Explicit namespaces in import/export -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +------------------------------------ .. extension:: ExplicitNamespaces - :shortdesc: Allow use of the keyword ``type`` to specify the namespace of - entries in imports and exports. + :shortdesc: Allow use of the ``type`` and ``data`` keywords to specify the namespace of + entries in import/export lists and in other contexts. :implied by: :extension:`TypeOperators`, :extension:`TypeFamilies` :since: 7.6.1 :status: Included in :extension:`GHC2024` - Enable use of explicit namespaces in module export lists, patterns, and expressions. + Enable use of explicit namespace specifiers ``type`` and ``data`` + in import declarations, module export lists, fixity declarations, + and warning/deprecation pragmas; as well as the ``type`` namespace + specifier in expressions and patterns. + +The ``type`` keyword in import/export lists +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**Since:** GHC 7.6 In an import or export list, such as :: @@ -51,17 +59,69 @@ import and export lists: The extension :extension:`ExplicitNamespaces` is implied by :extension:`TypeOperators` and (for some reason) by :extension:`TypeFamilies`. -In addition, you can prefix the name of a data constructor in an import or -export list with the keyword ``data``, to allow the import or export of a data -constructor without its parent type constructor (see :ref:`patsyn-impexp`). +The ``data`` keyword in import/export lists +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Furthermore, :extension:`ExplicitNamespaces` permits the use of the ``type`` -keyword in patterns and expressions:: +**Since:** GHC 9.14 - f (type t) x = ... -- in a pattern - r = f (type Integer) 10 -- in an expression +In an import or export list, such as :: -This is used in conjunction with :extension:`RequiredTypeArguments`. + module M( T ) where ... + import N( T ) + ... + +the entity ``T`` refers to a *type constructor*, even if there is also a data +constructor or pattern synonym of the same name. + +For a concrete example, consider the declaration ``data Proxy t = Proxy`` +and the following imports: :: + + import Data.Proxy (Proxy(Proxy)) -- imports both constructors + import Data.Proxy (Proxy(..)) -- imports both constructors + import Data.Proxy (Proxy) -- imports the type constructor only + import Data.Proxy (type Proxy) -- imports the type constructor only + +However, how would one import only the data constructor? There are two options: :: + + import Data.Proxy (data Proxy) -- imports the data constructor only + import Data.Proxy (pattern Proxy) -- imports the data constructor only + +The ``data`` keyword enables the import or export a data constructor without its +parent type constructor. + +The ``pattern`` keyword does the same, with only a few differences: + +* Required compiler versions and flags + + - ``pattern`` is provided by the :extension:`PatternSynonyms` extension and requires GHC ≥7.8 + - ``data`` is enabled by :extension:`ExplicitNamespaces` and requires GHC ≥9.14 + + See :ref:`patsyn-impexp`. + +* Restrictions on use + + - ``pattern`` is restricted to top-level imports of pattern synonyms and data + constructors: :: + + import N (pattern P) -- ok (top-level) + import N (T(pattern P)) -- error (subordinate) + import N (pattern f) -- error (term or field selector) + + - ``data`` is also permitted in subordinate import/export lists, and is + applicable to term declarations (functions and constants) and field + selectors: :: + + import N (data P) -- ok (top-level) + import N (T(data P)) -- ok (subordinate) + import N (data f) -- ok (term or field selector) + +The ``data`` keyword is preferred over ``pattern`` in import/export lists unless +there is a need to support older GHC versions. + +Explicit namespaces in fixity declarations and warning/deprecation pragmas +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**Since:** GHC 9.10 When :extension:`ExplicitNamespaces` is enabled, it is possible to use the ``type`` and ``data`` keywords to specify the namespace of the name used in @@ -79,9 +139,9 @@ type-level and term-level operators: :: Similarly, it can be used in pragmas to deprecate only one name in a namespace: :: - data Solo = MkSolo + data Solo a = MkSolo a - pattern Solo = MkSolo + pattern Solo x = MkSolo x {-# DEPRECATED data Solo "Use `MkSolo` instead" #-} type family Head xs where @@ -94,3 +154,16 @@ Similarly, it can be used in pragmas to deprecate only one name in a namespace: It is considered bad practice to use a fixity signature, ``WARNING`` pragma, or ``DEPRECATED`` pragma for a type-level name without an explicit ``type`` namespace, and doing so will become an error in a future version of GHC. + +The ``type`` keyword in expressions and patterns +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**Since:** GHC 9.10 + +Furthermore, :extension:`ExplicitNamespaces` permits the use of the ``type`` +keyword in patterns and expressions:: + + f (type t) x = ... -- in a pattern + r = f (type Integer) 10 -- in an expression + +This is used in conjunction with :extension:`RequiredTypeArguments`. ===================================== testsuite/tests/rename/should_compile/T22581d.stdout ===================================== @@ -2,4 +2,7 @@ In the import of ‘Data.Functor.Product’: a data type called ‘Product’ is exported, but its subordinate item ‘Pair’ is not in the type namespace. + Suggested fix: + Remove the ‘type’ keyword from the subordinate import item: + import Data.Functor.Product ( Product ( Pair ) ) ===================================== testsuite/tests/rename/should_compile/T25899d.stdout ===================================== @@ -2,6 +2,9 @@ In the import of ‘GHC.Generics’: a class called ‘Generic’ is exported, but its subordinate item ‘Rep’ is not in the data namespace. + Suggested fix: + Remove the ‘data’ keyword from the subordinate import item: + import GHC.Generics ( Generic ( Rep ) ) <interactive>:3:22: error: [GHC-56449] In the import of ‘GHC.Generics’: ===================================== testsuite/tests/rename/should_fail/T22581a.stderr ===================================== @@ -2,4 +2,7 @@ T22581a.hs:5:24: error: [GHC-51433] In the import of ‘T22581a_helper’: a data type called ‘T’ is exported, but its subordinate item ‘MkT’ is not in the type namespace. + Suggested fix: + Remove the ‘type’ keyword from the subordinate import item: + import T22581a_helper ( T ( MkT ) ) ===================================== testsuite/tests/rename/should_fail/T22581b.stderr ===================================== @@ -2,6 +2,9 @@ T22581b.hs:5:24: error: [GHC-51433] In the import of ‘T22581b_helper’: a data type called ‘T’ is exported, but its subordinate item ‘MkT1’ is not in the type namespace. + Suggested fix: + Remove the ‘type’ keyword from the subordinate import item: + import T22581b_helper ( T ( MkT1 ) ) T22581b.hs:5:24: error: [GHC-10237] In the import of ‘T22581b_helper’: ===================================== testsuite/tests/rename/should_fail/T25899f.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module T25899f where + +import T25899f_helper + ( T(type X, Y, type Z) + , type (#)(data F, G, data H) + ) ===================================== testsuite/tests/rename/should_fail/T25899f.stderr ===================================== @@ -0,0 +1,16 @@ +T25899f.hs:6:5: error: [GHC-51433] + In the import of ‘T25899f_helper’: + a data type called ‘T’ is exported, + but its subordinate items ‘X’, ‘Z’ are not in the type namespace. + Suggested fix: + Remove the ‘type’ keywords from the subordinate import items: + import T25899f_helper ( T ( X, Z ) ) + +T25899f.hs:7:5: error: [GHC-46557] + In the import of ‘T25899f_helper’: + a class called ‘(#)’ is exported, + but its subordinate items ‘F’, ‘H’ are not in the data namespace. + Suggested fix: + Remove the ‘data’ keywords from the subordinate import items: + import T25899f_helper ( type (#) ( F, H ) ) + ===================================== testsuite/tests/rename/should_fail/T25899f_helper.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} + +module T25899f_helper where + +data T = X | Y | Z + +class a # b where + type F a b + type G a b + type H a b ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -245,3 +245,4 @@ test('T25991b2', [extra_files(['T25991b_helper.hs'])], multimod_compile_fail, [' test('T25899e1', normal, compile_fail, ['']) test('T25899e2', normal, compile_fail, ['']) test('T25899e3', [extra_files(['T25899e_helper.hs'])], multimod_compile_fail, ['T25899e3', '-v0']) +test('T25899f', [extra_files(['T25899f_helper.hs'])], multimod_compile_fail, ['T25899f', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5da2ac8e2e4cee89643696f91cb23… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5da2ac8e2e4cee89643696f91cb23… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][ghc-9.10] 2 commits: ghcup metadata: fix debian 12+ selection logic
by Ben Gamari (＠bgamari) 15 May '25

15 May '25

Ben Gamari pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC Commits: b300f423 by Zubin Duggal at 2025-05-06T17:38:56+05:30 ghcup metadata: fix debian 12+ selection logic - - - - - e761967a by Matthew Pickering at 2025-05-06T17:39:24+05:30 ghcup-metadata: Fix use of arch argument The arch argument was ignored when making the jobname, which lead to failures when generating metadata for the alpine_3_18-aarch64 bindist. Fixes #25089 (cherry picked from commit 12d3b66cedd3c80e7c1e030238c92d26631cab8d) - - - - - 1 changed file: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -97,16 +97,16 @@ windowsArtifact = PlatformSpec ( 'x86_64-windows' , 'ghc-{version}-x86_64-unknown-mingw32' ) def fedora(n, arch='x86_64'): - return linux_platform(arch, "x86_64-linux-fedora{n}".format(n=n)) + return linux_platform(arch, "{arch}-linux-fedora{n}".format(n=n,arch=arch)) def alpine(n, arch='x86_64'): - return linux_platform(arch, "x86_64-linux-alpine{n}".format(n=n)) + return linux_platform(arch, "{arch}-linux-alpine{n}".format(n=n,arch=arch)) def rocky(n, arch='x86_64'): - return linux_platform(arch, "x86_64-linux-rocky{n}".format(n=n)) + return linux_platform(arch, "{arch}-linux-rocky{n}".format(n=n,arch=arch)) def ubuntu(n, arch='x86_64'): - return linux_platform(arch, "x86_64-linux-ubuntu{n}".format(n=n)) + return linux_platform(arch, "{arch}-linux-ubuntu{n}".format(n=n,arch=arch)) def linux_platform(arch, opsys): return PlatformSpec( opsys, 'ghc-{version}-{arch}-unknown-linux'.format(version="{version}", arch=arch) ) @@ -216,7 +216,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map) -> object: a64 = { "Linux_Debian": { "< 10": deb9 , "( >= 10 && < 11 )": deb10 , "( >= 11 && < 12 )": deb11 - , ">= 11": deb12 + , ">= 12": deb12 , "unknown_versioning": deb11 } , "Linux_Ubuntu" : { "unknown_versioning": ubuntu2004 , "( >= 16 && < 18 )": deb9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c9de16b57adcb6810d059ebd1c72d9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c9de16b57adcb6810d059ebd1c72d9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/9.10-metadata-fixes
by Ben Gamari (＠bgamari) 15 May '25

15 May '25

Ben Gamari deleted branch wip/9.10-metadata-fixes at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] Do not process CPP-style comments
by Alan Zimmerman (＠alanz) 15 May '25

15 May '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 497d6c7e by Alan Zimmerman at 2025-05-15T22:45:53+01:00 Do not process CPP-style comments - - - - - 2 changed files: - compiler/GHC/Parser/Lexer.x - utils/check-cpp/Main.hs Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -273,7 +273,7 @@ $tab { warnTab } -- set. "{-" / { isNormalComment } { nested_comment } -"/*" / { ifExtension GhcCppBit } { nested_comment } +-- "/*" / { ifExtension GhcCppBit } { nested_comment } -- Single-line comments are a bit tricky. Haskell 98 says that two or -- more dashes followed by a symbol should be parsed as a varsym, so we @@ -1587,6 +1587,16 @@ nested_doc_comment span buf _len _buf2 = {-# SCC "nested_doc_comment" #-} withLe dropTrailingDec "-}" = "" dropTrailingDec (x:xs) = x:dropTrailingDec xs +-- TODO:AZ delete this +nested_cpp_comment :: Action p +nested_cpp_comment span buf len _buf2 = {-# SCC "nested_comment" #-} do + l <- getLastLocIncludingComments + let endComment input (L _ comment) = commentEnd lexToken input (Nothing, ITblockComment comment l) buf span + input <- getInput + -- Include decorator in comment + let start_decorator = reverse $ lexemeToString buf len + nested_cpp_comment_logic endComment start_decorator input span + {-# INLINE nested_comment_logic #-} -- | Includes the trailing '-}' decorators -- drop the last two elements with the callback if you don't want them to be included @@ -1597,6 +1607,41 @@ nested_comment_logic -> PsSpan -> P p (PsLocated Token) nested_comment_logic endComment commentAcc input span = go commentAcc (1::Int) input + where + go commentAcc 0 input@(AI end_loc _) = do + let comment = reverse commentAcc + cspan = mkSrcSpanPs $ mkPsSpan (psSpanStart span) end_loc + lcomment = L cspan comment + endComment input lcomment + go commentAcc n input = ghcCppSet >>= \ghcCppSet -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('-',input) -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}' + Just (_,_) -> go ('-':commentAcc) n input + Just ('\123',input) -> case alexGetChar' input of -- '{' char + Nothing -> errBrace input (psRealSpan span) + Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input + Just (_,_) -> go ('\123':commentAcc) n input + -- See Note [Nested comment line pragmas] + Just ('\n',input) -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input + go (parsedAcc ++ '\n':commentAcc) n input + Just (_,_) -> go ('\n':commentAcc) n input + Just (c,input) -> go (c:commentAcc) n input + +-- TODO:AZ delete this +{-# INLINE nested_cpp_comment_logic #-} +-- | Includes the trailing '*/' decorators +-- drop the last two elements with the callback if you don't want them to be included +nested_cpp_comment_logic + :: (AlexInput -> Located String -> P p (PsLocated Token)) -- ^ Continuation that gets the rest of the input and the lexed comment + -> String -- ^ starting value for accumulator (reversed) - When we want to include a decorator '/*' in the comment + -> AlexInput + -> PsSpan + -> P p (PsLocated Token) +nested_cpp_comment_logic endComment commentAcc input span = go commentAcc (1::Int) input where go commentAcc 0 input@(AI end_loc _) = do let comment = reverse commentAcc @@ -1629,6 +1674,7 @@ nested_comment_logic endComment commentAcc input span = go commentAcc (1::Int) i Just (_,_) -> go ('\n':commentAcc) n input (_, Just (c,input)) -> go (c:commentAcc) n input + ghcCppSet :: P p Bool ghcCppSet = do exts <- getExts ===================================== utils/check-cpp/Main.hs ===================================== @@ -868,13 +868,13 @@ t38 = do , "buildg = 1" ] --- t39 :: IO () --- t39 = do --- dump --- [ "{-# LANGUAGE GHC_CPP #-}" --- , "{- WARNING! Do not edit!!!" --- , " This code is autogenerated from src/data/*.txt! -}" --- , "module Example16 where" --- , "x='a'" --- , "" --- ] +t39 :: IO () +t39 = do + dump + [ "{-# LANGUAGE GHC_CPP #-}" + , "{- WARNING! Do not edit!!!" + , " This code is autogenerated from src/data/*.txt! -}" + , "module Example16 where" + , "x='a'" + , "" + ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/497d6c7e1af9df6b9712a2e50af0481… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/497d6c7e1af9df6b9712a2e50af0481… You're receiving this email because of your account on gitlab.haskell.org.

1 0