Implement per-module log levels, which were documented and were a no-op
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
tracebecause 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/operationmessage 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 moduleA 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.
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(-)src/sigil/log.sglmodified
;;; ;; Lazy macros — expressions not evaluated if level inactive;;; (log-debug* "result" value: (expensive-computation));;;;;; ;; Per-module levels. The `module:` FIELD on a call is what selects;;; ;; which level applies; a call without one uses the global level.;;; (log-configure! level: 'info modules: '(("node/tty" . trace)));;; (log-debug* "byte in" module: "node/tty" n: 1) ; emitted;;; (log-debug* "cache hit" key: "user:42") ; suppressed;;;;;; Text format and untrusted values;;; ---------------------------------;;; A text line is `TIMESTAMP [LEVEL] message key=value key=value`. ;; Utilities log-level-active? log-level-may-be-active? current-log-level log-configure-from-args!) ;;; - `level:` — symbol (`'trace`, `'debug`, `'info`, `'warn`, `'error`, `'fatal`) or number (0-5) ;;; - `format:` — `'text` or `'json` ;;; - `target:` — `'console` (stderr), an output port, or a file path string ;;; - `modules:` — alist of `(name . level)` for per-module filtering ;;; - `modules:` — alist of `(name . level)` for per-module filtering. ;;; A log call is matched to a module by its `module:` field, so ;;; `(log-configure! modules: '(("node/tty" . trace)))` affects only ;;; calls that pass `module: "node/tty"`. Calls with no `module:` ;;; field always use the global level. A module level may be more ;;; verbose than the global one — that is the point of it. ;;; ;;; ```scheme ;;; (log-configure! level: 'debug format: 'json) ;; Level Checking ;; ============================================================ ;; Resolve the level in force for a module name, falling back to the ;; global level when the module is unknown or absent. (define (module-level module) (let ((name (cond ((symbol? module) (symbol->string module)) ((string? module) module) (else #f)))) (if name (let ((hit (assoc name *log-module-levels*))) (if (and (pair? hit) (integer? (cdr hit))) (cdr hit) *log-level*)) *log-level*))) ;; The most permissive level in force anywhere: the global level, or ;; a per-module override more verbose than it. Computed fresh rather ;; than cached, so it can never go stale against a reconfiguration. (define (effective-min-level) (: -> integer?) (let loop ((rest *log-module-levels*) (best *log-level*)) (if (null? rest) best (let ((lvl (cdr (car rest)))) (loop (cdr rest) (if (and (integer? lvl) (< lvl best)) lvl best)))))) ;;; Check whether a given log level is active. ;;; ;;; Accepts a numeric level (0-5) or a symbol (`'trace`, `'debug`, etc.). ;;; Returns `#t` if messages at that level would be emitted. ;;; Accepts a numeric level (0-5) or a symbol (`'trace`, `'debug`, etc.), ;;; and optionally a module name to check against the per-module levels ;;; set by `(log-configure! modules: ...)`. Without a module name the ;;; global level is used. ;;; ;;; ```scheme ;;; (log-level-active? 'debug) ; => #t if level <= debug ;;; (log-level-active? 1) ; same as above ;;; (log-level-active? 'debug) ; => #t if global level <= debug ;;; (log-level-active? 1) ; same as above ;;; (log-level-active? 'trace "slate/io") ; => #t if that module is at trace ;;; ``` (define (log-level-active? level) (define (log-level-active? level . rest) (: (any-of symbol? integer?) any? ... -> boolean?) (let ((n (if (symbol? level) (level-name->number level) level)) (module (if (pair? rest) (car rest) #f))) (and n (>= n (module-level module))))) ;;; Check whether a level could be active for SOME module. ;;; ;;; True when the level passes the global level, or passes any ;;; per-module override. This is the conservative pre-filter used by ;;; the lazy starred macros (`log-debug*` and siblings): it must never ;;; be `#f` where a real call would have emitted, because a `#f` here ;;; suppresses the call without evaluating its arguments. The exact ;;; per-module decision is made afterwards, inside the log call itself. ;;; ;;; Exported because the lazy macros expand into it at the call site. ;;; Application code wants `log-level-active?`. (define (log-level-may-be-active? level) (: (any-of symbol? integer?) -> boolean?) (let ((n (if (symbol? level) (level-name->number level) level))) (and n (>= n *log-level*)))) (and n (>= n (effective-min-level))))) ;;; Return the current log level as a symbol. ;;; Return the current global log level as a symbol. ;;; ;;; Per-module overrides are not reflected here. ;;; ;;; ```scheme ;;; (current-log-level) ; => 'info (default) (flush-output-port port))))) ;; Parse rest args into keyword fields and dispatch. ;; ;; When no per-module levels are configured (the default) this is ;; the original global-level check. When they are, the `module:` ;; field selects which level applies; a call with no `module:` ;; field always uses the global level. (define (do-log level-num message rest-args) (when (>= level-num *log-level*) (let ((kwargs (cdr (split-keyword-args rest-args)))) (emit-log level-num message kwargs)))) (if (null? *log-module-levels*) (when (>= level-num *log-level*) (emit-log level-num message (cdr (split-keyword-args rest-args)))) (let* ((kwargs (cdr (split-keyword-args rest-args))) (hit (assq module: kwargs))) (when (>= level-num (module-level (and (pair? hit) (cdr hit)))) (emit-log level-num message kwargs))))) ;; ============================================================ ;; Log Procedures (define-syntax log-trace* (syntax-rules () ((_ msg field ...) (when (log-level-active? 0) (when (log-level-may-be-active? 0) (log-trace msg field ...))))) ;;; Log at DEBUG level, guarding evaluation of all arguments. (define-syntax log-debug* (syntax-rules () ((_ msg field ...) (when (log-level-active? 1) (when (log-level-may-be-active? 1) (log-debug msg field ...))))) ;;; Log at INFO level, guarding evaluation of all arguments. (define-syntax log-info* (syntax-rules () ((_ msg field ...) (when (log-level-active? 2) (when (log-level-may-be-active? 2) (log-info msg field ...))))) ;;; Log at WARN level, guarding evaluation of all arguments. (define-syntax log-warn* (syntax-rules () ((_ msg field ...) (when (log-level-active? 3) (when (log-level-may-be-active? 3) (log-warn msg field ...))))) ;;; Log at ERROR level, guarding evaluation of all arguments. (define-syntax log-error* (syntax-rules () ((_ msg field ...) (when (log-level-active? 4) (when (log-level-may-be-active? 4) (log-error msg field ...))))) ;;; Log at FATAL level, guarding evaluation of all arguments. (define-syntax log-fatal* (syntax-rules () ((_ msg field ...) (when (log-level-active? 5) (when (log-level-may-be-active? 5) (log-fatal msg field ...))))) ;; ============================================================test/gate-source-under-test.shmodified
}copy_suite "$REPO/test/test-log.sgl" "test-log.sgl"copy_suite "$REPO/test/uut/forgery-arms.sgl" "test-forgery.sgl"copy_suite "$REPO/test/uut/module-arms.sgl" "test-modules.sgl"echo "suites: ${SUITES[*]}"echotest/uut/module-arms.sgladded
;;; Per-module level filtering for (sigil log).;;;;;; This was DOCUMENTED and was a no-op: `log-configure! modules:` stored an;;; alist that nothing ever read, and no log call had any way to name a module.;;; The estate recorded that on 2026-08-11 and it still re-entered a task brief;;; on 2026-08-24, taken from the module's own docstring.;;;;;; The consequence that made it worth fixing rather than deleting: the Slate;;; node had to put terminal byte I/O at `trace` because the global level was;;; the only working volume control, so an operator who wants trace for ONE;;; subsystem gets every byte of every terminal.;;;;;; THE ARM THAT MATTERS IS "a module may be MORE verbose than the global;;; level", THROUGH A LAZY MACRO. Raising one subsystem is the whole feature,;;; the lazy macros are the recommended way to call, and a naive implementation;;; passes every other arm here while failing that one — because the lazy gate;;; runs before anything knows which module is being logged.(import (sigil test) (sigil log) (sigil io) (sigil string))(define (capture thunk) (let ((port (open-output-string))) (log-configure! target: port) (thunk) (get-output-string port)))(define (reset!) (log-configure! level: 'info format: 'text target: 'console modules: '()));; ============================================================;; The feature is not a no-op;; ============================================================(test-group "per-module levels change behaviour at all" (test "configuring a module below the global level suppresses its calls" (reset!) (log-configure! level: 'debug modules: '(("net" . error))) (let ((out (capture (lambda () (log-debug "chatty" module: "net"))))) (assert-equal "" out))) (test "the same call with no module configured is emitted" (reset!) (log-configure! level: 'debug) (let ((out (capture (lambda () (log-debug "chatty" module: "net"))))) (assert-true (string-contains? out "chatty")))));; ============================================================;; Raising ONE module above the global level — the Slate case;; ============================================================(test-group "a module may be more verbose than the global level" (test "eager call: a raised module emits below the global level" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-trace "byte in" module: "node/tty" n: 1))))) (assert-true (string-contains? out "byte in")))) (test "LAZY call: a raised module emits below the global level" ;; The one that a naive implementation fails. `log-trace*` expands to a ;; guard evaluated BEFORE the module is known, so that guard has to be ;; permissive enough to let a raised module through. (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty" n: 1))))) (assert-true (string-contains? out "byte in")))) (test "raising one module does NOT raise the others" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-trace* "session detail" module: "node/net"))))) (assert-equal "" out))) (test "raising one module does NOT raise calls that name no module" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-trace* "unattributed"))))) (assert-equal "" out))));; ============================================================;; Fallback and shape;; ============================================================(test-group "per-module levels: fallback and shape" (test "an unconfigured module falls back to the global level" (reset!) (log-configure! level: 'warn modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-info "ordinary" module: "node/net"))))) (assert-equal "" out)) (let ((out (capture (lambda () (log-error "bad" module: "node/net"))))) (assert-true (string-contains? out "bad")))) (test "module names may be given as symbols in the config" (reset!) (log-configure! level: 'info modules: '((node/tty . trace))) (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty"))))) (assert-true (string-contains? out "byte in")))) (test "the module: field is still emitted, so a line says where it came from" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty"))))) (assert-true (string-contains? out "module=node/tty")))) (test "clearing the module alist restores plain global filtering" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (log-configure! modules: '()) (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty"))))) (assert-equal "" out))));; ============================================================;; The two predicates;; ============================================================(test-group "level predicates" (test "log-level-active? takes an optional module name" (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (assert-true (log-level-active? 'trace "node/tty")) (assert-false (log-level-active? 'trace "node/net")) (assert-false (log-level-active? 'trace))) (test "log-level-may-be-active? is permissive across modules" ;; It must be TRUE wherever any real call would emit, or the lazy macro ;; suppresses that call without ever evaluating its arguments. (reset!) (log-configure! level: 'info modules: '(("node/tty" . trace))) (assert-true (log-level-may-be-active? 'trace)) (assert-false (log-level-active? 'trace))) (test "with no modules configured the two predicates agree" (reset!) (log-configure! level: 'warn) (assert-equal (log-level-active? 'info) (log-level-may-be-active? 'info)) (assert-equal (log-level-active? 'error) (log-level-may-be-active? 'error))));; ============================================================;; The cost, stated rather than discovered;; ============================================================(test-group "laziness under per-module levels" (test "with no modules configured, lazy args are not evaluated" (reset!) (log-configure! level: 'error) (let ((ran #f)) (log-debug* "lazy" v: (begin (set! ran #t) 1)) (assert-false ran))) (test "raising ANY module makes lazy args evaluate for that level everywhere" ;; Honest cost of the conservative pre-filter, asserted so nobody ;; discovers it in production. The call is still SUPPRESSED — only its ;; argument expressions run. (reset!) (log-configure! level: 'error modules: '(("node/tty" . debug))) (let ((ran #f)) (let ((out (capture (lambda () (log-debug* "lazy" module: "other" v: (begin (set! ran #t) 1)))))) (assert-equal "" out) (assert-true ran)))))(run-tests)