Subject: bug#57907: Acknowledgement (29.0.50; Using keywords with cl-loop)

From: Philip Kaludercic <[email-masked]>
Date: Sun, 18 Sep 2022 20:12:26 +0000

Philip Kaludercic <[email-masked]> writes:

> It seems it isn't that difficult to do this (though the patch is longer
> than it ought to be because of indentation changes)

It turned out to be a bit more difficult than I had assumed at first,
but this patch should address the remaining issues I had:

>From a15a3d33b3ae4e2e8608da04978ed91b7c01187f Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <[email-masked]>
Date: Sun, 18 Sep 2022 14:25:29 +0200
Subject: [PATCH] Have 'cl-loop' handle keyword symbols

* lisp/emacs-lisp/cl-macs.el (cl-loop): Add keywords to the edebug
spec.
(cl--parse-loop-clause): Handle keyword symbols by converting them
into regular symbols.
* doc/misc/cl.texi (Loop Basics): Mention that keywords are handled.
* etc/NEWS: Mention it.
(Bug#57907)
---
 doc/misc/cl.texi           |  13 +-
 etc/NEWS                   |   3 +
 lisp/emacs-lisp/cl-macs.el | 964 +++++++++++++++++++------------------
 3 files changed, 510 insertions(+), 470 deletions(-)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a6747b1096..2f64aa3f1e 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -1700,12 +1700,13 @@ Loop Basics
 
 @defmac cl-loop clauses@dots{}
 A loop construct consists of a series of @var{clause}s, each
-introduced by a symbol like @code{for} or @code{do}.  Clauses
-are simply strung together in the argument list of @code{cl-loop},
-with minimal extra parentheses.  The various types of clauses
-specify initializations, such as the binding of temporary
-variables, actions to be taken in the loop, stepping actions,
-and final cleanup.
+introduced by a symbol like @code{for} or @code{do}.  Clauses are
+simply strung together in the argument list of @code{cl-loop}, with
+minimal extra parentheses.  The various types of clauses specify
+initializations, such as the binding of temporary variables, actions
+to be taken in the loop, stepping actions, and final cleanup.
+@code{cl-loop} can also handle keyword symbols, such as @code{:for} or
+@code{:do}, in the same way as it would handle non-keyword symbols.
 
 Common Lisp specifies a certain general order of clauses in a
 loop:
diff --git a/etc/NEWS b/etc/NEWS
index e5d9b1ca23..b6862276f1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3801,6 +3801,9 @@ the same but works by modifying LIST destructively.
 ---
 ** 'string-split' is now an alias for 'split-string'.
 
++++
+** 'cl-loop' now handles keyword symbols.
+
 
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 5d330f32d6..74d0878689 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -946,6 +946,9 @@ cl-loop
     do EXPRS...
     [finally] return EXPR
 
+All cl-loop keywords may also be written using keyword
+symbols (e.g. `:for' is the same as `for').
+
 For more details, see Info node `(cl)Loop Facility'.
 
 \(fn CLAUSE...)"
@@ -953,22 +956,24 @@ cl-loop
                          ;; These are usually followed by a symbol, but it can
                          ;; actually be any destructuring-bind pattern, which
                          ;; would erroneously match `form'.
-                         [[&or "for" "as" "with" "and"] sexp]
+                         [[&or "for" ":for" "as" ":as" "with" ":with" "and" ":and"] sexp]
                          ;; These are followed by expressions which could
                          ;; erroneously match `symbolp'.
-                         [[&or "from" "upfrom" "downfrom" "to" "upto" "downto"
-                               "above" "below" "by" "in" "on" "=" "across"
-                               "repeat" "while" "until" "always" "never"
-                               "thereis" "collect" "append" "nconc" "sum"
-                               "count" "maximize" "minimize"
-                               "if" "when" "unless"
-                               "return"]
+                         [[&or "from" ":from" "upfrom" ":upfrom" "downfrom" ":downfrom" "to"
+                               ":to" "upto" ":upto" "downto" ":downto" "above" ":above"
+                               "below" ":below" "by" ":by" "in" ":in" "on" ":on" "=" ":="
+                               "across" ":across" "repeat" ":repeat" "while" ":while" "until"
+                               ":until" "always" ":always" "never" ":never" "thereis"
+                               ":thereis" "collect" ":collect" "append" ":append" "nconc"
+                               ":nconc" "sum" ":sum" "count" ":count" "maximize" ":maximize"
+                               "minimize" ":minimize" "if" ":if" "when" ":when" "unless"
+                               ":unless" "return" ":return" ]
                           form]
                          ["using" (symbolp symbolp)]
                          ;; Simple default, which covers 99% of the cases.
                          symbolp form)))
   (if (not (memq t (mapcar #'symbolp
-                           (delq nil (delq t (cl-copy-list loop-args))))))
+                           (delq nil (remq t loop-args)))))
       `(cl-block nil (while t ,@loop-args))
     (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil)
 	  (cl--loop-body nil)		(cl--loop-steps nil)
@@ -1204,465 +1209,496 @@ cl--push-clause-loop-body
 ;;   '(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
 
 (defun cl--parse-loop-clause ()		; uses loop-*
-  (let ((word (pop cl--loop-args))
-	(hash-types '(hash-key hash-keys hash-value hash-values))
-	(key-types '(key-code key-codes key-seq key-seqs
-		     key-binding key-bindings)))
-    (cond
+  (cl-flet
+      ;; The following local functions are added to automatically
+      ;; convert loop-keywords that use keyword symbols to
+      ;; non-keyword symbols.  E.g. we want
+      ;;
+      ;;    (cl-loop :repeat foo :collect :bar)
+      ;;
+      ;; to do the same as
+      ;;
+      ;;    (cl-loop repeat foo collect :bar)
+      ;;
+      ;; We can't generically replace all keyword symbols with
+      ;; non-keyword symbols because that could break things when we
+      ;; actually intend to have a keyword symbol.  Instead the local
+      ;; functions are used whenever we want to query the next
+      ;; loop-keyword.
+      ((next ()
+         (let ((word (pop cl--loop-args)))
+           (if (keywordp word)
+               (intern (substring (symbol-name word) 1))
+             word)))
+       (next-2 ()                  ;double-step `next'
+         (let ((word (cl--pop2 cl--loop-args)))
+           (if (keywordp word)
+               (intern (substring (symbol-name word) 1))
+             word)))
+       (peek ()
+         (let ((word (car cl--loop-args)))
+           (if (keywordp word)
+               (intern (substring (symbol-name word) 1))
+             word))))
+    (let ((word (next))
+          (hash-types '(hash-key hash-keys hash-value hash-values))
+          (key-types '(key-code key-codes key-seq key-seqs
+                                key-binding key-bindings)))
+      (cond
+
+       ((null cl--loop-args)
+        (error "Malformed `cl-loop' macro"))
+
+       ((eq word 'named)
+        (setq cl--loop-name (pop cl--loop-args)))
+
+       ((eq word 'initially)
+        (if (memq (peek) '(do doing)) (next))
+        (or (consp (peek))
+            (error "Syntax error on `initially' clause"))
+        (while (consp (peek))
+          (push (pop cl--loop-args) cl--loop-initially)))
+
+       ((eq word 'finally)
+        (if (eq (peek) 'return)
+            (setq cl--loop-result-explicit
+                  (or (cl--pop2 cl--loop-args) '(quote nil)))
+          (if (memq (peek) '(do doing)) (next))
+          (or (consp (peek))
+              (error "Syntax error on `finally' clause"))
+          (if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name))
+              (setq cl--loop-result-explicit
+                    (or (nth 1 (pop cl--loop-args)) '(quote nil)))
+            (while (consp (peek))
+              (push (pop cl--loop-args) cl--loop-finally)))))
+
+       ((memq word '(for as))
+        (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
+              (ands nil))
+          (while
+              ;; Use `cl-gensym' rather than `make-symbol'.  It's important that
+              ;; (not (eq (symbol-name var1) (symbol-name var2))) because
+              ;; these vars get added to the macro-environment.
+              (let ((var (or (pop cl--loop-args) (cl-gensym "--cl-var--"))))
+                (setq word (next))
+                (if (eq word 'being) (setq word (next)))
+                (if (memq word '(the each)) (setq word (next)))
+                (if (memq word '(buffer buffers))
+                    (setq word 'in
+                          cl--loop-args (cons '(buffer-list) cl--loop-args)))
+                (cond
 
-     ((null cl--loop-args)
-      (error "Malformed `cl-loop' macro"))
-
-     ((eq word 'named)
-      (setq cl--loop-name (pop cl--loop-args)))
-
-     ((eq word 'initially)
-      (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
-      (or (consp (car cl--loop-args))
-          (error "Syntax error on `initially' clause"))
-      (while (consp (car cl--loop-args))
-	(push (pop cl--loop-args) cl--loop-initially)))
-
-     ((eq word 'finally)
-      (if (eq (car cl--loop-args) 'return)
-	  (setq cl--loop-result-explicit
-                (or (cl--pop2 cl--loop-args) '(quote nil)))
-	(if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
-	(or (consp (car cl--loop-args))
-            (error "Syntax error on `finally' clause"))
-	(if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name))
-	    (setq cl--loop-result-explicit
-                  (or (nth 1 (pop cl--loop-args)) '(quote nil)))
-	  (while (consp (car cl--loop-args))
-	    (push (pop cl--loop-args) cl--loop-finally)))))
-
-     ((memq word '(for as))
-      (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
-	    (ands nil))
-	(while
-	    ;; Use `cl-gensym' rather than `make-symbol'.  It's important that
-	    ;; (not (eq (symbol-name var1) (symbol-name var2))) because
-	    ;; these vars get added to the macro-environment.
-	    (let ((var (or (pop cl--loop-args) (cl-gensym "--cl-var--"))))
-	      (setq word (pop cl--loop-args))
-	      (if (eq word 'being) (setq word (pop cl--loop-args)))
-	      (if (memq word '(the each)) (setq word (pop cl--loop-args)))
-	      (if (memq word '(buffer buffers))
-		  (setq word 'in
-                        cl--loop-args (cons '(buffer-list) cl--loop-args)))
-	      (cond
-
-	       ((memq word '(from downfrom upfrom to downto upto
-			     above below by))
-		(push word cl--loop-args)
-		(if (memq (car cl--loop-args) '(downto above))
-		    (error "Must specify `from' value for downward cl-loop"))
-		(let* ((down (or (eq (car cl--loop-args) 'downfrom)
-				 (memq (nth 2 cl--loop-args)
-                                       '(downto above))))
-		       (excl (or (memq (car cl--loop-args) '(above below))
-				 (memq (nth 2 cl--loop-args)
-                                       '(above below))))
-		       (start (and (memq (car cl--loop-args)
-                                         '(from upfrom downfrom))
-				   (cl--pop2 cl--loop-args)))
-		       (end (and (memq (car cl--loop-args)
-				       '(to upto downto above below))
-				 (cl--pop2 cl--loop-args)))
-		       (step (and (eq (car cl--loop-args) 'by)
-                                  (cl--pop2 cl--loop-args)))
-		       (end-var (and (not (macroexp-const-p end))
-				     (make-symbol "--cl-var--")))
-		       (step-var (and (not (macroexp-const-p step))
-				      (make-symbol "--cl-var--"))))
-		  (and step (numberp step) (<= step 0)
-		       (error "Loop `by' value is not positive: %s" step))
-		  (push (list var (or start 0)) loop-for-bindings)
-		  (if end-var (push (list end-var end) loop-for-bindings))
-		  (if step-var (push (list step-var step)
-				     loop-for-bindings))
-		  (when end
+                 ((memq word '(from downfrom upfrom to downto upto
+                                    above below by))
+                  (push word cl--loop-args)
+                  (if (memq (peek) '(downto above))
+                      (error "Must specify `from' value for downward cl-loop"))
+                  (let* ((down (or (eq (peek) 'downfrom)
+                                   (memq (nth 2 cl--loop-args)
+                                         '(downto above))))
+                         (excl (or (memq (peek) '(above below))
+                                   (memq (nth 2 cl--loop-args)
+                                         '(above below))))
+                         (start (and (memq (peek)
+                                           '(from upfrom downfrom))
+                                     (next-2)))
+                         (end (and (memq (peek)
+                                         '(to upto downto above below))
+                                   (next-2)))
+                         (step (and (eq (peek) 'by)
+                                    (next-2)))
+                         (end-var (and (not (macroexp-const-p end))
+                                       (make-symbol "--cl-var--")))
+                         (step-var (and (not (macroexp-const-p step))
+                                        (make-symbol "--cl-var--"))))
+                    (and step (numberp step) (<= step 0)
+                         (error "Loop `by' value is not positive: %s" step))
+                    (push (list var (or start 0)) loop-for-bindings)
+                    (if end-var (push (list end-var end) loop-for-bindings))
+                    (if step-var (push (list step-var step)
+                                       loop-for-bindings))
+                    (when end
+                      (cl--push-clause-loop-body
+                       (list
+                        (if down (if excl '> '>=) (if excl '< '<=))
+                        var (or end-var end))))
+                    (push (list var (list (if down '- '+) var
+                                          (or step-var step 1)))
+                          loop-for-steps)))
+
+                 ((memq word '(in in-ref on))
+                  (let* ((on (eq word 'on))
+                         (temp (if (and on (symbolp var))
+                                   var (make-symbol "--cl-var--"))))
+                    (push (list temp (pop cl--loop-args)) loop-for-bindings)
+                    (cl--push-clause-loop-body `(consp ,temp))
+                    (if (eq word 'in-ref)
+                        (push (list var `(car ,temp)) cl--loop-symbol-macs)
+                      (or (eq temp var)
+                          (progn
+                            (push (list var nil) loop-for-bindings)
+                            (push (list var (if on temp `(car ,temp)))
+                                  loop-for-sets))))
+                    (push (list temp
+                                (if (eq (peek) 'by)
+                                    (let ((step (cl--pop2 cl--loop-args)))
+                                      (if (and (memq (car-safe step)
+                                                     '(quote function
+                                                             cl-function))
+                                               (symbolp (nth 1 step)))
+                                          (list (nth 1 step) temp)
+                                        `(funcall ,step ,temp)))
+                                  `(cdr ,temp)))
+                          loop-for-steps)))
+
+                 ((eq word '=)
+                  (let* ((start (next))
+                         (then (if (eq (peek) 'then)
+                                   (cl--pop2 cl--loop-args) start))
+                         (first-assign (or cl--loop-first-flag
+                                           (setq cl--loop-first-flag
+                                                 (make-symbol "--cl-var--")))))
+                    (push (list var nil) loop-for-bindings)
+                    (if (or ands (eq (peek) 'and))
+                        (progn
+                          (push `(,var (if ,first-assign ,start ,var)) loop-for-sets)
+                          (push `(,var (if ,(car (cl--loop-build-ands
+                                                  (nreverse cl--loop-conditions)))
+                                           ,then ,var))
+                                loop-for-steps))
+                      (push (if (eq start then)
+                                `(,var ,then)
+                              `(,var (if ,first-assign ,start ,then)))
+                            loop-for-sets))))
+
+                 ((memq word '(across across-ref))
+                  (let ((temp-vec (make-symbol "--cl-vec--"))
+                        (temp-idx (make-symbol "--cl-idx--")))
+                    (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
+                    (push (list temp-idx -1) loop-for-bindings)
+                    (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
                     (cl--push-clause-loop-body
-                     (list
-                      (if down (if excl '> '>=) (if excl '< '<=))
-                      var (or end-var end))))
-		  (push (list var (list (if down '- '+) var
-					(or step-var step 1)))
-			loop-for-steps)))
-
-	       ((memq word '(in in-ref on))
-		(let* ((on (eq word 'on))
-		       (temp (if (and on (symbolp var))
-				 var (make-symbol "--cl-var--"))))
-		  (push (list temp (pop cl--loop-args)) loop-for-bindings)
-                  (cl--push-clause-loop-body `(consp ,temp))
-		  (if (eq word 'in-ref)
-		      (push (list var `(car ,temp)) cl--loop-symbol-macs)
-		    (or (eq temp var)
-			(progn
-			  (push (list var nil) loop-for-bindings)
-			  (push (list var (if on temp `(car ,temp)))
-				loop-for-sets))))
-		  (push (list temp
-			      (if (eq (car cl--loop-args) 'by)
-				  (let ((step (cl--pop2 cl--loop-args)))
-				    (if (and (memq (car-safe step)
-						   '(quote function
-							   cl-function))
-					     (symbolp (nth 1 step)))
-					(list (nth 1 step) temp)
-				      `(funcall ,step ,temp)))
-				`(cdr ,temp)))
-			loop-for-steps)))
-
-	       ((eq word '=)
-		(let* ((start (pop cl--loop-args))
-		       (then (if (eq (car cl--loop-args) 'then)
-                                 (cl--pop2 cl--loop-args) start))
-                       (first-assign (or cl--loop-first-flag
-					 (setq cl--loop-first-flag
-					       (make-symbol "--cl-var--")))))
-		  (push (list var nil) loop-for-bindings)
-		  (if (or ands (eq (car cl--loop-args) 'and))
-		      (progn
-			(push `(,var (if ,first-assign ,start ,var)) loop-for-sets)
-			(push `(,var (if ,(car (cl--loop-build-ands
-                                                (nreverse cl--loop-conditions)))
-                                         ,then ,var))
-                              loop-for-steps))
-                    (push (if (eq start then)
-		              `(,var ,then)
-                            `(,var (if ,first-assign ,start ,then)))
-                          loop-for-sets))))
-
-	       ((memq word '(across across-ref))
-		(let ((temp-vec (make-symbol "--cl-vec--"))
-		      (temp-idx (make-symbol "--cl-idx--")))
-		  (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
-		  (push (list temp-idx -1) loop-for-bindings)
-                  (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
-		  (cl--push-clause-loop-body
-                   `(< ,temp-idx (length ,temp-vec)))
-		  (if (eq word 'across-ref)
-		      (push (list var `(aref ,temp-vec ,temp-idx))
-			    cl--loop-symbol-macs)
-		    (push (list var nil) loop-for-bindings)
-		    (push (list var `(aref ,temp-vec ,temp-idx))
-			  loop-for-sets))))
-
-	       ((memq word '(element elements))
-		(let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref))
-			       (and (not (memq (car cl--loop-args) '(in of)))
-				    (error "Expected `of'"))))
-		      (seq (cl--pop2 cl--loop-args))
-		      (temp-seq (make-symbol "--cl-seq--"))
-		      (temp-idx
-                       (if (eq (car cl--loop-args) 'using)
-                           (if (and (= (length (cadr cl--loop-args)) 2)
-                                    (eq (caadr cl--loop-args) 'index))
-                               (cadr (cl--pop2 cl--loop-args))
-                             (error "Bad `using' clause"))
-                         (make-symbol "--cl-idx--"))))
-		  (push (list temp-seq seq) loop-for-bindings)
-		  (push (list temp-idx 0) loop-for-bindings)
-		  (if ref
-                      (let ((temp-len (make-symbol "--cl-len--")))
-			(push (list temp-len `(length ,temp-seq))
-			      loop-for-bindings)
-			(push (list var `(elt ,temp-seq ,temp-idx))
-			      cl--loop-symbol-macs)
-                        (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
-		    (push (list var nil) loop-for-bindings)
-		    (cl--push-clause-loop-body `(and ,temp-seq
-                                                     (or (consp ,temp-seq)
-                                                         (< ,temp-idx (length ,temp-seq)))))
-		    (push (list var `(if (consp ,temp-seq)
-                                         (pop ,temp-seq)
-                                       (aref ,temp-seq ,temp-idx)))
-			  loop-for-sets))
-		  (push (list temp-idx `(1+ ,temp-idx))
-			loop-for-steps)))
-
-	       ((memq word hash-types)
-		(or (memq (car cl--loop-args) '(in of))
-                    (error "Expected `of'"))
-		(let* ((table (cl--pop2 cl--loop-args))
-		       (other
-                        (if (eq (car cl--loop-args) 'using)
-                            (if (and (= (length (cadr cl--loop-args)) 2)
-                                     (memq (caadr cl--loop-args) hash-types)
-                                     (not (eq (caadr cl--loop-args) word)))
-                                (cadr (cl--pop2 cl--loop-args))
-                              (error "Bad `using' clause"))
-                          (make-symbol "--cl-var--"))))
-		  (if (memq word '(hash-value hash-values))
-		      (setq var (prog1 other (setq other var))))
-		  (cl--loop-set-iterator-function
-                   'hash-tables (lambda (body)
-                                  `(maphash (lambda (,var ,other) . ,body)
-                                            ,table)))))
-
-	       ((memq word '(symbol present-symbol external-symbol
-			     symbols present-symbols external-symbols))
-		(let ((ob (and (memq (car cl--loop-args) '(in of))
-                               (cl--pop2 cl--loop-args))))
-		  (cl--loop-set-iterator-function
-                   'symbols (lambda (body)
-                              `(mapatoms (lambda (,var) . ,body) ,ob)))))
-
-	       ((memq word '(overlay overlays extent extents))
-		(let ((buf nil) (from nil) (to nil))
-		  (while (memq (car cl--loop-args) '(in of from to))
-		    (cond ((eq (car cl--loop-args) 'from)
-                           (setq from (cl--pop2 cl--loop-args)))
-			  ((eq (car cl--loop-args) 'to)
-                           (setq to (cl--pop2 cl--loop-args)))
-			  (t (setq buf (cl--pop2 cl--loop-args)))))
-		  (cl--loop-set-iterator-function
-                   'overlays (lambda (body)
-                               `(cl--map-overlays
-                                 (lambda (,var ,(make-symbol "--cl-var--"))
-                                   (progn . ,body) nil)
-                                 ,buf ,from ,to)))))
-
-	       ((memq word '(interval intervals))
-		(let ((buf nil) (prop nil) (from nil) (to nil)
-		      (var1 (make-symbol "--cl-var1--"))
-		      (var2 (make-symbol "--cl-var2--")))
-		  (while (memq (car cl--loop-args) '(in of property from to))
-		    (cond ((eq (car cl--loop-args) 'from)
-                           (setq from (cl--pop2 cl--loop-args)))
-			  ((eq (car cl--loop-args) 'to)
-                           (setq to (cl--pop2 cl--loop-args)))
-			  ((eq (car cl--loop-args) 'property)
-			   (setq prop (cl--pop2 cl--loop-args)))
-			  (t (setq buf (cl--pop2 cl--loop-args)))))
-		  (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
-		      (setq var1 (car var) var2 (cdr var))
-		    (push (list var `(cons ,var1 ,var2)) loop-for-sets))
-		  (cl--loop-set-iterator-function
-                   'intervals (lambda (body)
-                                `(cl--map-intervals
-                                  (lambda (,var1 ,var2) . ,body)
-                                  ,buf ,prop ,from ,to)))))
-
-	       ((memq word key-types)
-		(or (memq (car cl--loop-args) '(in of))
-                    (error "Expected `of'"))
-		(let ((cl-map (cl--pop2 cl--loop-args))
-		      (other
-                       (if (eq (car cl--loop-args) 'using)
-                           (if (and (= (length (cadr cl--loop-args)) 2)
-                                    (memq (caadr cl--loop-args) key-types)
-                                    (not (eq (caadr cl--loop-args) word)))
-                               (cadr (cl--pop2 cl--loop-args))
-                             (error "Bad `using' clause"))
-                         (make-symbol "--cl-var--"))))
-		  (if (memq word '(key-binding key-bindings))
-		      (setq var (prog1 other (setq other var))))
-		  (cl--loop-set-iterator-function
-                   'keys (lambda (body)
-                           `(,(if (memq word '(key-seq key-seqs))
-                                  'cl--map-keymap-recursively 'map-keymap)
-                             (lambda (,var ,other) . ,body) ,cl-map)))))
-
-	       ((memq word '(frame frames screen screens))
-		(let ((temp (make-symbol "--cl-var--")))
-		  (push (list var  '(selected-frame))
-			loop-for-bindings)
-		  (push (list temp nil) loop-for-bindings)
-		  (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
-                                                (or ,temp (setq ,temp ,var))))
-		  (push (list var `(next-frame ,var))
-			loop-for-steps)))
-
-	       ((memq word '(window windows))
-		(let ((scr (and (memq (car cl--loop-args) '(in of))
-                                (cl--pop2 cl--loop-args)))
-		      (temp (make-symbol "--cl-var--"))
-		      (minip (make-symbol "--cl-minip--")))
-		  (push (list var (if scr
-				      `(frame-selected-window ,scr)
-				    '(selected-window)))
-			loop-for-bindings)
-		  ;; If we started in the minibuffer, we need to
-		  ;; ensure that next-window will bring us back there
-		  ;; at some point.  (Bug#7492).
-		  ;; (Consider using walk-windows instead of cl-loop if
-		  ;; you care about such things.)
-		  (push (list minip `(minibufferp (window-buffer ,var)))
-			loop-for-bindings)
-		  (push (list temp nil) loop-for-bindings)
-		  (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
-                                                (or ,temp (setq ,temp ,var))))
-		  (push (list var `(next-window ,var ,minip))
-			loop-for-steps)))
-
-	       (t
-		;; This is an advertised interface: (info "(cl)Other Clauses").
-		(let ((handler (and (symbolp word)
-				    (get word 'cl-loop-for-handler))))
-		  (if handler
-		      (funcall handler var)
-		    (error "Expected a `for' preposition, found %s" word)))))
-	      (eq (car cl--loop-args) 'and))
-	  (setq ands t)
-	  (pop cl--loop-args))
-	(if (and ands loop-for-bindings)
-	    (push (nreverse loop-for-bindings) cl--loop-bindings)
-	  (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings)
-				         cl--loop-bindings)))
-	(if loop-for-sets
-	    (push `(progn
-                     ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
+                     `(< ,temp-idx (length ,temp-vec)))
+                    (if (eq word 'across-ref)
+                        (push (list var `(aref ,temp-vec ,temp-idx))
+                              cl--loop-symbol-macs)
+                      (push (list var nil) loop-for-bindings)
+                      (push (list var `(aref ,temp-vec ,temp-idx))
+                            loop-for-sets))))
+
+                 ((memq word '(element elements))
+                  (let ((ref (or (memq (peek) '(in-ref of-ref))
+                                 (and (not (memq (peek) '(in of)))
+                                      (error "Expected `of'"))))
+                        (seq (cl--pop2 cl--loop-args))
+                        (temp-seq (make-symbol "--cl-seq--"))
+                        (temp-idx
+                         (if (eq (peek) 'using)
+                             (if (and (= (length (cadr cl--loop-args)) 2)
+                                      (eq (caadr cl--loop-args) 'index))
+                                 (cadr (cl--pop2 cl--loop-args))
+                               (error "Bad `using' clause"))
+                           (make-symbol "--cl-idx--"))))
+                    (push (list temp-seq seq) loop-for-bindings)
+                    (push (list temp-idx 0) loop-for-bindings)
+                    (if ref
+                        (let ((temp-len (make-symbol "--cl-len--")))
+                          (push (list temp-len `(length ,temp-seq))
+                                loop-for-bindings)
+                          (push (list var `(elt ,temp-seq ,temp-idx))
+                                cl--loop-symbol-macs)
+                          (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
+                      (push (list var nil) loop-for-bindings)
+                      (cl--push-clause-loop-body `(and ,temp-seq
+                                                       (or (consp ,temp-seq)
+                                                           (< ,temp-idx (length ,temp-seq)))))
+                      (push (list var `(if (consp ,temp-seq)
+                                           (pop ,temp-seq)
+                                         (aref ,temp-seq ,temp-idx)))
+                            loop-for-sets))
+                    (push (list temp-idx `(1+ ,temp-idx))
+                          loop-for-steps)))
+
+                 ((memq word hash-types)
+                  (or (memq (peek) '(in of))
+                      (error "Expected `of'"))
+                  (let* ((table (cl--pop2 cl--loop-args))
+                         (other
+                          (if (eq (peek) 'using)
+                              (if (and (= (length (cadr cl--loop-args)) 2)
+                                       (memq (caadr cl--loop-args) hash-types)
+                                       (not (eq (caadr cl--loop-args) word)))
+                                  (cadr (cl--pop2 cl--loop-args))
+                                (error "Bad `using' clause"))
+                            (make-symbol "--cl-var--"))))
+                    (if (memq word '(hash-value hash-values))
+                        (setq var (prog1 other (setq other var))))
+                    (cl--loop-set-iterator-function
+                     'hash-tables (lambda (body)
+                                    `(maphash (lambda (,var ,other) . ,body)
+                                              ,table)))))
+
+                 ((memq word '(symbol present-symbol external-symbol
+                                      symbols present-symbols external-symbols))
+                  (let ((ob (and (memq (peek) '(in of))
+                                 (cl--pop2 cl--loop-args))))
+                    (cl--loop-set-iterator-function
+                     'symbols (lambda (body)
+                                `(mapatoms (lambda (,var) . ,body) ,ob)))))
+
+                 ((memq word '(overlay overlays extent extents))
+                  (let ((buf nil) (from nil) (to nil))
+                    (while (memq (peek) '(in of from to))
+                      (cond ((eq (peek) 'from)
+                             (setq from (cl--pop2 cl--loop-args)))
+                            ((eq (peek) 'to)
+                             (setq to (cl--pop2 cl--loop-args)))
+                            (t (setq buf (cl--pop2 cl--loop-args)))))
+                    (cl--loop-set-iterator-function
+                     'overlays (lambda (body)
+                                 `(cl--map-overlays
+                                   (lambda (,var ,(make-symbol "--cl-var--"))
+                                     (progn . ,body) nil)
+                                   ,buf ,from ,to)))))
+
+                 ((memq word '(interval intervals))
+                  (let ((buf nil) (prop nil) (from nil) (to nil)
+                        (var1 (make-symbol "--cl-var1--"))
+                        (var2 (make-symbol "--cl-var2--")))
+                    (while (memq (peek) '(in of property from to))
+                      (cond ((eq (peek) 'from)
+                             (setq from (cl--pop2 cl--loop-args)))
+                            ((eq (peek) 'to)
+                             (setq to (cl--pop2 cl--loop-args)))
+                            ((eq (peek) 'property)
+                             (setq prop (cl--pop2 cl--loop-args)))
+                            (t (setq buf (cl--pop2 cl--loop-args)))))
+                    (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
+                        (setq var1 (car var) var2 (cdr var))
+                      (push (list var `(cons ,var1 ,var2)) loop-for-sets))
+                    (cl--loop-set-iterator-function
+                     'intervals (lambda (body)
+                                  `(cl--map-intervals
+                                    (lambda (,var1 ,var2) . ,body)
+                                    ,buf ,prop ,from ,to)))))
+
+                 ((memq word key-types)
+                  (or (memq (peek) '(in of))
+                      (error "Expected `of'"))
+                  (let ((cl-map (cl--pop2 cl--loop-args))
+                        (other
+                         (if (eq (peek) 'using)
+                             (if (and (= (length (cadr cl--loop-args)) 2)
+                                      (memq (caadr cl--loop-args) key-types)
+                                      (not (eq (caadr cl--loop-args) word)))
+                                 (cadr (cl--pop2 cl--loop-args))
+                               (error "Bad `using' clause"))
+                           (make-symbol "--cl-var--"))))
+                    (if (memq word '(key-binding key-bindings))
+                        (setq var (prog1 other (setq other var))))
+                    (cl--loop-set-iterator-function
+                     'keys (lambda (body)
+                             `(,(if (memq word '(key-seq key-seqs))
+                                    'cl--map-keymap-recursively 'map-keymap)
+                               (lambda (,var ,other) . ,body) ,cl-map)))))
+
+                 ((memq word '(frame frames screen screens))
+                  (let ((temp (make-symbol "--cl-var--")))
+                    (push (list var  '(selected-frame))
+                          loop-for-bindings)
+                    (push (list temp nil) loop-for-bindings)
+                    (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+                                                  (or ,temp (setq ,temp ,var))))
+                    (push (list var `(next-frame ,var))
+                          loop-for-steps)))
+
+                 ((memq word '(window windows))
+                  (let ((scr (and (memq (peek) '(in of))
+                                  (cl--pop2 cl--loop-args)))
+                        (temp (make-symbol "--cl-var--"))
+                        (minip (make-symbol "--cl-minip--")))
+                    (push (list var (if scr
+                                        `(frame-selected-window ,scr)
+                                      '(selected-window)))
+                          loop-for-bindings)
+                    ;; If we started in the minibuffer, we need to
+                    ;; ensure that next-window will bring us back there
+                    ;; at some point.  (Bug#7492).
+                    ;; (Consider using walk-windows instead of cl-loop if
+                    ;; you care about such things.)
+                    (push (list minip `(minibufferp (window-buffer ,var)))
+                          loop-for-bindings)
+                    (push (list temp nil) loop-for-bindings)
+                    (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+                                                  (or ,temp (setq ,temp ,var))))
+                    (push (list var `(next-window ,var ,minip))
+                          loop-for-steps)))
+
+                 (t
+                  ;; This is an advertised interface: (info "(cl)Other Clauses").
+                  (let ((handler (and (symbolp word)
+                                      (get word 'cl-loop-for-handler))))
+                    (if handler
+                        (funcall handler var)
+                      (error "Expected a `for' preposition, found %s" word)))))
+                (eq (peek) 'and))
+            (setq ands t)
+            (pop cl--loop-args))
+          (if (and ands loop-for-bindings)
+              (push (nreverse loop-for-bindings) cl--loop-bindings)
+            (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings)
+                                           cl--loop-bindings)))
+          (if loop-for-sets
+              (push `(progn
+                       ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
+                       t)
+                    cl--loop-body))
+          (when loop-for-steps
+            (push (cons (if ands 'cl-psetq 'setq)
+                        (apply #'append (nreverse loop-for-steps)))
+                  cl--loop-steps))))
+
+       ((eq word 'repeat)
+        (let ((temp (make-symbol "--cl-var--")))
+          (push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
+          (push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
+
+       ((memq word '(collect collecting))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum nil 'nreverse)))
+          (if (eq var cl--loop-accum-var)
+              (push `(progn (push ,what ,var) t) cl--loop-body)
+            (push `(progn
+                     (setq ,var (nconc ,var (list ,what)))
                      t)
-                  cl--loop-body))
-	(when loop-for-steps
-	  (push (cons (if ands 'cl-psetq 'setq)
-		      (apply #'append (nreverse loop-for-steps)))
-		cl--loop-steps))))
-
-     ((eq word 'repeat)
-      (let ((temp (make-symbol "--cl-var--")))
-	(push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
-	(push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
-
-     ((memq word '(collect collecting))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum nil 'nreverse)))
-	(if (eq var cl--loop-accum-var)
-	    (push `(progn (push ,what ,var) t) cl--loop-body)
-	  (push `(progn
-                   (setq ,var (nconc ,var (list ,what)))
+                  cl--loop-body))))
+
+       ((memq word '(nconc nconcing append appending))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum nil 'nreverse)))
+          (push `(progn
+                   (setq ,var
+                         ,(if (eq var cl--loop-accum-var)
+                              `(nconc
+                                (,(if (memq word '(nconc nconcing))
+                                      #'nreverse #'reverse)
+                                 ,what)
+                                ,var)
+                            `(,(if (memq word '(nconc nconcing))
+                                   #'nconc #'append)
+                              ,var ,what)))
                    t)
-                cl--loop-body))))
-
-     ((memq word '(nconc nconcing append appending))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum nil 'nreverse)))
-	(push `(progn
-                 (setq ,var
-                       ,(if (eq var cl--loop-accum-var)
-                            `(nconc
-                              (,(if (memq word '(nconc nconcing))
-                                    #'nreverse #'reverse)
-                               ,what)
-                              ,var)
-                          `(,(if (memq word '(nconc nconcing))
-                                 #'nconc #'append)
-                            ,var ,what)))
-                 t)
-              cl--loop-body)))
-
-     ((memq word '(concat concating))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum "")))
-	(push `(progn (cl-callf concat ,var ,what) t) cl--loop-body)))
-
-     ((memq word '(vconcat vconcating))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum [])))
-	(push `(progn (cl-callf vconcat ,var ,what) t) cl--loop-body)))
-
-     ((memq word '(sum summing))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum 0)))
-	(push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
-
-     ((memq word '(count counting))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum 0)))
-	(push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
-
-     ((memq word '(minimize minimizing maximize maximizing))
-      (push `(progn ,(macroexp-let2 macroexp-copyable-p temp
-                                    (pop cl--loop-args)
-                       (let* ((var (cl--loop-handle-accum nil))
-                              (func (intern (substring (symbol-name word)
-                                                       0 3))))
-                         `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
-                    t)
-            cl--loop-body))
-
-     ((eq word 'with)
-      (let ((bindings nil))
-	(while (progn (push (list (pop cl--loop-args)
-				  (and (eq (car cl--loop-args) '=)
-                                       (cl--pop2 cl--loop-args)))
-			    bindings)
-		      (eq (car cl--loop-args) 'and))
-	  (pop cl--loop-args))
-	(push (nreverse bindings) cl--loop-bindings)))
-
-     ((eq word 'while)
-      (push (pop cl--loop-args) cl--loop-body))
-
-     ((eq word 'until)
-      (push `(not ,(pop cl--loop-args)) cl--loop-body))
-
-     ((eq word 'always)
-      (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
-      (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
-      (setq cl--loop-result t))
-
-     ((eq word 'never)
-      (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
-      (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
-	    cl--loop-body)
-      (setq cl--loop-result t))
-
-     ((eq word 'thereis)
-      (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
-      (or cl--loop-result-var
-          (setq cl--loop-result-var (make-symbol "--cl-var--")))
-      (push `(setq ,cl--loop-finish-flag
-                   (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
-	    cl--loop-body))
-
-     ((memq word '(if when unless))
-      (let* ((cond (pop cl--loop-args))
-	     (then (let ((cl--loop-body nil))
-		     (cl--parse-loop-clause)
-		     (cl--loop-build-ands (nreverse cl--loop-body))))
-	     (else (let ((cl--loop-body nil))
-		     (if (eq (car cl--loop-args) 'else)
-			 (progn (pop cl--loop-args) (cl--parse-loop-clause)))
-		     (cl--loop-build-ands (nreverse cl--loop-body))))
-	     (simple (and (eq (car then) t) (eq (car else) t))))
-	(if (eq (car cl--loop-args) 'end) (pop cl--loop-args))
-	(if (eq word 'unless) (setq then (prog1 else (setq else then))))
-	(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
-			  (if simple (nth 1 else) (list (nth 2 else))))))
-	  (setq form (if (cl--expr-contains form 'it)
-                         `(let ((it ,cond)) (if it ,@form))
-                       `(if ,cond ,@form)))
-	  (push (if simple `(progn ,form t) form) cl--loop-body))))
-
-     ((memq word '(do doing))
-      (let ((body nil))
-	(or (consp (car cl--loop-args)) (error "Syntax error on `do' clause"))
-	(while (consp (car cl--loop-args)) (push (pop cl--loop-args) body))
-	(push (cons 'progn (nreverse (cons t body))) cl--loop-body)))
-
-     ((eq word 'return)
-      (or cl--loop-finish-flag
-          (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
-      (or cl--loop-result-var
-          (setq cl--loop-result-var (make-symbol "--cl-var--")))
-      (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
-                   ,cl--loop-finish-flag nil)
-            cl--loop-body))
-
-     (t
-      ;; This is an advertised interface: (info "(cl)Other Clauses").
-      (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
-	(or handler (error "Expected a cl-loop keyword, found %s" word))
-	(funcall handler))))
-    (if (eq (car cl--loop-args) 'and)
-	(progn (pop cl--loop-args) (cl--parse-loop-clause)))))
+                cl--loop-body)))
+
+       ((memq word '(concat concating))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum "")))
+          (push `(progn (cl-callf concat ,var ,what) t) cl--loop-body)))
+
+       ((memq word '(vconcat vconcating))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum [])))
+          (push `(progn (cl-callf vconcat ,var ,what) t) cl--loop-body)))
+
+       ((memq word '(sum summing))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum 0)))
+          (push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
+
+       ((memq word '(count counting))
+        (let ((what (pop cl--loop-args))
+              (var (cl--loop-handle-accum 0)))
+          (push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
+
+       ((memq word '(minimize minimizing maximize maximizing))
+        (push `(progn ,(macroexp-let2 macroexp-copyable-p temp
+                                      (pop cl--loop-args)
+                         (let* ((var (cl--loop-handle-accum nil))
+                                (func (intern (substring (symbol-name word)
+                                                         0 3))))
+                           `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+                      t)
+              cl--loop-body))
+
+       ((eq word 'with)
+        (let ((bindings nil))
+          (while (progn (push (list (pop cl--loop-args)
+                                    (and (eq (peek) '=)
+                                         (cl--pop2 cl--loop-args)))
+                              bindings)
+                        (eq (peek) 'and))
+            (pop cl--loop-args))
+          (push (nreverse bindings) cl--loop-bindings)))
+
+       ((eq word 'while)
+        (push (pop cl--loop-args) cl--loop-body))
+
+       ((eq word 'until)
+        (push `(not ,(pop cl--loop-args)) cl--loop-body))
+
+       ((eq word 'always)
+        (or cl--loop-finish-flag
+            (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+        (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
+        (setq cl--loop-result t))
+
+       ((eq word 'never)
+        (or cl--loop-finish-flag
+            (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+        (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
+              cl--loop-body)
+        (setq cl--loop-result t))
+
+       ((eq word 'thereis)
+        (or cl--loop-finish-flag
+            (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+        (or cl--loop-result-var
+            (setq cl--loop-result-var (make-symbol "--cl-var--")))
+        (push `(setq ,cl--loop-finish-flag
+                     (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
+              cl--loop-body))
+
+       ((memq word '(if when unless))
+        (let* ((cond (pop cl--loop-args))
+               (then (let ((cl--loop-body nil))
+                       (cl--parse-loop-clause)
+                       (cl--loop-build-ands (nreverse cl--loop-body))))
+               (else (let ((cl--loop-body nil))
+                       (if (eq (peek) 'else)
+                           (progn (pop cl--loop-args) (cl--parse-loop-clause)))
+                       (cl--loop-build-ands (nreverse cl--loop-body))))
+               (simple (and (eq (car then) t) (eq (car else) t))))
+          (if (eq (peek) 'end) (pop cl--loop-args))
+          (if (eq word 'unless) (setq then (prog1 else (setq else then))))
+          (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
+                            (if simple (nth 1 else) (list (nth 2 else))))))
+            (setq form (if (cl--expr-contains form 'it)
+                           `(let ((it ,cond)) (if it ,@form))
+                         `(if ,cond ,@form)))
+            (push (if simple `(progn ,form t) form) cl--loop-body))))
+
+       ((memq word '(do doing))
+        (let ((body nil))
+          (or (consp (peek)) (error "Syntax error on `do' clause"))
+          (while (consp (peek)) (push (pop cl--loop-args) body))
+          (push (cons 'progn (nreverse (cons t body))) cl--loop-body)))
+
+       ((eq word 'return)
+        (or cl--loop-finish-flag
+            (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
+        (or cl--loop-result-var
+            (setq cl--loop-result-var (make-symbol "--cl-var--")))
+        (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
+                     ,cl--loop-finish-flag nil)
+              cl--loop-body))
+
+       (t
+        ;; This is an advertised interface: (info "(cl)Other Clauses").
+        (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
+          (or handler (error "Expected a cl-loop keyword, found %s" word))
+          (funcall handler))))
+      (if (eq (peek) 'and)
+          (progn (pop cl--loop-args) (cl--parse-loop-clause))))))
 
 (defun cl--unused-var-p (sym)
   (or (null sym) (eq ?_ (aref (symbol-name sym) 0))))
-- 
2.37.3