diff options
author | Noam Postavsky <npostavs@gmail.com> | 2020-04-30 07:54:49 -0400 |
---|---|---|
committer | Noam Postavsky <npostavs@gmail.com> | 2020-05-07 08:23:56 -0400 |
commit | de7158598fcd5440c0180ff6f83052c29e490bcd (patch) | |
tree | 8e0c7b89a7c0e6b738228a9b4cba3708bd9d8afe /lisp/emacs-lisp | |
parent | 2c905fb8a1d95a72e4b8a9b138458c86b099ced1 (diff) | |
download | emacs-de7158598fcd5440c0180ff6f83052c29e490bcd.tar.gz |
Revert "cl-loop: Calculate the array length just once"
It fails when using 'and' (parallel bindings) for arrays (Bug#40727).
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): Revert to
recomputing array length.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-loop-and-arrays): New
test.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 14 |
1 files changed, 4 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 4408bb58464..fef8786b599 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1317,13 +1317,11 @@ For more details, see Info node `(cl)Loop Facility'. ((memq word '(across across-ref)) (let ((temp-vec (make-symbol "--cl-vec--")) - (temp-len (make-symbol "--cl-len--")) (temp-idx (make-symbol "--cl-idx--"))) (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) - (push (list temp-len `(length ,temp-vec)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) (cl--push-clause-loop-body - `(< (setq ,temp-idx (1+ ,temp-idx)) ,temp-len)) + `(< (setq ,temp-idx (1+ ,temp-idx)) (length ,temp-vec))) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) cl--loop-symbol-macs) @@ -1337,7 +1335,6 @@ For more details, see Info node `(cl)Loop Facility'. (error "Expected `of'")))) (seq (cl--pop2 cl--loop-args)) (temp-seq (make-symbol "--cl-seq--")) - (temp-len (make-symbol "--cl-len--")) (temp-idx (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) @@ -1348,19 +1345,16 @@ For more details, see Info node `(cl)Loop Facility'. (push (list temp-seq seq) loop-for-bindings) (push (list temp-idx 0) loop-for-bindings) (if ref - (progn + (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))) - ;; Evaluate seq length just if needed, that is, when seq is not a cons. - (push (list temp-len (or (consp seq) `(length ,temp-seq))) - loop-for-bindings) + (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 ,temp-len)))) + (< ,temp-idx (length ,temp-seq))))) (push (list var `(if (consp ,temp-seq) (pop ,temp-seq) (aref ,temp-seq ,temp-idx))) |