@@ -261,29 +261,34 @@ withTraceNode `isPosTrace (msg := (return m!"{ExceptToEmoji.toEmoji ·} checking
261261
262262The `cls`, `collapsed`, and `tag` arguments are forwarded to the constructor of `TraceData`.
263263-/
264+ @[inline]
264265def withTraceNode [always : MonadAlwaysExcept ε m] [MonadLiftT BaseIO m] (cls : Name)
265266 (msg : Except ε α → m MessageData) (k : m α) (collapsed := true ) (tag := "" ) : m α := do
266- let _ := always.except
267267 let opts ← getOptions
268268 let clsEnabled ← isTracingEnabledFor cls
269269 unless clsEnabled || trace.profiler.get opts do
270270 return (← k)
271271 let oldTraces ← getResetTraces
272- let (res, start, stop) ← withStartStop opts <| observing k
273- let aboveThresh := trace.profiler.get opts &&
274- stop - start > trace.profiler.threshold.unitAdjusted opts
275- unless clsEnabled || aboveThresh do
276- modifyTraces (oldTraces ++ ·)
277- return (← MonadExcept.ofExcept res)
278- let ref ← getRef
279- let mut m ← try msg res catch _ => pure m! "<exception thrown while producing trace node message>"
280- let mut data := { cls, collapsed, tag }
281- if trace.profiler.get opts then
282- data := { data with startTime := start, stopTime := stop }
283- addTraceNode oldTraces data ref m
284- MonadExcept.ofExcept res
272+ let (res, start, stop) ← withStartStop opts <| let _ := always.except; observing k
273+ postCallback opts clsEnabled oldTraces msg res start stop
274+ where
275+ postCallback (opts : Options) (clsEnabled) (oldTraces) (msg) (res : Except ε α) (start stop : Float) : m α := do
276+ let _ := always.except
277+ let aboveThresh := trace.profiler.get opts &&
278+ stop - start > trace.profiler.threshold.unitAdjusted opts
279+ unless clsEnabled || aboveThresh do
280+ modifyTraces (oldTraces ++ ·)
281+ return (← MonadExcept.ofExcept res)
282+ let ref ← getRef
283+ let mut m ← try msg res catch _ => pure m! "<exception thrown while producing trace node message>"
284+ let mut data := { cls, collapsed, tag }
285+ if trace.profiler.get opts then
286+ data := { data with startTime := start, stopTime := stop }
287+ addTraceNode oldTraces data ref m
288+ MonadExcept.ofExcept res
285289
286290/-- A version of `Lean.withTraceNode` which allows generating the message within the computation. -/
291+ @[inline]
287292def withTraceNode' [MonadAlwaysExcept Exception m] [MonadLiftT BaseIO m] (cls : Name)
288293 (k : m (α × MessageData)) (collapsed := true ) (tag := "" ) : m α :=
289294 let msg := fun
@@ -369,10 +374,10 @@ the result produced by `k` into an emoji (e.g., `💥️`, `✅️`, `❌️`).
369374
370375TODO: find better name for this function.
371376-/
377+ @[inline]
372378def withTraceNodeBefore [MonadRef m] [AddMessageContext m] [MonadOptions m]
373379 [always : MonadAlwaysExcept ε m] [MonadLiftT BaseIO m] [ExceptToEmoji ε α] (cls : Name)
374- (msg : Unit → m MessageData) (k : m α) (collapsed := true ) (tag := "" ) : m α := do
375- let _ := always.except
380+ (msg : Unit -> m MessageData) (k : m α) (collapsed := true ) (tag := "" ) : m α := do
376381 let opts ← getOptions
377382 let clsEnabled ← isTracingEnabledFor cls
378383 unless clsEnabled || trace.profiler.get opts do
@@ -381,18 +386,22 @@ def withTraceNodeBefore [MonadRef m] [AddMessageContext m] [MonadOptions m]
381386 let ref ← getRef
382387 -- make sure to preserve context *before* running `k`
383388 let msg ← withRef ref do addMessageContext (← msg ())
384- let (res, start, stop) ← withStartStop opts <| observing k
385- let aboveThresh := trace.profiler.get opts &&
386- stop - start > trace.profiler.threshold.unitAdjusted opts
387- unless clsEnabled || aboveThresh do
388- modifyTraces (oldTraces ++ ·)
389- return (← MonadExcept.ofExcept res)
390- let mut msg := m! "{ ExceptToEmoji.toEmoji res} { msg} "
391- let mut data := { cls, collapsed, tag }
392- if trace.profiler.get opts then
393- data := { data with startTime := start, stopTime := stop }
394- addTraceNode oldTraces data ref msg
395- MonadExcept.ofExcept res
389+ let (res, start, stop) ← withStartStop opts <| let _ := always.except; observing k
390+ postCallback opts clsEnabled oldTraces ref msg res start stop
391+ where
392+ postCallback (opts : Options) (clsEnabled) (oldTraces) (ref) (msg : MessageData) (res : Except ε α) (start stop : Float) : m α := do
393+ let _ := always.except
394+ let aboveThresh := trace.profiler.get opts &&
395+ stop - start > trace.profiler.threshold.unitAdjusted opts
396+ unless clsEnabled || aboveThresh do
397+ modifyTraces (oldTraces ++ ·)
398+ return (← MonadExcept.ofExcept res)
399+ let mut msg := m! "{ ExceptToEmoji.toEmoji res} { msg} "
400+ let mut data := { cls, collapsed, tag }
401+ if trace.profiler.get opts then
402+ data := { data with startTime := start, stopTime := stop }
403+ addTraceNode oldTraces data ref msg
404+ MonadExcept.ofExcept res
396405
397406def addTraceAsMessages [Monad m] [MonadRef m] [MonadLog m] [MonadTrace m] : m Unit := do
398407 if trace.profiler.output.get? (← getOptions) |>.isSome then
0 commit comments