coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lua: pattern character sets [...] and [^...] +3 tests; tests reach deeper code
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-24 23:52:39 +00:00
parent 0491f061c4
commit 77f20b713d
5 changed files with 119 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
lib/lua/runtime.sx
View File

@@ -730,14 +730,76 @@
;; Match a single "pattern atom" (char or class) at src position — returns true or false.
;; pat-pos is position of the atom start. Returns the atom's length in pat (1 or 2).
(define
lua-pat-set-end
(fn (pat pat-pos)
(let ((i (+ pat-pos 1)))
(begin
(when (and (< i (len pat)) (= (char-at pat i) "^"))
(set! i (+ i 1)))
(when (and (< i (len pat)) (= (char-at pat i) "]"))
(set! i (+ i 1)))
(define
se-loop
(fn ()
(when (< i (len pat))
(let ((c (char-at pat i)))
(cond
((= c "]") nil)
((= c "%")
(begin (set! i (+ i 2)) (se-loop)))
(else
(begin (set! i (+ i 1)) (se-loop))))))))
(se-loop)
i))))
(define
lua-pat-atom-len
(fn (pat pat-pos)
(cond
((>= pat-pos (len pat)) 0)
((= (char-at pat pat-pos) "%") 2)
((= (char-at pat pat-pos) "[")
(let ((end (lua-pat-set-end pat pat-pos)))
(- (+ end 1) pat-pos)))
(else 1))))
(define
lua-pat-set-match
(fn (pat set-start sc)
(let ((i (+ set-start 1)) (negated false) (matched false))
(begin
(when (and (< i (len pat)) (= (char-at pat i) "^"))
(begin (set! negated true) (set! i (+ i 1))))
(define
sm-loop
(fn ()
(when (and (< i (len pat)) (not (= (char-at pat i) "]")))
(let ((c (char-at pat i)))
(cond
((= c "%")
(cond
((< (+ i 1) (len pat))
(begin
(when (lua-pat-class-match (char-at pat (+ i 1)) sc)
(set! matched true))
(set! i (+ i 2))
(sm-loop)))
(else (set! i (+ i 1)))))
((and (< (+ i 2) (len pat)) (= (char-at pat (+ i 1)) "-") (not (= (char-at pat (+ i 2)) "]")))
(begin
(when (and (>= sc c) (<= sc (char-at pat (+ i 2))))
(set! matched true))
(set! i (+ i 3))
(sm-loop)))
(else
(begin
(when (= sc c) (set! matched true))
(set! i (+ i 1))
(sm-loop))))))))
(sm-loop)
(if negated (not matched) matched)))))
(define
lua-pat-atom-match
(fn (pat pat-pos s s-pos)
@@ -752,6 +814,7 @@
(cond
((>= (+ pat-pos 1) (len pat)) false)
(else (lua-pat-class-match (char-at pat (+ pat-pos 1)) sc))))
((= pc "[") (lua-pat-set-match pat pat-pos sc))
(else (= pc sc))))))))
;; Match pattern against string starting at s-pos and pat-pos. Returns end-pos (inclusive+1) or -1 on no-match.