Compare commits

...

1 Commits

Author SHA1 Message Date
Joachim Breitner
1430e218f2 fix: add checkSystem calls to long-running elaboration paths
This PR adds `checkSystem` calls to several code paths that can run for
extended periods without checking for cancellation, heartbeat limits, or
stack overflow. This improves responsiveness of the cancellation mechanism
in the language server.

Affected paths:
- `simp` rewrite candidate loops (`Rewrite.lean`)
- `simpAppUsingCongr` argument traversal (`Types.lean`)
- `synthesizeSyntheticMVarsStep` mvar loop (`SyntheticMVars.lean`)
- `abstractNestedProofs` visitor (`AbstractNestedProofs.lean`)
- `transform`/`transformWithCache` visitors (`Transform.lean`)
- LCNF compiler pass runner loop (`Main.lean`)
- LCNF checker recursive traversal (`Check.lean`)
- LCNF simplifier recursive traversal (`Simp/Main.lean`)
- `whnfCore` recursive reduction loop (`WHNF.lean`)

With these changes, at a 50ms monitoring threshold across the full test suite,
the only remaining Lean-side elaborator gaps are:
- bv_decide pure computation wrapped in `IO.lazyPure` (architectural)
- Single deep `whnf` reductions from the `constructorNameAsVariable` linter (~100-180ms)

Remaining C++ gaps (type checker, interpreter module init) are tracked separately.

Found using `LEAN_CHECK_SYSTEM_INTERVAL_MS` monitoring from #13218.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
2026-04-01 11:37:52 +00:00
10 changed files with 13 additions and 2 deletions

View File

@@ -232,6 +232,7 @@ partial def checkCases (c : Cases .pure) : CheckM Unit := do
withParams params do check k
partial def check (code : Code .pure) : CheckM Unit := do
checkSystem "LCNF check"
match code with
| .let decl k => checkLetDecl decl; withFVarId decl.fvarId do check k
| .fun decl k =>

View File

@@ -188,6 +188,7 @@ where
profileitM Exception profilerName ( getOptions) do
let mut state : (pu : Purity) × Array (Decl pu) := inPhase, decls
for pass in passes do
checkSystem "LCNF compiler"
state withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
let decls withPhase pass.phase do
state.fst.withAssertPurity pass.phase.toPurity fun h => do

View File

@@ -453,6 +453,9 @@ Throws an internal interrupt exception if cancellation has been requested. The e
caught by `try catch` but is intended to be caught by `Command.withLoggingExceptions` at the top
level of elaboration. In particular, we want to skip producing further incremental snapshots after
the exception has been thrown.
Like `checkSystem` but without the global heartbeat check, for callers that have their own
heartbeat tracking (e.g. `SynthInstance`).
-/
@[inline] def checkInterrupted : CoreM Unit := do
if let some tk := ( read).cancelTk? then

View File

@@ -582,6 +582,7 @@ mutual
-- We use `filterRevM` instead of `filterM` to make sure we process the synthetic metavariables using the order they were created.
-- It would not be incorrect to use `filterM`.
let remainingPendingMVars pendingMVars.filterRevM fun mvarId => do
checkSystem "synthesize pending MVars"
-- We use `traceM` because we want to make sure the metavar local context is used to trace the message
traceM `Elab.postpone (mvarId.withContext do addMessageContext m!"resuming {mkMVar mvarId}")
let succeeded synthesizeSyntheticMVar mvarId postponeOnError runTactics

View File

@@ -70,6 +70,7 @@ structure Context where
abbrev M := ReaderT Context $ MonadCacheT ExprStructEq Expr MetaM
partial def visit (e : Expr) : M Expr := do
checkSystem "abstract nested proofs"
if e.isAtomic then
pure e
else

View File

@@ -714,7 +714,6 @@ where
set_option compiler.ignoreBorrowAnnotation true in
@[export lean_simp]
def simpImpl (e : Expr) : SimpM Result := withIncRecDepth do
checkSystem "simp"
if ( isProof e) then
return { expr := e }
trace[Meta.Tactic.simp.heads] "{repr e.toHeadIndex}"

View File

@@ -218,6 +218,7 @@ where
else
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.1.priority > e₂.1.priority
for (thm, numExtraArgs) in candidates do
checkSystem "simp"
if inErasedSet thm then continue
if rflOnly then
unless thm.rfl do
@@ -245,6 +246,7 @@ where
else
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.priority > e₂.priority
for thm in candidates do
checkSystem "simp"
unless inErasedSet thm || (rflOnly && !thm.rfl) do
let result? withNewMCtxDepth do
let val thm.getValue

View File

@@ -722,6 +722,7 @@ def simpAppUsingCongr (e : Expr) : SimpM Result := do
if i == 0 then
simp f
else
checkSystem "simp"
let i := i - 1
let .app f a := e | unreachable!
let fr visit f i

View File

@@ -50,6 +50,7 @@ partial def transform {m} [Monad m] [MonadLiftT CoreM m] [MonadControlT CoreM m]
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := CoreM) (liftM (m := ST IO.RealWorld) x) }
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
checkCache { val := e : ExprStructEq } fun _ => Core.withIncRecDepth do
Core.checkSystem "transform"
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
match ( post e) with
| .done e => pure e
@@ -107,6 +108,7 @@ partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := MetaM) (liftM (m := ST IO.RealWorld) x) }
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
checkCache { val := e : ExprStructEq } fun _ => Meta.withIncRecDepth do
(Core.checkSystem "transform" : MetaM Unit)
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
match ( post e) with
| .done e => pure e

View File

@@ -650,7 +650,7 @@ expand let-expressions, expand assigned meta-variables, unfold aux declarations.
partial def whnfCore (e : Expr) : MetaM Expr :=
go e
where
go (e : Expr) : MetaM Expr :=
go (e : Expr) : MetaM Expr := do
whnfEasyCases e fun e => do
trace[Meta.whnf] e
match e with