From 9c0bcabf7db6d301d23a00a51667d72396c2fcae Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Mon, 20 Apr 2026 11:19:29 -0400 Subject: [PATCH 1/2] parse-formatter-pattern: remove a lot of code duplication (SEE NOTE!) This is technically an incompatible change in that `%{severity}` now logs the single letter severity instead of the long for (DEBUG etc). I'm going to be lazy and treat this as compatible because so few libraries use logging and I happen to know that they don't parse the log output. I just don't think there's much call for long-form severity. --- logging.dylan | 174 ++++++++++++++------------------- tests/logging-test-suite.dylan | 2 +- 2 files changed, 76 insertions(+), 100 deletions(-) diff --git a/logging.dylan b/logging.dylan index afe12ab..90c8aaf 100644 --- a/logging.dylan +++ b/logging.dylan @@ -829,108 +829,84 @@ define method parse-formatter-pattern index := idx; char := next-char(); end; - local method pad (string :: ) - let len :: = string.size; - if (width <= len) - string + let directive-arg = #f; + local + method pad (string :: ) + // Not worth adding a dependency on the strings library for this. + let len :: = string.size; + if (width <= len) + string + else + let fill :: = make(, size: width - len, fill: ' '); + if (align == #"left") + concatenate(string, fill) + else + concatenate(fill, string) + end + end + end, + method %%date (#rest ignore) + pad(if (directive-arg) + format-date(directive-arg, current-date()) else - let fill :: = make(, size: width - len, fill: ' '); - if (align == #"left") - concatenate(string, fill) - else - concatenate(fill, string) - end - end - end method; - local method parse-long-format-control () - let bpos = index; - while (~member?(peek-char(), ":}")) next-char() end; - let word = copy-sequence(pattern, start: bpos, end: index); - let arg = #f; - if (pattern[index] == ':') - next-char(); - let start = index; - while(peek-char() ~= '}') next-char() end; - arg := copy-sequence(pattern, start: start, end: index); - end; - next-char(); // eat '}' - select (word by \=) - "date" => - method (#rest args) - pad(if (arg) - format-date(arg, current-date()) - else - as-iso8601-string(current-date()) - end) - end; - "level" => // deprecated, use "severity" - method (level, target, object, args) - pad(level-name(level)) - end; - "severity" => - // Would be nice to do this padding at compile time since the severity - // level is explicit in the log-info etc call. Just pass the level to - // this function (parse-formatter-pattern). - method (level, target, object, args) - pad(level-name(level)) - end; - "message" => - method (level, target, object, args) - write-message(target, object, args); - #f - end; - "pid" => - method (#rest args) - pad(integer-to-string(current-process-id())); - end; - "millis" => - method (#rest args) - pad(number-to-string(elapsed-milliseconds())); - end; - "thread" => - method (#rest args) - pad(thread-name(current-thread()) - | number-to-string(current-thread-id())); - end; - otherwise => - // Unknown control string. Just output the text we've seen... - copy-sequence(pattern, start: start, end: index); - end select; - end method; + as-iso8601-string(current-date()) + end) + end, + method %%severity (level, target, object, args) + // Would be nice to do this padding at compile time since the severity level is + // explicit in the log-info etc call. Just pass the level to this function + // (parse-formatter-pattern). + pad(level-short-name(level)) + end, + method %%message (level, target, object, args) + write-message(target, object, args); + #f + end, + method %%process (#rest args) + pad(integer-to-string(current-process-id())); + end, + method %%milliseconds (#rest args) + pad(number-to-string(elapsed-milliseconds())); + end, + method %%thread (#rest args) + pad(thread-name(current-thread()) + | number-to-string(current-thread-id())); + end, + method parse-long-format-control () + let bpos = index; + while (~member?(peek-char(), ":}")) next-char() end; + let word = copy-sequence(pattern, start: bpos, end: index); + if (pattern[index] == ':') + next-char(); + let start = index; + while(peek-char() ~= '}') next-char() end; + directive-arg := copy-sequence(pattern, start: start, end: index); + end; + next-char(); // eat '}' + select (word by \=) + "date" => %%date; + "level" => %%severity; // deprecated, use "severity" + "severity" => %%severity; + "message" => %%message; + "pid" => %%process; + "millis" => %%milliseconds; + "thread" => %%thread; + otherwise => + // Unknown control string. Just output the text we've seen... + copy-sequence(pattern, start: start, end: index); + end select + end method; add!(result, select (char) - '{' => parse-long-format-control(); - 'd' => - method (#rest args) - pad(as-iso8601-string(current-date())); - end; - 'l', 'L' => - method (level, target, object, args) - pad(level-name(level)) - end; - 'm' => - method (level, target, object, args) - write-message(target, object, args); - #f - end; - 'p' => - method (#rest args) - pad(integer-to-string(current-process-id())); - end; - 'r' => - method (#rest args) - pad(number-to-string(elapsed-milliseconds())); - end; - 's' => - method (level, target, object, args) - pad(level-short-name(level)) - end; - 't' => - method (#rest args) - pad(thread-name(current-thread()) - | number-to-string(current-thread-id())); - end; - '%' => pad("%"); + '{' => parse-long-format-control(); + 'd' => %%date; + 'l', 'L' => %%severity; + 'm' => %%message; + 'p' => %%process; + 'r' => %%milliseconds; + 's' => %%severity; + 't' => %%thread; + '%' => pad("%"); otherwise => // Unknown control char. Just output the text we've seen... copy-sequence(pattern, start: start, end: index); diff --git a/tests/logging-test-suite.dylan b/tests/logging-test-suite.dylan index 04b8195..e8d6824 100644 --- a/tests/logging-test-suite.dylan +++ b/tests/logging-test-suite.dylan @@ -145,7 +145,7 @@ define test test-format-severity () log-warning("x"); log-error("x"); end; - assert-equal("T TRACE\nD DEBUG\nI INFO\nW WARNING\nE ERROR\n", + assert-equal("T T\nD D\nI I\nW W\nE E\n", stream-contents(target.target-stream)) end test; From 6f4ed6665e42806b73a69a6e38db22ec3e0fd78d Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Wed, 22 Apr 2026 12:15:49 -0400 Subject: [PATCH 2/2] Rewrite parse-formatter-pattern using forward-iteration-protocol This should continue to work once we have Unicode, although the use of `` should be replaced with `` (or whatever the ultimate name of the class is). There's an incompatible change here: rather than passing through an invalid pattern such as `%X` we allow it to fall through the `select` cases and signal an error. This is better for maintaining backward compatibility in the long run if new pattern directives are added. --- logging.dylan | 134 ++++++++++++++++++++++---------------------------- 1 file changed, 60 insertions(+), 74 deletions(-) diff --git a/logging.dylan b/logging.dylan index 90c8aaf..009aa56 100644 --- a/logging.dylan +++ b/logging.dylan @@ -770,79 +770,66 @@ define method pattern-to-stream end; end method pattern-to-stream; -// Parse a string of the form "%{r} blah %{m} ..." into a list of functions -// and/or strings. The functions can be called with no arguments and return -// strings. The concatenation of all the resulting strings is the log message. -// (The concatenation needn't ever be done if writing to a stream, but I do -// wonder which would be faster, concatenation or multiple stream writes. -// Might be worth benchmarking at some point.) +// Parse a string of the form "%{r} blah %{m} ..." into a list of functions and/or +// strings. The functions can be called with no arguments and return strings. // +// This function could be a lot simpler. It's done this way to avoid dependencies on the +// regular-expressions and strings libraries. define method parse-formatter-pattern (pattern :: ) => (parsed :: ) let result :: = make(); block (exit) - let dispatch-char :: = '%'; - let index :: = 0; - let control-size :: = pattern.size; - local method next-char () => (char :: ) - if (index >= control-size) - logging-error("Log format control string ended prematurely: %s", - pattern); - else - let char = pattern[index]; - index := index + 1; - char - end - end method; - local method peek-char () => (char :: false-or()) - if (index < control-size) - pattern[index] - end - end; - while (index < control-size) - // Skip to dispatch char. - for (i :: = index then (i + 1), - until: ((i == control-size) - | (pattern[i] == dispatch-char))) - finally - if (i ~== index) - add!(result, copy-sequence(pattern, start: index, end: i)); + let (state, limit, next-state, finished-state?, ignored-current-key, current-element) + = forward-iteration-protocol(pattern); + local + method peek () => (char :: false-or()) + if (~finished-state?(pattern, state, limit)) + current-element(pattern, state) + end + end method, + method consume () => (char :: ) + if (finished-state?(pattern, state, limit)) + logging-error("Log format control string ended prematurely: %s", pattern); end; - if (i == control-size) - exit(); - else - index := i + 1; - end; - end for; - let start :: = index; - let align :: = #"right"; - let width :: = 0; - let char = next-char(); - if (char == '-') - align := #"left"; - char := next-char(); - end; - if (member?(char, "0123456789")) - let (wid, idx) = string-to-integer(pattern, start: index - 1); - width := wid; - index := idx; - char := next-char(); - end; + let char = current-element(pattern, state); + state := next-state(pattern, state); + char + end method, + method read-until (fn :: , #key error?) + let buf = make(); + iterate loop (ch = peek()) + if (~ch & error?) + logging-error("format control string ended prematurely: %s", pattern); + end; + if (~ch | fn(ch)) + ch & consume(); + values(as(, buf), ch) + else + add!(buf, consume()); + loop(peek()) + end + end + end method; + while (~finished-state?(pattern, state, limit)) let directive-arg = #f; + let width :: = 0; + let align = #"right"; local method pad (string :: ) - // Not worth adding a dependency on the strings library for this. let len :: = string.size; if (width <= len) string else - let fill :: = make(, size: width - len, fill: ' '); + let buf = make(); if (align == #"left") - concatenate(string, fill) + concatenate!(buf, string); + for (i from 1 to width - len) add!(buf, ' ') end; else - concatenate(fill, string) - end + for (i from 1 to width - len) add!(buf, ' ') end; + concatenate!(buf, string); + end; + as(, buf) end end, method %%date (#rest ignore) @@ -873,16 +860,10 @@ define method parse-formatter-pattern | number-to-string(current-thread-id())); end, method parse-long-format-control () - let bpos = index; - while (~member?(peek-char(), ":}")) next-char() end; - let word = copy-sequence(pattern, start: bpos, end: index); - if (pattern[index] == ':') - next-char(); - let start = index; - while(peek-char() ~= '}') next-char() end; - directive-arg := copy-sequence(pattern, start: start, end: index); + let (word, ch) = read-until(method (c) c == ':' | c == '}' end, error?: #t); + if (ch == ':') + directive-arg := read-until(method (c) c == '}' end); end; - next-char(); // eat '}' select (word by \=) "date" => %%date; "level" => %%severity; // deprecated, use "severity" @@ -891,13 +872,21 @@ define method parse-formatter-pattern "pid" => %%process; "millis" => %%milliseconds; "thread" => %%thread; - otherwise => - // Unknown control string. Just output the text we've seen... - copy-sequence(pattern, start: start, end: index); end select - end method; + end; + let (text, ch) = read-until(method (c) c == '%' end); + add!(result, text); + ch | exit(); + if (peek() == '-') + consume(); + align := #"left"; + end; + while (peek() & member?(peek(), "0123456789")) + let digit-value = as(, consume()) - as(, '0'); + width := width * 10 + digit-value; + end; add!(result, - select (char) + select (consume()) '{' => parse-long-format-control(); 'd' => %%date; 'l', 'L' => %%severity; @@ -907,9 +896,6 @@ define method parse-formatter-pattern 's' => %%severity; 't' => %%thread; '%' => pad("%"); - otherwise => - // Unknown control char. Just output the text we've seen... - copy-sequence(pattern, start: start, end: index); end); end while; end block;