Commitd2f584b3Recorded25 Aug 2026Repositorysigil-log

Implement per-module log levels, which were documented and were a no-op

Message

log-configure! modules: stored an alist that nothing ever read, and no log call had any way to name a module, so the feature was inert while the module docstring and README both advertised it. The estate recorded this on 2026-08-11 and it still re-entered a task brief on 2026-08-24, taken from the docstring by someone who had no reason to doubt it.

I implemented it rather than striking the docs, for three reasons:

  • the promise already in the public API (modules: keyed by name) needed only a way for a call to name its module to become true;
  • the consequence is live -- the Slate node put terminal byte I/O at trace because the global level is the only working volume control, so an operator who wants trace for ONE subsystem gets every byte of every terminal;
  • the alternative convention, deriving a module from a subsystem/operation message prefix, is implicit, undocumented, breaks for messages with no prefix, and silently changes filtering when someone rewords a message. That is a worse trap than the one being fixed.

HOW A CALL NAMES ITS MODULE. By a module: field:

    (log-configure! level: 'info modules: '(("node/tty" . trace)))
    (log-trace* "byte in" module: "node/tty" n: 1)   ; emitted
    (log-trace* "byte out" module: "node/net")       ; suppressed
    (log-debug* "cache hit" key: "user:42")          ; suppressed, names no module

A call with no module: field always uses the global level, so nothing that exists today changes behaviour. The field is still emitted, so a line says which module it came from. Names may be strings or symbols.

THE HARD PART IS THE LAZY MACROS, and a naive implementation passes every other arm while failing the only one that matters. log-trace* expands to a guard evaluated BEFORE anything knows which module is being logged, so gating it on the global level makes a raised module unreachable through exactly the call style the library recommends. The guard is therefore log-level-may-be-active?, a conservative pre-filter that is true if the level passes the global level OR any configured module level; do-log then makes the exact per-module decision. It is computed fresh from the module alist on each call rather than cached, so it cannot go stale against a reconfiguration.

That predicate is exported because the macros expand into it at the call site. Application code wants log-level-active?, which now takes an optional module name and keeps its old meaning without one.

THE COST, asserted in a test rather than left to be discovered: raising ANY module to level N makes the argument expressions of EVERY level-N lazy call evaluate, even where the call is then suppressed. When no modules are configured -- the default -- laziness is exactly as before, and do-log keeps its original fast path.

Sabotage-tested, restores verified by sha256:

  • product layer -- reverting the library to the previous commit turns 9 of the 15 module arms red;
  • the discriminating control -- planting the NAIVE implementation (lazy macros gated on log-level-active?, everything else kept) turns the LAZY arm red and leaves the EAGER arm green, which is what shows that arm is doing real work rather than restating its neighbour.
Changed
 src/sigil/log.sgl              | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------------
 test/gate-source-under-test.sh |   1 +
 test/uut/module-arms.sgl       | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 251 insertions(+), 17 deletions(-)
Diff
src/sigil/log.sglmodified
@@ -16,6 +16,12 @@
16
;;; ;; Lazy macros — expressions not evaluated if level inactive
17
;;; (log-debug* "result" value: (expensive-computation))
18
;;;
+19
;;; ;; Per-module levels. The `module:` FIELD on a call is what selects
+20
;;; ;; which level applies; a call without one uses the global level.
+21
;;; (log-configure! level: 'info modules: '(("node/tty" . trace)))
+22
;;; (log-debug* "byte in" module: "node/tty" n: 1) ; emitted
+23
;;; (log-debug* "cache hit" key: "user:42") ; suppressed
+24
;;;
25
;;; Text format and untrusted values
26
;;; ---------------------------------
27
;;; A text line is `TIMESTAMP [LEVEL] message key=value key=value`.
@@ -61,6 +67,7 @@
67
68
;; Utilities
69
log-level-active?
+70
log-level-may-be-active?
71
current-log-level
72
log-configure-from-args!)
73
@@ -134,7 +141,12 @@
141
;;; - `level:` — symbol (`'trace`, `'debug`, `'info`, `'warn`, `'error`, `'fatal`) or number (0-5)
142
;;; - `format:` — `'text` or `'json`
143
;;; - `target:` — `'console` (stderr), an output port, or a file path string
−137
;;; - `modules:` — alist of `(name . level)` for per-module filtering
+144
;;; - `modules:` — alist of `(name . level)` for per-module filtering.
+145
;;; A log call is matched to a module by its `module:` field, so
+146
;;; `(log-configure! modules: '(("node/tty" . trace)))` affects only
+147
;;; calls that pass `module: "node/tty"`. Calls with no `module:`
+148
;;; field always use the global level. A module level may be more
+149
;;; verbose than the global one — that is the point of it.
150
;;;
151
;;; ```scheme
152
;;; (log-configure! level: 'debug format: 'json)
@@ -180,21 +192,68 @@
192
;; Level Checking
193
;; ============================================================
194
+195
;; Resolve the level in force for a module name, falling back to the
+196
;; global level when the module is unknown or absent.
+197
(define (module-level module)
+198
(let ((name (cond ((symbol? module) (symbol->string module))
+199
((string? module) module)
+200
(else #f))))
+201
(if name
+202
(let ((hit (assoc name *log-module-levels*)))
+203
(if (and (pair? hit) (integer? (cdr hit)))
+204
(cdr hit)
+205
*log-level*))
+206
*log-level*)))
+207
+208
;; The most permissive level in force anywhere: the global level, or
+209
;; a per-module override more verbose than it. Computed fresh rather
+210
;; than cached, so it can never go stale against a reconfiguration.
+211
(define (effective-min-level)
+212
(: -> integer?)
+213
(let loop ((rest *log-module-levels*) (best *log-level*))
+214
(if (null? rest)
+215
best
+216
(let ((lvl (cdr (car rest))))
+217
(loop (cdr rest)
+218
(if (and (integer? lvl) (< lvl best)) lvl best))))))
+219
220
;;; Check whether a given log level is active.
221
;;;
−185
;;; Accepts a numeric level (0-5) or a symbol (`'trace`, `'debug`, etc.).
−186
;;; Returns `#t` if messages at that level would be emitted.
+222
;;; Accepts a numeric level (0-5) or a symbol (`'trace`, `'debug`, etc.),
+223
;;; and optionally a module name to check against the per-module levels
+224
;;; set by `(log-configure! modules: ...)`. Without a module name the
+225
;;; global level is used.
226
;;;
227
;;; ```scheme
−189
;;; (log-level-active? 'debug) ; => #t if level <= debug
−190
;;; (log-level-active? 1) ; same as above
+228
;;; (log-level-active? 'debug) ; => #t if global level <= debug
+229
;;; (log-level-active? 1) ; same as above
+230
;;; (log-level-active? 'trace "slate/io") ; => #t if that module is at trace
231
;;; ```
−192
(define (log-level-active? level)
+232
(define (log-level-active? level . rest)
+233
(: (any-of symbol? integer?) any? ... -> boolean?)
+234
(let ((n (if (symbol? level) (level-name->number level) level))
+235
(module (if (pair? rest) (car rest) #f)))
+236
(and n (>= n (module-level module)))))
+237
+238
;;; Check whether a level could be active for SOME module.
+239
;;;
+240
;;; True when the level passes the global level, or passes any
+241
;;; per-module override. This is the conservative pre-filter used by
+242
;;; the lazy starred macros (`log-debug*` and siblings): it must never
+243
;;; be `#f` where a real call would have emitted, because a `#f` here
+244
;;; suppresses the call without evaluating its arguments. The exact
+245
;;; per-module decision is made afterwards, inside the log call itself.
+246
;;;
+247
;;; Exported because the lazy macros expand into it at the call site.
+248
;;; Application code wants `log-level-active?`.
+249
(define (log-level-may-be-active? level)
250
(: (any-of symbol? integer?) -> boolean?)
251
(let ((n (if (symbol? level) (level-name->number level) level)))
−195
(and n (>= n *log-level*))))
+252
(and n (>= n (effective-min-level)))))
253
−197
;;; Return the current log level as a symbol.
+254
;;; Return the current global log level as a symbol.
+255
;;;
+256
;;; Per-module overrides are not reflected here.
257
;;;
258
;;; ```scheme
259
;;; (current-log-level) ; => 'info (default)
@@ -354,10 +413,19 @@
413
(flush-output-port port)))))
414
415
;; Parse rest args into keyword fields and dispatch.
+416
;;
+417
;; When no per-module levels are configured (the default) this is
+418
;; the original global-level check. When they are, the `module:`
+419
;; field selects which level applies; a call with no `module:`
+420
;; field always uses the global level.
421
(define (do-log level-num message rest-args)
−358
(when (>= level-num *log-level*)
−359
(let ((kwargs (cdr (split-keyword-args rest-args))))
−360
(emit-log level-num message kwargs))))
+422
(if (null? *log-module-levels*)
+423
(when (>= level-num *log-level*)
+424
(emit-log level-num message (cdr (split-keyword-args rest-args))))
+425
(let* ((kwargs (cdr (split-keyword-args rest-args)))
+426
(hit (assq module: kwargs)))
+427
(when (>= level-num (module-level (and (pair? hit) (cdr hit))))
+428
(emit-log level-num message kwargs)))))
429
430
;; ============================================================
431
;; Log Procedures
@@ -427,7 +495,7 @@
495
(define-syntax log-trace*
496
(syntax-rules ()
497
((_ msg field ...)
−430
(when (log-level-active? 0)
+498
(when (log-level-may-be-active? 0)
499
(log-trace msg field ...)))))
500
501
;;; Log at DEBUG level, guarding evaluation of all arguments.
@@ -436,7 +504,7 @@
504
(define-syntax log-debug*
505
(syntax-rules ()
506
((_ msg field ...)
−439
(when (log-level-active? 1)
+507
(when (log-level-may-be-active? 1)
508
(log-debug msg field ...)))))
509
510
;;; Log at INFO level, guarding evaluation of all arguments.
@@ -445,7 +513,7 @@
513
(define-syntax log-info*
514
(syntax-rules ()
515
((_ msg field ...)
−448
(when (log-level-active? 2)
+516
(when (log-level-may-be-active? 2)
517
(log-info msg field ...)))))
518
519
;;; Log at WARN level, guarding evaluation of all arguments.
@@ -454,7 +522,7 @@
522
(define-syntax log-warn*
523
(syntax-rules ()
524
((_ msg field ...)
−457
(when (log-level-active? 3)
+525
(when (log-level-may-be-active? 3)
526
(log-warn msg field ...)))))
527
528
;;; Log at ERROR level, guarding evaluation of all arguments.
@@ -463,7 +531,7 @@
531
(define-syntax log-error*
532
(syntax-rules ()
533
((_ msg field ...)
−466
(when (log-level-active? 4)
+534
(when (log-level-may-be-active? 4)
535
(log-error msg field ...)))))
536
537
;;; Log at FATAL level, guarding evaluation of all arguments.
@@ -472,7 +540,7 @@
540
(define-syntax log-fatal*
541
(syntax-rules ()
542
((_ msg field ...)
−475
(when (log-level-active? 5)
+543
(when (log-level-may-be-active? 5)
544
(log-fatal msg field ...)))))
545
546
;; ============================================================
test/gate-source-under-test.shmodified
@@ -126,6 +126,7 @@ copy_suite() { # src-path dest-basename
126
}
127
copy_suite "$REPO/test/test-log.sgl" "test-log.sgl"
128
copy_suite "$REPO/test/uut/forgery-arms.sgl" "test-forgery.sgl"
+129
copy_suite "$REPO/test/uut/module-arms.sgl" "test-modules.sgl"
130
echo "suites: ${SUITES[*]}"
131
echo
132
test/uut/module-arms.sgladded
@@ -0,0 +1,165 @@
+1
;;; Per-module level filtering for (sigil log).
+2
;;;
+3
;;; This was DOCUMENTED and was a no-op: `log-configure! modules:` stored an
+4
;;; alist that nothing ever read, and no log call had any way to name a module.
+5
;;; The estate recorded that on 2026-08-11 and it still re-entered a task brief
+6
;;; on 2026-08-24, taken from the module's own docstring.
+7
;;;
+8
;;; The consequence that made it worth fixing rather than deleting: the Slate
+9
;;; node had to put terminal byte I/O at `trace` because the global level was
+10
;;; the only working volume control, so an operator who wants trace for ONE
+11
;;; subsystem gets every byte of every terminal.
+12
;;;
+13
;;; THE ARM THAT MATTERS IS "a module may be MORE verbose than the global
+14
;;; level", THROUGH A LAZY MACRO. Raising one subsystem is the whole feature,
+15
;;; the lazy macros are the recommended way to call, and a naive implementation
+16
;;; passes every other arm here while failing that one — because the lazy gate
+17
;;; runs before anything knows which module is being logged.
+18
+19
(import (sigil test)
+20
(sigil log)
+21
(sigil io)
+22
(sigil string))
+23
+24
(define (capture thunk)
+25
(let ((port (open-output-string)))
+26
(log-configure! target: port)
+27
(thunk)
+28
(get-output-string port)))
+29
+30
(define (reset!)
+31
(log-configure! level: 'info format: 'text target: 'console modules: '()))
+32
+33
;; ============================================================
+34
;; The feature is not a no-op
+35
;; ============================================================
+36
+37
(test-group "per-module levels change behaviour at all"
+38
(test "configuring a module below the global level suppresses its calls"
+39
(reset!)
+40
(log-configure! level: 'debug modules: '(("net" . error)))
+41
(let ((out (capture (lambda () (log-debug "chatty" module: "net")))))
+42
(assert-equal "" out)))
+43
+44
(test "the same call with no module configured is emitted"
+45
(reset!)
+46
(log-configure! level: 'debug)
+47
(let ((out (capture (lambda () (log-debug "chatty" module: "net")))))
+48
(assert-true (string-contains? out "chatty")))))
+49
+50
;; ============================================================
+51
;; Raising ONE module above the global level — the Slate case
+52
;; ============================================================
+53
+54
(test-group "a module may be more verbose than the global level"
+55
(test "eager call: a raised module emits below the global level"
+56
(reset!)
+57
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+58
(let ((out (capture (lambda () (log-trace "byte in" module: "node/tty" n: 1)))))
+59
(assert-true (string-contains? out "byte in"))))
+60
+61
(test "LAZY call: a raised module emits below the global level"
+62
;; The one that a naive implementation fails. `log-trace*` expands to a
+63
;; guard evaluated BEFORE the module is known, so that guard has to be
+64
;; permissive enough to let a raised module through.
+65
(reset!)
+66
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+67
(let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty" n: 1)))))
+68
(assert-true (string-contains? out "byte in"))))
+69
+70
(test "raising one module does NOT raise the others"
+71
(reset!)
+72
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+73
(let ((out (capture (lambda () (log-trace* "session detail" module: "node/net")))))
+74
(assert-equal "" out)))
+75
+76
(test "raising one module does NOT raise calls that name no module"
+77
(reset!)
+78
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+79
(let ((out (capture (lambda () (log-trace* "unattributed")))))
+80
(assert-equal "" out))))
+81
+82
;; ============================================================
+83
;; Fallback and shape
+84
;; ============================================================
+85
+86
(test-group "per-module levels: fallback and shape"
+87
(test "an unconfigured module falls back to the global level"
+88
(reset!)
+89
(log-configure! level: 'warn modules: '(("node/tty" . trace)))
+90
(let ((out (capture (lambda () (log-info "ordinary" module: "node/net")))))
+91
(assert-equal "" out))
+92
(let ((out (capture (lambda () (log-error "bad" module: "node/net")))))
+93
(assert-true (string-contains? out "bad"))))
+94
+95
(test "module names may be given as symbols in the config"
+96
(reset!)
+97
(log-configure! level: 'info modules: '((node/tty . trace)))
+98
(let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
+99
(assert-true (string-contains? out "byte in"))))
+100
+101
(test "the module: field is still emitted, so a line says where it came from"
+102
(reset!)
+103
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+104
(let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
+105
(assert-true (string-contains? out "module=node/tty"))))
+106
+107
(test "clearing the module alist restores plain global filtering"
+108
(reset!)
+109
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+110
(log-configure! modules: '())
+111
(let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
+112
(assert-equal "" out))))
+113
+114
;; ============================================================
+115
;; The two predicates
+116
;; ============================================================
+117
+118
(test-group "level predicates"
+119
(test "log-level-active? takes an optional module name"
+120
(reset!)
+121
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+122
(assert-true (log-level-active? 'trace "node/tty"))
+123
(assert-false (log-level-active? 'trace "node/net"))
+124
(assert-false (log-level-active? 'trace)))
+125
+126
(test "log-level-may-be-active? is permissive across modules"
+127
;; It must be TRUE wherever any real call would emit, or the lazy macro
+128
;; suppresses that call without ever evaluating its arguments.
+129
(reset!)
+130
(log-configure! level: 'info modules: '(("node/tty" . trace)))
+131
(assert-true (log-level-may-be-active? 'trace))
+132
(assert-false (log-level-active? 'trace)))
+133
+134
(test "with no modules configured the two predicates agree"
+135
(reset!)
+136
(log-configure! level: 'warn)
+137
(assert-equal (log-level-active? 'info) (log-level-may-be-active? 'info))
+138
(assert-equal (log-level-active? 'error) (log-level-may-be-active? 'error))))
+139
+140
;; ============================================================
+141
;; The cost, stated rather than discovered
+142
;; ============================================================
+143
+144
(test-group "laziness under per-module levels"
+145
(test "with no modules configured, lazy args are not evaluated"
+146
(reset!)
+147
(log-configure! level: 'error)
+148
(let ((ran #f))
+149
(log-debug* "lazy" v: (begin (set! ran #t) 1))
+150
(assert-false ran)))
+151
+152
(test "raising ANY module makes lazy args evaluate for that level everywhere"
+153
;; Honest cost of the conservative pre-filter, asserted so nobody
+154
;; discovers it in production. The call is still SUPPRESSED — only its
+155
;; argument expressions run.
+156
(reset!)
+157
(log-configure! level: 'error modules: '(("node/tty" . debug)))
+158
(let ((ran #f))
+159
(let ((out (capture (lambda ()
+160
(log-debug* "lazy" module: "other"
+161
v: (begin (set! ran #t) 1))))))
+162
(assert-equal "" out)
+163
(assert-true ran)))))
+164
+165
(run-tests)