[elpa] externals/relint d2b7194 19/23: Evaluate `dolist' and `while'

[Mattias Engdegård]

branch: externals/relint
commit d2b71948b8fd3736c4892a249f34455eac0d86be
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Evaluate `dolist' and `while'
    
    `dolist' is special-cased for speed right now, but could also be
    expanded and handled by `while' if implemented. `while' is capped at
    100 iterations to guarantee reasonable progress.
---
 relint.el       | 30 ++++++++++++++++++++++++++++++
 test/7.elisp    | 21 +++++++++++++++++++++
 test/7.expected |  6 ++++++
 3 files changed, 57 insertions(+)

diff --git a/relint.el b/relint.el
index 1e89278..90fc73b 100644
--- a/relint.el
+++ b/relint.el
@@ -769,6 +769,36 @@ not be evaluated safely."
                 (relint--eval `(let* ,(cdr bindings) ,@(cdr body))))
             (relint--eval-body (cdr body)))))
 
+       ;; dolist: simulate its operation. We could also expand it,
+       ;; but this is somewhat faster.
+       ((eq head 'dolist)
+        (unless (and (>= (length body) 2)
+                     (consp (car body)))
+          (throw 'relint-eval 'no-value))
+        (let ((var (nth 0 (car body)))
+              (seq-arg (nth 1 (car body)))
+              (res-arg (nth 2 (car body))))
+          (unless (symbolp var)
+            (throw 'relint-eval 'no-value))
+          (let ((seq (relint--eval-list seq-arg)))
+            (while (consp seq)
+              (let ((relint--locals (cons (list var (car seq))
+                                          relint--locals)))
+                (relint--eval-body (cdr body)))
+              (setq seq (cdr seq))))
+          (and res-arg (relint--eval res-arg))))
+
+       ;; while: this slows down simulation noticeably, but catches some
+       ;; mistakes.
+       ((eq head 'while)
+        (let ((condition (car body))
+              (loops 0))
+          (while (and (relint--eval condition)
+                      (< loops 100))
+            (relint--eval-body (cdr body))
+            (setq loops (1+ loops)))
+          nil))
+
        ;; Loose comma: can occur if we unwittingly stumbled into a backquote
        ;; form. Just eval the arg and hope for the best.
        ((eq head '\,)
diff --git a/test/7.elisp b/test/7.elisp
new file mode 100644
index 0000000..b0ed01c
--- /dev/null
+++ b/test/7.elisp
@@ -0,0 +1,21 @@
+;;; Relint test file 7          -*- emacs-lisp -*-
+
+(defun my-dolist-fun (seq)
+  (let ((s ""))
+    (dolist (c seq)
+      (setq s (concat s (char-to-string c))))
+    s))
+
+(defun test-dolist ()
+  (looking-at (my-dolist-fun '(?a ?b ?^))))
+
+(defun my-while-fun ()
+  (let ((s "")
+        (c ?!))
+    (while (< c ?&)
+      (setq s (concat s (char-to-string c)))
+      (setq c (1+ c)))
+    s))
+
+(defun test-while ()
+  (looking-at (my-while-fun)))
diff --git a/test/7.expected b/test/7.expected
new file mode 100644
index 0000000..5275a63
--- /dev/null
+++ b/test/7.expected
@@ -0,0 +1,6 @@
+7.elisp:10:15: In call to looking-at: Unescaped literal `^' (pos 2)
+  "ab^"
+   ..^
+7.elisp:21:15: In call to looking-at: Unescaped literal `$' (pos 3)
+  "!\"#$%"
+   ....^