Add 'rx' pattern for pcase.
* lisp/emacs-lisp/rx.el (rx): New pcase macro. * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add unit test.
This commit is contained in:
parent
f57c710772
commit
ad4eff3b90
4 changed files with 69 additions and 1 deletions
3
etc/NEWS
3
etc/NEWS
|
@ -1555,6 +1555,9 @@ manual.
|
||||||
** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality
|
** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality
|
||||||
can be replicated simply by setting 'comment-auto-fill-only-comments'.
|
can be replicated simply by setting 'comment-auto-fill-only-comments'.
|
||||||
|
|
||||||
|
** New pcase pattern 'rx' to match against a rx-style regular
|
||||||
|
expression.
|
||||||
|
|
||||||
|
|
||||||
* Changes in Emacs 26.1 on Non-Free Operating Systems
|
* Changes in Emacs 26.1 on Non-Free Operating Systems
|
||||||
|
|
||||||
|
|
|
@ -930,6 +930,5 @@ QPAT can take the following forms:
|
||||||
((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
|
((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
|
||||||
(t (error "Unknown QPAT: %S" qpat))))
|
(t (error "Unknown QPAT: %S" qpat))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'pcase)
|
(provide 'pcase)
|
||||||
;;; pcase.el ends here
|
;;; pcase.el ends here
|
||||||
|
|
|
@ -1169,6 +1169,62 @@ enclosed in `(and ...)'.
|
||||||
(rx-to-string `(and ,@regexps) t))
|
(rx-to-string `(and ,@regexps) t))
|
||||||
(t
|
(t
|
||||||
(rx-to-string (car regexps) t))))
|
(rx-to-string (car regexps) t))))
|
||||||
|
|
||||||
|
|
||||||
|
(pcase-defmacro rx (&rest regexps)
|
||||||
|
"Build a `pcase' pattern matching `rx' regexps.
|
||||||
|
The REGEXPS are interpreted as by `rx'. The pattern matches if
|
||||||
|
the regular expression so constructed matches the object, as if
|
||||||
|
by `string-match'.
|
||||||
|
|
||||||
|
In addition to the usual `rx' constructs, REGEXPS can contain the
|
||||||
|
following constructs:
|
||||||
|
|
||||||
|
(let VAR FORM...) creates a new explicitly numbered submatch
|
||||||
|
that matches FORM and binds the match to
|
||||||
|
VAR.
|
||||||
|
(backref VAR) creates a backreference to the submatch
|
||||||
|
introduced by a previous (let VAR ...)
|
||||||
|
construct.
|
||||||
|
|
||||||
|
The VARs are associated with explicitly numbered submatches
|
||||||
|
starting from 1. Multiple occurrences of the same VAR refer to
|
||||||
|
the same submatch.
|
||||||
|
|
||||||
|
If a case matches, the match data is modified as usual so you can
|
||||||
|
use it in the case body, but you still have to pass the correct
|
||||||
|
string as argument to `match-string'."
|
||||||
|
(let* ((vars ())
|
||||||
|
(rx-constituents
|
||||||
|
`((let
|
||||||
|
,(lambda (form)
|
||||||
|
(rx-check form)
|
||||||
|
(let ((var (cadr form)))
|
||||||
|
(cl-check-type var symbol)
|
||||||
|
(let ((i (or (cl-position var vars :test #'eq)
|
||||||
|
(prog1 (length vars)
|
||||||
|
(setq vars `(,@vars ,var))))))
|
||||||
|
(rx-form `(submatch-n ,(1+ i) ,@(cddr form))))))
|
||||||
|
1 nil)
|
||||||
|
(backref
|
||||||
|
,(lambda (form)
|
||||||
|
(rx-check form)
|
||||||
|
(rx-backref
|
||||||
|
`(backref ,(let ((var (cadr form)))
|
||||||
|
(if (integerp var) var
|
||||||
|
(1+ (cl-position var vars :test #'eq)))))))
|
||||||
|
1 1
|
||||||
|
,(lambda (var)
|
||||||
|
(cond ((integerp var) (rx-check-backref var))
|
||||||
|
((memq var vars) t)
|
||||||
|
(t (error "rx `backref' variable must be one of %s: %s"
|
||||||
|
vars var)))))
|
||||||
|
,@rx-constituents))
|
||||||
|
(regexp (rx-to-string `(seq ,@regexps) :no-group)))
|
||||||
|
`(and (pred (string-match ,regexp))
|
||||||
|
,@(cl-loop for i from 1
|
||||||
|
for var in vars
|
||||||
|
collect `(app (match-string ,i) ,var)))))
|
||||||
|
|
||||||
;; ;; sregex.el replacement
|
;; ;; sregex.el replacement
|
||||||
|
|
||||||
|
|
|
@ -33,5 +33,15 @@
|
||||||
(number-sequence ?< ?\])
|
(number-sequence ?< ?\])
|
||||||
(number-sequence ?- ?:))))))
|
(number-sequence ?- ?:))))))
|
||||||
|
|
||||||
|
(ert-deftest rx-pcase ()
|
||||||
|
(should (equal (pcase "a 1 2 3 1 1 b"
|
||||||
|
((rx (let u (+ digit)) space
|
||||||
|
(let v (+ digit)) space
|
||||||
|
(let v (+ digit)) space
|
||||||
|
(backref u) space
|
||||||
|
(backref 1))
|
||||||
|
(list u v)))
|
||||||
|
'("1" "3"))))
|
||||||
|
|
||||||
(provide 'rx-tests)
|
(provide 'rx-tests)
|
||||||
;; rx-tests.el ends here.
|
;; rx-tests.el ends here.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue