[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/relint c857c98c4b 1/2: Improved backquote expansion in
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/relint c857c98c4b 1/2: Improved backquote expansion in rx forms |
|
Date: |
Mon, 31 Jul 2023 12:58:47 -0400 (EDT) |
branch: externals/relint
commit c857c98c4b9ed07818f3371f5ddc9459cac4565b
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Improved backquote expansion in rx forms
This comes at the cost of some reduced warning location accuracy, but
should be worth it.
---
relint.el | 79 ++++++++++++++++++++++++++++++++++++++++----------------
test/11.elisp | 4 ++-
test/11.expected | 32 ++++++++++++-----------
3 files changed, 77 insertions(+), 38 deletions(-)
diff --git a/relint.el b/relint.el
index 0555930c3c..ef00882282 100644
--- a/relint.el
+++ b/relint.el
@@ -1551,12 +1551,63 @@ RANGES is a list of (X . Y) representing the interval
[X,Y]."
(setq ranges (cdr ranges)))
(car ranges))
+(defun relint--expand-rx-args (items)
+ "Expand unquotes and `eval' and `literal' forms in ITEMS recursively."
+ (if (atom items)
+ items
+ (let ((acc nil)
+ (tail items))
+ (while (consp tail)
+ (let* ((item (car tail))
+ (head (car-safe item)))
+ ;; Evaluate unquote and unquote-splicing forms as if inside a
+ ;; (single) backquote.
+ (cond ((memq head '(eval \,))
+ (let ((val (relint--eval-or-nil (cadr item))))
+ (pop tail)
+ (if val
+ (push val tail)
+ (push item acc))))
+ ((eq head 'literal)
+ (let ((val (relint--eval-or-nil (cadr item))))
+ (pop tail)
+ (push (if (stringp val)
+ (regexp-quote val)
+ item)
+ acc)))
+ ((eq head '\,@)
+ (let ((vals (relint--eval-or-nil (cadr item))))
+ (pop tail)
+ (if vals
+ (setq tail (append vals tail))
+ (push item acc))))
+ ((eq item '\,) ; (... . ,TAIL) = (... , TAIL)
+ (let ((vals (relint--eval-or-nil (cadr tail))))
+ (pop tail)
+ (if vals
+ (setq tail vals)
+ (push item acc))))
+ ((and (consp item) (listp (cdr item)))
+ (push (relint--expand-rx-args item) acc)
+ (pop tail))
+ (t (push item acc)
+ (pop tail)))))
+ (setq acc (nreverse acc))
+ (if (equal acc items)
+ items
+ acc))))
+
(defun relint--check-rx (item pos path exact-path)
"Check the `rx' expression ITEM.
EXACT-PATH indicates whether PATH leads to ITEM exactly, rather
than just to a surrounding or producing expression."
+ (let ((expanded (relint--expand-rx-args item)))
+ (relint--check-rx-1 expanded pos path
+ (and exact-path (eq expanded item)))))
+
+(defun relint--check-rx-1 (item pos path exact-path)
(pcase item
- (`(,(or ': 'seq 'sequence 'and 'or '|
+ (`(,(or 'rx ': 'seq 'sequence 'and 'or '| ; pretend that `rx' is `seq'
'not 'intersection 'repeat '= '>= '**
'zero-or-more '0+ '* '*?
'one-or-more '1+ '+ '+?
@@ -1585,8 +1636,8 @@ than just to a surrounding or producing expression."
;; Form with subforms: recurse.
(let ((i 1))
(dolist (arg args)
- (relint--check-rx arg pos (if exact-path (cons i path) path)
- exact-path)
+ (relint--check-rx-1 arg pos (if exact-path (cons i path) path)
+ exact-path)
(setq i (1+ i)))))
(`(,(or 'any 'in 'char 'not-char) . ,args)
@@ -1721,19 +1772,7 @@ than just to a surrounding or producing expression."
(`(,(or 'regexp 'regex) ,expr)
(relint--check-re expr (format-message "rx `%s' form" (car item))
- pos (if exact-path (cons 1 path) path)))
-
- ;; Evaluate unquote and unquote-splicing forms as if inside a
- ;; (single) backquote.
- (`(,(or 'eval '\,) ,expr)
- (let ((val (relint--eval-or-nil expr)))
- (when val
- (relint--check-rx val pos (if exact-path (cons 1 path) path) nil))))
-
- (`(\,@ ,expr)
- (let ((items (relint--eval-list expr)))
- (dolist (form items)
- (relint--check-rx form pos (if exact-path (cons 1 path) path)
nil))))))
+ pos (if exact-path (cons 1 path) path)))))
(defun relint--regexp-args-from-doc (doc-string)
"Extract regexp arguments (as a list of symbols) from DOC-STRING."
@@ -2240,12 +2279,8 @@ directly."
(cons 'val val))))
(list 'expr re-arg))))
(push (cons name new) relint--variables)))))
- (`(rx . ,items)
- (let ((i 1))
- (while (consp items)
- (relint--check-rx (car items) pos (cons i path) t)
- (setq items (cdr items))
- (setq i (1+ i)))))
+ (`(rx . ,_)
+ (relint--check-rx form pos path t))
(`(rx-to-string (,(or 'quote '\`) ,arg) . ,_)
(relint--check-rx arg pos (cons 1 (cons 1 path)) t))
(`(font-lock-add-keywords ,_ ,keywords . ,_)
diff --git a/test/11.elisp b/test/11.elisp
index 3f4527b23a..c0af6a1792 100644
--- a/test/11.elisp
+++ b/test/11.elisp
@@ -21,7 +21,9 @@
(rx-to-string `(: bol
,(list 'in "BB")))
`(rx ,(list 'char "CC"))
- `(rx ,@(list nonl (list 'any "DD"))))
+ `(rx ,@(list 'nonl (list 'any "DD")))
+ (let ((things '(?x ?y ?z ?y)))
+ `(rx (any ?z . ,things))))
;; No error here.
(rx (any "\000-\377" ?å) (any "\377" 255))
diff --git a/test/11.expected b/test/11.expected
index 9b8c9b1b19..c48a42b73e 100644
--- a/test/11.expected
+++ b/test/11.expected
@@ -25,41 +25,43 @@
11.elisp:15:20: Literal `-' not first or last (pos 3)
"A-F-K-T"
...^
-11.elisp:16:19: In rx `regexp' form: Duplicated `1' inside character
alternative (pos 2)
+11.elisp:16:4: In rx `regexp' form: Duplicated `1' inside character
alternative (pos 2)
"[11]"
..^
-11.elisp:17:18: In rx `regex' form: Duplicated `2' inside character
alternative (pos 2)
+11.elisp:16:4: In rx `regex' form: Duplicated `2' inside character alternative
(pos 2)
"[22]"
..^
-11.elisp:18:14: Duplicated character `3' (pos 1)
+11.elisp:16:4: Duplicated character `3' (pos 1)
"33"
.^
11.elisp:20:29: Duplicated character `A' (pos 1)
"AA"
.^
-11.elisp:22:23: Duplicated character `B' (pos 1)
+11.elisp:21:19: Duplicated character `B' (pos 1)
"BB"
.^
-11.elisp:23:10: Duplicated character `C' (pos 1)
+11.elisp:23:5: Duplicated character `C' (pos 1)
"CC"
.^
-11.elisp:24:11: Duplicated character `D' (pos 1)
+11.elisp:24:5: Duplicated character `D' (pos 1)
"DD"
.^
-11.elisp:29:25: Character `\177' included in range `\000-\177' (pos 0)
+11.elisp:26:7: Duplicated character `z'
+11.elisp:26:7: Duplicated character `y'
+11.elisp:31:25: Character `\177' included in range `\000-\177' (pos 0)
"\177"
^
-11.elisp:29:32: Character `\240' included in range `\200-\377' (pos 0)
+11.elisp:31:32: Character `\240' included in range `\200-\377' (pos 0)
"\240"
^
-11.elisp:31:18: Character `m' included in range `a-z'
-11.elisp:32:19: Range `\000-\377' overlaps previous `a-f' (pos 0)
+11.elisp:33:18: Character `m' included in range `a-z'
+11.elisp:34:19: Range `\000-\377' overlaps previous `a-f' (pos 0)
"\000-\377"
^
-11.elisp:33:25: Range `\000-\377' overlaps previous `\240-\277' (pos 0)
+11.elisp:35:25: Range `\000-\377' overlaps previous `\240-\277' (pos 0)
"\000-\377"
^
-11.elisp:35:17: Duplicated rx form in or-pattern: ?A
-11.elisp:35:20: Duplicated rx form in or-pattern: "def"
-11.elisp:36:10: Duplicated rx form in or-pattern: "abc"
-11.elisp:36:16: Duplicated rx form in or-pattern: (= 3 ?*)
+11.elisp:37:17: Duplicated rx form in or-pattern: ?A
+11.elisp:37:20: Duplicated rx form in or-pattern: "def"
+11.elisp:38:10: Duplicated rx form in or-pattern: "abc"
+11.elisp:38:16: Duplicated rx form in or-pattern: (= 3 ?*)