--- a/lisp/ChangeLog	Sat Jan 01 20:08:44 2011 +0000
+++ b/lisp/ChangeLog	Sun Jan 02 00:06:14 2011 +0000
@@ -1,3 +1,12 @@
+2011-01-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
+	(symbol-macrolet):
+	Define these macros with defmacro* instead of parsing the argument
+	list by hand, for the sake of style and readability; use backquote
+	where appropriate, instead of calling #'list and and friends, for
+	the same reason.
+
 2010-12-30  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* x-misc.el (device-x-display):

--- a/lisp/cl-macs.el	Sat Jan 01 20:08:44 2011 +0000
+++ b/lisp/cl-macs.el	Sun Jan 02 00:06:14 2011 +0000
@@ -1679,51 +1679,42 @@
 	       (or (cdr endtest) '(nil)))))
 
 ;;;###autoload
-(defmacro dolist (spec &rest body)
+(defmacro* dolist ((var list &optional result) &body body)
   "Loop over a list.
 Evaluate BODY with VAR bound to each `car' from LIST, in turn.
-Then evaluate RESULT to get return value, default nil.
-
-arguments: ((VAR LIST &optional RESULT) &body BODY)"
-  (let ((temp (gensym "--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))))))
+Then evaluate RESULT to get return value, default nil."
+  (let ((gensym (gensym)))
+    `(block nil
+      (let ((,gensym ,list) ,var)
+        (while ,gensym
+          (setq ,var (car ,gensym))
+          ,@body
+          (setq ,gensym (cdr ,gensym)))
+        ,@(if result `((setq ,var nil) ,result))))))
 
 ;;;###autoload
-(defmacro dotimes (spec &rest body)
+(defmacro* dotimes ((var count &optional result) &body body)
   "Loop a certain number of times.
 Evaluate BODY with VAR bound to successive integers from 0, inclusive,
 to COUNT, exclusive.  Then evaluate RESULT to get return value, default
-nil.
-
-arguments: ((VAR COUNT &optional RESULT) &body BODY)"
-  (let ((temp (gensym "--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))))))
+nil."
+  (let* ((limit (if (cl-const-expr-p count) count (gensym)))
+         (bind (if (cl-const-expr-p count) nil `((,limit ,count)))))
+    `(block nil
+      (let ((,var 0) ,@bind)
+        (while (< ,var ,limit)
+          ,@body
+          (setq ,var (1+ ,var)))
+        ,@(if result (list result))))))
 
 ;;;###autoload
-(defmacro do-symbols (spec &rest body)
-  "Loop over all symbols.
+(defmacro* do-symbols ((var &optional obarray result) &rest body)
+  "Loop over all interned symbols.
 Evaluate BODY with VAR bound to each interned symbol, or to each symbol
-from OBARRAY.
-
-arguments: ((VAR &optional OBARRAY RESULT) &body BODY)"
-  ;; Apparently this doesn't have an implicit block.
-  (list 'block nil
-	(list 'let (list (car spec))
-	      (list* 'mapatoms
-		     (list 'function (list* 'lambda (list (car spec)) body))
-		     (and (cadr spec) (list (cadr spec))))
-	      (caddr spec))))
+from OBARRAY."
+  `(block nil
+    (mapatoms #'(lambda (,var) ,@body) ,@(and obarray (list obarray)))
+    ,@(if result `((let (,var) ,result)))))
 
 ;;;###autoload
 (defmacro do-all-symbols (spec &rest body)
@@ -1806,37 +1797,34 @@
 ;; The following ought to have a better definition for use with newer
 ;; byte compilers.
 ;;;###autoload
-(defmacro macrolet (bindings &rest body)
+(defmacro* macrolet (((name arglist &optional docstring &body body)
+                       &rest macros) &body form)
   "Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
-
-arguments: (((NAME ARGLIST &optional DOCSTRING &body body) &rest MACROS) &body FORM)"
-  (if (cdr bindings)
-      (list 'macrolet
-	    (list (car bindings)) (list* 'macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (let* ((name (caar bindings))
-	     (res (cl-transform-lambda (cdar bindings) name)))
-	(eval (car res))
-	(cl-macroexpand-all (cons 'progn body)
-			    (cons (list* name 'lambda (cdr res))
-				  cl-macro-environment))))))
+This is like `flet', but for macros instead of functions."
+  (cl-macroexpand-all (cons 'progn form)
+                      (nconc
+                       (loop
+                         for (name . details)
+                         in (cons (list* name arglist docstring body) macros)
+                         collect
+                         (list* name 'lambda
+                                (prog1
+                                    (cdr (setq details (cl-transform-lambda
+                                                        details name)))
+                                  (eval (car details)))))
+                       cl-macro-environment)))
 
 ;;;###autoload
-(defmacro symbol-macrolet (bindings &rest body)
+(defmacro* symbol-macrolet (((name expansion) &rest symbol-macros) &body form)
   "Make symbol macro definitions.
 Within the body FORMs, references to the variable NAME will be replaced
-by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
-
-arguments: (((NAME EXPANSION) &rest SYMBOL-MACROS) &body FORM)"
-  (if (cdr bindings)
-      (list 'symbol-macrolet
-	    (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (cl-macroexpand-all (cons 'progn body)
-			  (cons (list (symbol-name (caar bindings))
-				      (cadar bindings))
-				cl-macro-environment)))))
+by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
+  (cl-macroexpand-all (cons 'progn form)
+                      (append (list (list (symbol-name name) expansion))
+                              (loop
+                                for (name expansion) in symbol-macros
+                                collect (list (symbol-name name) expansion))
+                              cl-macro-environment)))
 
 (defvar cl-closure-vars nil)
 ;;;###autoload