diff options
Diffstat (limited to 'lisp/emacs-lisp/rx.el')
| -rw-r--r-- | lisp/emacs-lisp/rx.el | 47 |
1 files changed, 39 insertions, 8 deletions
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index b29b870061d..071d390f0e4 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)." (* (or (seq "[:" (+ (any "a-z")) ":]") (not (any "]")))) "]") - anything + (not (any "*+?^$[\\")) (seq "\\" (or anything (seq (any "sScC_") anything) @@ -1210,7 +1210,7 @@ unmatchable Never match anything at all. CHARCLASS Match a character from a character class. One of: alpha, alphabetic, letter Alphabetic characters (defined by Unicode). alnum, alphanumeric Alphabetic or decimal digit chars (Unicode). - digit numeric, num 0-9. + digit, numeric, num 0-9. xdigit, hex-digit, hex 0-9, A-F, a-f. cntrl, control ASCII codes 0-31. blank Horizontal whitespace (Unicode). @@ -1418,6 +1418,12 @@ into a plain rx-expression, collecting names into `rx--pcase-vars'." (cons head (mapcar #'rx--pcase-transform rest))) (_ rx))) +(defun rx--reduce-right (f l) + "Right-reduction on L by F. L must be non-empty." + (if (cdr l) + (funcall f (car l) (rx--reduce-right f (cdr l))) + (car l))) + ;;;###autoload (pcase-defmacro rx (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form. @@ -1437,12 +1443,37 @@ following constructs: construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) - `(and (pred (string-match ,regexp)) - ,@(let ((i 0)) - (mapcar (lambda (name) - (setq i (1+ i)) - `(app (match-string ,i) ,name)) - (reverse rx--pcase-vars)))))) + `(and (pred stringp) + ,(pcase (length rx--pcase-vars) + (0 + ;; No variables bound: a single predicate suffices. + `(pred (string-match ,regexp))) + (1 + ;; Create a match value that on a successful regexp match + ;; is the submatch value, 0 on failure. We can't use nil + ;; for failure because it is a valid submatch value. + `(app (lambda (s) + (if (string-match ,regexp s) + (match-string 1 s) + 0)) + (and ,(car rx--pcase-vars) (pred (not numberp))))) + (nvars + ;; Pack the submatches into a dotted list which is then + ;; immediately destructured into individual variables again. + ;; This is of course slightly inefficient. + ;; A dotted list is used to reduce the number of conses + ;; to create and take apart. + `(app (lambda (s) + (and (string-match ,regexp s) + ,(rx--reduce-right + (lambda (a b) `(cons ,a ,b)) + (mapcar (lambda (i) `(match-string ,i s)) + (number-sequence 1 nvars))))) + ,(list '\` + (rx--reduce-right + #'cons + (mapcar (lambda (name) (list '\, name)) + (reverse rx--pcase-vars)))))))))) ;; Obsolete internal symbol, used in old versions of the `flycheck' package. (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1") |