Allow more character range patterns

* geesh/pattern.scm (ascii-lower-case, ascii-upper-case, asii-digits):
Remove variables.
(character-range): New function.
(parse-matching-bracket-expression): Use it to allow any character
range contained in one of the ASCII uppercase, ASCII lowercase, or
ASCII digits character sets.
This commit is contained in:
Timothy Sample 2018-12-04 10:03:54 -05:00
parent c1f8a870ed
commit 2bcef52895
1 changed files with 21 additions and 19 deletions

View File

@ -34,17 +34,23 @@
(end (string-length s))) (end (string-length s)))
(parse-rdelim s ":]" start end)) (parse-rdelim s ":]" start end))
(define ascii-lower-case (define character-range
(char-set->list (char-set-intersection char-set:ascii (let ((lower "abcdefghijklmnopqrstuvwxyz")
char-set:lower-case))) (upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(digits "0123456789"))
(define ascii-upper-case (lambda (start end)
(char-set->list (char-set-intersection char-set:ascii (let loop ((strs (list lower upper digits)))
char-set:upper-case))) (match strs
(() #f)
(define ascii-digits ((str . tail)
(char-set->list (char-set-intersection char-set:ascii (match (string-index str start)
char-set:digit))) (#f (loop tail))
(sindex
(match (string-index str end)
(#f (loop tail))
(eindex (if (<= sindex eindex)
(string->list str sindex (1+ eindex))
(loop tail))))))))))))
(define* (parse-matching-bracket-expression s #:optional (start 0) (define* (parse-matching-bracket-expression s #:optional (start 0)
(end (string-length s))) (end (string-length s)))
@ -75,15 +81,11 @@
(and (< (1+ i) end) (char=? (string-ref s (1+ i)) #\]))) (and (< (1+ i) end) (char=? (string-ref s (1+ i)) #\])))
(loop (1+ i) (cons #\- acc)) (loop (1+ i) (cons #\- acc))
(let ((alpha (and (pair? acc) (car acc))) (let ((alpha (and (pair? acc) (car acc)))
;; XXX: Escaped range end?
(omega (and (< (1+ i) end) (string-ref s (1+ i))))) (omega (and (< (1+ i) end) (string-ref s (1+ i)))))
(match `(,alpha . ,omega) (match (character-range alpha omega)
((#\a . #\z) (#f (throw 'pattern-range-expression))
(loop (+ i 2) (append ascii-lower-case acc))) (chrs (loop (+ i 2) (append chrs acc)))))))
((#\A . #\Z)
(loop (+ i 2) (append ascii-upper-case acc)))
((#\0 . #\9)
(loop (+ i 2) (append ascii-digits acc)))
(_ (throw 'pattern-range-expression))))))
(#\\ (if (< (1+ i) end) (#\\ (if (< (1+ i) end)
(loop (+ i 2) (cons (string-ref s (1+ i)) acc)) (loop (+ i 2) (cons (string-ref s (1+ i)) acc))
(loop (1+ i) acc))) (loop (1+ i) acc)))