Merge from trunk.

[gnu-emacs] / lisp / emacs-lisp / cl-macs.el

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9ce3dd6a7fe3d4550472e690e608cc3370f6115d..d6b4643d6a4c4c13ebe96353b4d10e793420bc2e 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
   (let ((temp (make-symbol "--cl-dolist-temp--")))
-    (list 'block nil
-         (list* 'let (list (list temp (nth 1 spec)) (car spec))
-                (list* 'while temp (list 'setq (car spec) (list 'car temp))
-                       (append body (list (list 'setq temp
-                                                (list 'cdr temp)))))
-                (if (cdr (cdr spec))
-                    (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
-                  '(nil))))))
+    ;; FIXME: Copy&pasted from subr.el.
+    `(block nil
+       ;; This is not a reliable test, but it does not matter because both
+       ;; semantics are acceptable, tho one is slightly faster with dynamic
+       ;; scoping and the other is slightly faster (and has cleaner semantics)
+       ;; with lexical scoping.
+       ,(if lexical-binding
+            `(let ((,temp ,(nth 1 spec)))
+               (while ,temp
+                 (let ((,(car spec) (car ,temp)))
+                   ,@body
+                   (setq ,temp (cdr ,temp))))
+               ,@(if (cdr (cdr spec))
+                     ;; FIXME: This let often leads to "unused var" warnings.
+                     `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
+          `(let ((,temp ,(nth 1 spec))
+                 ,(car spec))
+             (while ,temp
+               (setq ,(car spec) (car ,temp))
+               ,@body
+               (setq ,temp (cdr ,temp)))
+             ,@(if (cdr (cdr spec))
+                   `((setq ,(car spec) nil) ,@(cddr spec))))))))
 
 ;;;###autoload
 (defmacro dotimes (spec &rest body)
@@ -1253,12 +1268,30 @@ to COUNT, exclusive.  Then evaluate RESULT to get return value, default
 nil.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
-  (let ((temp (make-symbol "--cl-dotimes-temp--")))
-    (list 'block nil
-         (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
-                (list* 'while (list '< (car spec) temp)
-                       (append body (list (list 'incf (car spec)))))
-                (or (cdr (cdr spec)) '(nil))))))
+  (let ((temp (make-symbol "--cl-dotimes-temp--"))
+       (end (nth 1 spec)))
+    ;; FIXME: Copy&pasted from subr.el.
+    `(block nil
+       ;; This is not a reliable test, but it does not matter because both
+       ;; semantics are acceptable, tho one is slightly faster with dynamic
+       ;; scoping and the other has cleaner semantics.
+       ,(if lexical-binding
+            (let ((counter '--dotimes-counter--))
+              `(let ((,temp ,end)
+                     (,counter 0))
+                 (while (< ,counter ,temp)
+                   (let ((,(car spec) ,counter))
+                     ,@body)
+                   (setq ,counter (1+ ,counter)))
+                 ,@(if (cddr spec)
+                       ;; FIXME: This let often leads to "unused var" warnings.
+                       `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
+          `(let ((,temp ,end)
+                 (,(car spec) 0))
+             (while (< ,(car spec) ,temp)
+               ,@body
+               (incf ,(car spec)))
+             ,@(cdr (cdr spec)))))))
 
 ;;;###autoload
 (defmacro do-symbols (spec &rest body)
@@ -1568,6 +1601,13 @@ values.  For compatibility, (values A B C) is a synonym for (list A B C).
 
 ;;;###autoload
 (defmacro declare (&rest specs)
+  "Declare SPECS about the current function while compiling.
+For instance
+
+  \(declare (warn 0))
+
+will turn off byte-compile warnings in the function.
+See Info node `(cl)Declarations' for details."
   (if (cl-compiling-file)
       (while specs
        (if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
@@ -2356,8 +2396,10 @@ value, that slot cannot be set via `setf'.
              (push (cons accessor t) side-eff)
              (push (list 'define-setf-method accessor '(cl-x)
                             (if (cadr (memq :read-only (cddr desc)))
-                                (list 'error (format "%s is a read-only slot"
-                                                     accessor))
+                                 (list 'progn '(ignore cl-x)
+                                       (list 'error
+                                             (format "%s is a read-only slot"
+                                                     'accessor)))
                               ;; If cl is loaded only for compilation,
                               ;; the call to cl-struct-setf-expander would
                               ;; cause a warning because it may not be