This came up with some code Didier pointed me towards off-list, and I think it makes this aspect of cl-macs substantially clearer. APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1305724912 -3600 # Node ID 9ac0016d8fe8de796c91284b29a09563b8ef3221 # Parent 3fe8358ad59ab0463fa1443600b522dbf0b13d5d Remove `bind-inits', cl-macs.el, it's no longer used. 2011-05-18 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-macs.el (bind-inits)): Removed. * cl-macs.el (defun*): * cl-macs.el (defmacro*): * cl-macs.el (function*): * cl-macs.el (macrolet): * cl-macs.el (cl-transform-function-property): * cl-macs.el (destructuring-bind): Remove `bind-inits' from this file, and only ever return nil as the first element of cl-transform-lambda's result list; bind-inits hasn't been used since the support for non-self-quoting keywords was removed, and its absence (and the guarantee that the first element of the result of cl-transform-lambda is nil) make the implementations of various other macros easier and clearer. * cl-macs.el (cl-transform-lambda): Give this function a docstring. diff -r 3fe8358ad59a -r 9ac0016d8fe8 lisp/ChangeLog --- a/lisp/ChangeLog Mon May 09 20:47:31 2011 +0100 +++ b/lisp/ChangeLog Wed May 18 14:21:52 2011 +0100 ＠＠ -1,3 +1,21 ＠＠ +2011-05-18 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * cl-macs.el (bind-inits)): Removed. + * cl-macs.el (defun*): + * cl-macs.el (defmacro*): + * cl-macs.el (function*): + * cl-macs.el (macrolet): + * cl-macs.el (cl-transform-function-property): + * cl-macs.el (destructuring-bind): + Remove `bind-inits' from this file, and only ever return nil as + the first element of cl-transform-lambda's result list; bind-inits + hasn't been used since the support for non-self-quoting keywords + was removed, and its absence (and the guarantee that the first + element of the result of cl-transform-lambda is nil) make the + implementations of various other macros easier and clearer. + * cl-macs.el (cl-transform-lambda): + Give this function a docstring. + 2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp-runtime.el: diff -r 3fe8358ad59a -r 9ac0016d8fe8 lisp/cl-macs.el --- a/lisp/cl-macs.el Mon May 09 20:47:31 2011 +0100 +++ b/lisp/cl-macs.el Wed May 18 14:21:52 2011 +0100 ＠＠ -222,9 +222,8 ＠＠ The format of each binding is VAR || (VAR [INITFORM]) -- exactly like the format of `let'/`let*' bindings. " - (let* ((res (cl-transform-lambda (list* arglist docstring body) name)) - (form (list* 'defun name (cdr res)))) - (if (car res) (list 'progn (car res) form) form))) + (list* 'defun name (cdr (cl-transform-lambda (list* arglist docstring body) + name)))) ;;;###autoload (defmacro defmacro* (name arglist &optional docstring &rest body) ＠＠ -278,33 +277,29 ＠＠ are ignored, not enough arguments cause the remaining parameters to receive a value of nil, etc. " - (let* ((res (cl-transform-lambda (list* arglist docstring body) name)) - (form (list* 'defmacro name (cdr res)))) - (if (car res) (list 'progn (car res) form) form))) + (list* 'defmacro name (cdr (cl-transform-lambda (list* arglist docstring body) + name)))) ;;;###autoload (defmacro function* (symbol-or-lambda) "Introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions." - (if (eq (car-safe symbol-or-lambda) 'lambda) - (let* ((res (cl-transform-lambda (cdr symbol-or-lambda) 'cl-none)) - (form (list 'function (cons 'lambda (cdr res))))) - (if (car res) (list 'progn (car res) form) form)) - (list 'function symbol-or-lambda))) + `(function + ,(if (eq (car-safe symbol-or-lambda) 'lambda) + (cons 'lambda (cdr (cl-transform-lambda (cdr symbol-or-lambda) + 'cl-none))) + symbol-or-lambda))) (defun cl-transform-function-property (func prop form) - (let ((res (cl-transform-lambda form func))) - (append '(progn) (cdr (cdr (car res))) - (list (list 'put (list 'quote func) (list 'quote prop) - (list 'function (cons 'lambda (cdr res)))))))) + `(put ',func ',prop #'(lambda ,＠(cdr (cl-transform-lambda form func))))) (defconst lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) (defvar cl-macro-environment nil) (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) -(defvar bind-inits) (defvar bind-lets) (defvar bind-forms) +(defvar bind-lets) (defvar bind-forms) ;; npak(a)ispras.ru (defun cl-upcase-arg (arg) ＠＠ -346,9 +341,20 ＠＠ (t "Not available"))))) (defun cl-transform-lambda (form bind-block) + "Transform a lambda expression to support Common Lisp conventions. + +FORM is the cdr of the lambda expression. BIND-BLOCK is the implicit block +name that's added, typically the name of the associated function. It can be +the symbol `cl-none', to indicate no implicit block is needed. + +The Common Lisp conventions described are those detailed in the `defun*' and +`defmacro*' docstrings. This function returns a list with the first element +nil, to be ignored. The rest of the list represents a transformed lambda +expression, with any argument list parsing code necessary, and a surrounding +block." (let* ((args (car form)) (body (cdr form)) (bind-defs nil) (bind-enquote nil) - (bind-inits nil) (bind-lets nil) (bind-forms nil) + (bind-lets nil) (bind-forms nil) (header nil) (simple-args nil) (complex-arglist (cl-function-arglist args)) (doc "")) ＠＠ -389,10 +395,10 ＠＠ (cl-do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) (setq bind-lets (nreverse bind-lets)) - (list* (and bind-inits (list* 'eval-when '(compile load eval) - (nreverse bind-inits))) - (nconc simple-args - (list '&rest (car (pop bind-lets)))) + ;; This code originally needed to create the keywords itself, that + ;; wasn't done by the Lisp reader; the first element of the result + ;; list comprised code to do this. It's not used any more. + (list* nil (nconc simple-args (list '&rest (car (pop bind-lets)))) ;; XEmacs change: we add usage information using Nickolay's ;; approach above (nconc header ＠＠ -571,13 +577,9 ＠＠ I say \"approximately\" because the destructuring works in a somewhat different fashion, although for most reasonably simple constructs the results will be the same." - (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) - (bind-defs nil) (bind-block 'cl-none)) + (let ((bind-block 'cl-none) bind-lets bind-forms bind-defs) (cl-do-arglist (or args '(&aux)) expr) - (append '(progn) bind-inits - (list (nconc (list 'let* (nreverse bind-lets)) - (nreverse bind-forms) body))))) - + (nconc (list 'let* (nreverse bind-lets)) (nreverse bind-forms) body))) ;;; The `eval-when' form. ＠＠ -1777,11 +1779,8 ＠＠ 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))))) + (list* name 'lambda (cdr (cl-transform-lambda details + name)))) cl-macro-environment))) ;;;###autoload -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches