changeset: 5326:60ba780f9078 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sun Jan 02 00:06:14 2011 +0000 files: lisp/ChangeLog lisp/cl-macs.el description: Use defmacro* when defining dolist, dotimes, do-symbols, macrolet, cl-macs.el 2011-01-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 47298dcf2e8f -r 60ba780f9078 lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * x-misc.el (device-x-display): diff -r 47298dcf2e8f -r 60ba780f9078 lisp/cl-macs.el --- 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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches