Review fixes: print fast-path + regex zero-width advance

- with-deeper-print only parameterizes the print depth when *print-level* is
  set, so printing pays no parameterize on the common nil-default path.
- re-find (the matcher) and re-seq advance past a zero-width match relative to
  the match's own start, not the search origin — a zero-width match found past
  the origin (lookahead/boundary) no longer repeats. (re-seq #"a*" "aba") now
  matches the JVM.
This commit is contained in:
Yogthos 2026-06-26 21:01:55 -04:00
parent cc26e3abba
commit 28d938c396
3 changed files with 17 additions and 6 deletions

View file

@ -205,9 +205,12 @@
(start (matcher-t-pos m)) (start (matcher-t-pos m))
(mm (and (<= start len) (irregex-search (matcher-t-irx m) str start)))) (mm (and (<= start len) (irregex-search (matcher-t-irx m) str start))))
(if mm (if mm
(let ((e (irregex-match-end-index mm 0))) (let ((ms (irregex-match-start-index mm 0))
(e (irregex-match-end-index mm 0)))
(matcher-t-last-set! m mm) (matcher-t-last-set! m mm)
(matcher-t-pos-set! m (if (> e start) e (+ start 1))) ;; advance past this match: to its end, or one past a zero-width match
;; (which may sit past the search origin, e.g. a lookahead/boundary).
(matcher-t-pos-set! m (if (> e ms) e (+ e 1)))
(irx-result mm)) (irx-result mm))
(begin (matcher-t-last-set! m #f) jolt-nil)))))) (begin (matcher-t-last-set! m #f) jolt-nil))))))
@ -227,8 +230,11 @@
(let loop ((start 0) (acc '())) (let loop ((start 0) (acc '()))
(let ((m (and (<= start len) (irregex-search irx s start)))) (let ((m (and (<= start len) (irregex-search irx s start))))
(if m (if m
(let ((e (irregex-match-end-index m 0))) (let ((ms (irregex-match-start-index m 0))
(loop (if (> e start) e (+ start 1)) (cons (irx-result m) acc))) (e (irregex-match-end-index m 0)))
;; to the match end, or one past a zero-width match (relative to its
;; own start, which may be past the search origin).
(loop (if (> e ms) e (+ e 1)) (cons (irx-result m) acc)))
(list->cseq (reverse acc))))))) (list->cseq (reverse acc)))))))
(def-var! "clojure.core" "re-pattern" jolt-re-pattern) (def-var! "clojure.core" "re-pattern" jolt-re-pattern)

View file

@ -234,10 +234,14 @@
(cond ((null? s) (reverse acc)) (cond ((null? s) (reverse acc))
((fx>=? i lim) (reverse (cons "..." acc))) ((fx>=? i lim) (reverse (cons "..." acc)))
(else (loop (cdr s) (fx+ i 1) (cons (car s) acc)))))))) (else (loop (cdr s) (fx+ i 1) (cons (car s) acc))))))))
;; bump the print depth around a collection's element rendering. ;; bump the print depth around a collection's element rendering — but only when
;; *print-level* is set, since depth is consulted only to enforce it. With the
;; common nil default this is a plain begin, so printing pays no parameterize.
(define-syntax with-deeper-print (define-syntax with-deeper-print
(syntax-rules () (syntax-rules ()
((_ body ...) (parameterize ((jolt-print-depth (fx+ (jolt-print-depth) 1))) body ...)))) ((_ body ...) (if (jolt-print-level)
(parameterize ((jolt-print-depth (fx+ (jolt-print-depth) 1))) body ...)
(begin body ...)))))
;; A host shim registers a type's str-style rendering via register-pr-str-arm! (or ;; A host shim registers a type's str-style rendering via register-pr-str-arm! (or
;; register-pr-arm! in printing.ss for both printers at once) instead of ;; register-pr-arm! in printing.ss for both printers at once) instead of

View file

@ -3277,4 +3277,5 @@
{:suite "printer / str vs print" :label "infinity inside a collection prints readably in str" :expected "true" :actual "(= \"[##Inf]\" (str [##Inf]))"} {:suite "printer / str vs print" :label "infinity inside a collection prints readably in str" :expected "true" :actual "(= \"[##Inf]\" (str [##Inf]))"}
{:suite "interop / uri equality" :label "URIs are value-equal and usable as set members" :expected "[true true]" :actual "[(= (java.net.URI. \"/\") (java.net.URI. \"/\")) (= #{(java.net.URI. \"/\")} #{(java.net.URI. \"/\")})]"} {:suite "interop / uri equality" :label "URIs are value-equal and usable as set members" :expected "[true true]" :actual "[(= (java.net.URI. \"/\") (java.net.URI. \"/\")) (= #{(java.net.URI. \"/\")} #{(java.net.URI. \"/\")})]"}
{:suite "stdlib / clojure.walk" :label "macroexpand-all expands a form" :expected "true" :actual "(do (require (quote clojure.walk)) (seq? (clojure.walk/macroexpand-all (quote (when true 1)))))"} {:suite "stdlib / clojure.walk" :label "macroexpand-all expands a form" :expected "true" :actual "(do (require (quote clojure.walk)) (seq? (clojure.walk/macroexpand-all (quote (when true 1)))))"}
{:suite "regex / re-seq zero-width" :label "a zero-width match advances by one without repeating" :expected "[\"a\" \"\" \"a\" \"\"]" :actual "(vec (re-seq #\"a*\" \"aba\"))"}
] ]