aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2020-04-30 19:33:51 -0400
committerNoam Postavsky2020-05-05 21:07:58 -0400
commitde1b33f5a8c6ceee9be59285f70370c3cb2efd34 (patch)
tree41fd81f55ba3f1b4a27e89a7f92e0368ba5f8d38
parentcaf155c4638d4704b2a099657153c9abc115720b (diff)
downloademacs-de1b33f5a8c6ceee9be59285f70370c3cb2efd34.tar.gz
emacs-de1b33f5a8c6ceee9be59285f70370c3cb2efd34.zip
Revert "cl-loop: Calculate the array length just once"
Don't merge to master. This is a safe-for-release fix for Bug#40727.
-rw-r--r--lisp/emacs-lisp/cl-macs.el12
1 files changed, 3 insertions, 9 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 00f34d3fb60..78d083fcc63 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1322,13 +1322,11 @@ For more details, see Info node `(cl)Loop Facility'.
1322 1322
1323 ((memq word '(across across-ref)) 1323 ((memq word '(across across-ref))
1324 (let ((temp-vec (make-symbol "--cl-vec--")) 1324 (let ((temp-vec (make-symbol "--cl-vec--"))
1325 (temp-len (make-symbol "--cl-len--"))
1326 (temp-idx (make-symbol "--cl-idx--"))) 1325 (temp-idx (make-symbol "--cl-idx--")))
1327 (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) 1326 (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
1328 (push (list temp-len `(length ,temp-vec)) loop-for-bindings)
1329 (push (list temp-idx -1) loop-for-bindings) 1327 (push (list temp-idx -1) loop-for-bindings)
1330 (push `(< (setq ,temp-idx (1+ ,temp-idx)) 1328 (push `(< (setq ,temp-idx (1+ ,temp-idx))
1331 ,temp-len) 1329 (length ,temp-vec))
1332 cl--loop-body) 1330 cl--loop-body)
1333 (if (eq word 'across-ref) 1331 (if (eq word 'across-ref)
1334 (push (list var `(aref ,temp-vec ,temp-idx)) 1332 (push (list var `(aref ,temp-vec ,temp-idx))
@@ -1343,7 +1341,6 @@ For more details, see Info node `(cl)Loop Facility'.
1343 (error "Expected `of'")))) 1341 (error "Expected `of'"))))
1344 (seq (cl--pop2 cl--loop-args)) 1342 (seq (cl--pop2 cl--loop-args))
1345 (temp-seq (make-symbol "--cl-seq--")) 1343 (temp-seq (make-symbol "--cl-seq--"))
1346 (temp-len (make-symbol "--cl-len--"))
1347 (temp-idx 1344 (temp-idx
1348 (if (eq (car cl--loop-args) 'using) 1345 (if (eq (car cl--loop-args) 'using)
1349 (if (and (= (length (cadr cl--loop-args)) 2) 1346 (if (and (= (length (cadr cl--loop-args)) 2)
@@ -1354,19 +1351,16 @@ For more details, see Info node `(cl)Loop Facility'.
1354 (push (list temp-seq seq) loop-for-bindings) 1351 (push (list temp-seq seq) loop-for-bindings)
1355 (push (list temp-idx 0) loop-for-bindings) 1352 (push (list temp-idx 0) loop-for-bindings)
1356 (if ref 1353 (if ref
1357 (progn 1354 (let ((temp-len (make-symbol "--cl-len--")))
1358 (push (list temp-len `(length ,temp-seq)) 1355 (push (list temp-len `(length ,temp-seq))
1359 loop-for-bindings) 1356 loop-for-bindings)
1360 (push (list var `(elt ,temp-seq ,temp-idx)) 1357 (push (list var `(elt ,temp-seq ,temp-idx))
1361 cl--loop-symbol-macs) 1358 cl--loop-symbol-macs)
1362 (push `(< ,temp-idx ,temp-len) cl--loop-body)) 1359 (push `(< ,temp-idx ,temp-len) cl--loop-body))
1363 ;; Evaluate seq length just if needed, that is, when seq is not a cons.
1364 (push (list temp-len (or (consp seq) `(length ,temp-seq)))
1365 loop-for-bindings)
1366 (push (list var nil) loop-for-bindings) 1360 (push (list var nil) loop-for-bindings)
1367 (push `(and ,temp-seq 1361 (push `(and ,temp-seq
1368 (or (consp ,temp-seq) 1362 (or (consp ,temp-seq)
1369 (< ,temp-idx ,temp-len))) 1363 (< ,temp-idx (length ,temp-seq))))
1370 cl--loop-body) 1364 cl--loop-body)
1371 (push (list var `(if (consp ,temp-seq) 1365 (push (list var `(if (consp ,temp-seq)
1372 (pop ,temp-seq) 1366 (pop ,temp-seq)