Skip to content

Commit 5b9e69e

Browse files
committed
chore: inline trace nodes
This extracts a `postCallback` helper so that only the actual callback is inlined.
1 parent e766839 commit 5b9e69e

File tree

1 file changed

+37
-28
lines changed

1 file changed

+37
-28
lines changed

src/Lean/Util/Trace.lean

Lines changed: 37 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -261,29 +261,34 @@ withTraceNode `isPosTrace (msg := (return m!"{ExceptToEmoji.toEmoji ·} checking
261261
262262
The `cls`, `collapsed`, and `tag` arguments are forwarded to the constructor of `TraceData`.
263263
-/
264+
@[inline]
264265
def 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]
287292
def 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
370375
TODO: find better name for this function.
371376
-/
377+
@[inline]
372378
def 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

397406
def addTraceAsMessages [Monad m] [MonadRef m] [MonadLog m] [MonadTrace m] : m Unit := do
398407
if trace.profiler.output.get? (← getOptions) |>.isSome then

0 commit comments

Comments
 (0)