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:
parent
c1f8a870ed
commit
2bcef52895
|
@ -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)))
|
||||||
|
|
Loading…
Reference in New Issue