From bfca19e475c01f13dbacc7f8b7bb1aecf46cb7e4 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Mon, 8 Jan 2018 00:33:13 +0900 Subject: [PATCH] cl-loop: Calculate the array length just once * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): Dont calculate the array length on each iteration (Bug#29866). --- lisp/emacs-lisp/cl-macs.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16f33282bae..9af014cf8e9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1317,11 +1317,13 @@ 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) (push `(< (setq ,temp-idx (1+ ,temp-idx)) - (length ,temp-vec)) + ,temp-len) cl--loop-body) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) @@ -1336,6 +1338,7 @@ 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) @@ -1346,16 +1349,19 @@ 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 - (let ((temp-len (make-symbol "--cl-len--"))) + (progn (push (list temp-len `(length ,temp-seq)) loop-for-bindings) (push (list var `(elt ,temp-seq ,temp-idx)) cl--loop-symbol-macs) (push `(< ,temp-idx ,temp-len) cl--loop-body)) + ;; 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) (push (list var nil) loop-for-bindings) (push `(and ,temp-seq (or (consp ,temp-seq) - (< ,temp-idx (length ,temp-seq)))) + (< ,temp-idx ,temp-len))) cl--loop-body) (push (list var `(if (consp ,temp-seq) (pop ,temp-seq) -- 2.39.2