From 23aba0ea0e4922cfd8534f43667d3a758f2d2974 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Mar 2011 18:31:49 -0400 Subject: [PATCH] * src/eval.c (Ffunction): Use simpler format for closures. (Fcommandp, funcall_lambda): * src/doc.c (Fdocumentation, store_function_docstring): * src/data.c (Finteractive_form): * lisp/help-fns.el (help-function-arglist): * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): * lisp/subr.el (apply-partially): Adjust to new closure format. * lisp/emacs-lisp/disass.el (disassemble-internal): Catch closures. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/disass.el | 3 +-- lisp/help-fns.el | 3 +-- lisp/subr.el | 2 +- src/ChangeLog | 7 +++++++ src/data.c | 4 ++-- src/doc.c | 8 +++----- src/eval.c | 9 +++++---- 9 files changed, 28 insertions(+), 17 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01571b80124..3b93d4ecee7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2011-03-13 Stefan Monnier + + * help-fns.el (help-function-arglist): + * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): + * subr.el (apply-partially): Adjust to new format. + * emacs-lisp/disass.el (disassemble-internal): Catch closures. + 2011-03-12 Stefan Monnier * subr.el (apply-partially): Move from subr.el; don't use lexical-let. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 729d91eb1c5..69733ed2e8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1345,7 +1345,7 @@ extra args." (let ((sig1 (byte-compile-arglist-signature (pcase old (`(lambda ,args . ,_) args) - (`(closure ,_ ,_ ,args . ,_) args) + (`(closure ,_ ,args . ,_) args) ((pred byte-code-function-p) (aref old 0)) (t '(&rest def))))) (sig2 (byte-compile-arglist-signature (nth 2 form)))) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9ee02a98e5e..9318876fe61 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -86,8 +86,7 @@ redefine OBJECT if it is a symbol." (setq macro t obj (cdr obj))) (when (and (listp obj) (eq (car obj) 'closure)) - (setq lexical-binding t) - (setq obj (cddr obj))) + (error "Don't know how to compile an interpreted closure")) (if (and (listp obj) (eq (car obj) 'byte-code)) (setq obj (list 'lambda nil obj))) (if (and (listp obj) (not (eq (car obj) 'lambda))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index f81505c1cf1..8209cdebd3c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -104,8 +104,6 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) - ;; and do the same for interpreted closures - (if (eq (car-safe def) 'closure) (setq def (cddr def))) (cond ((and (byte-code-function-p def) (integerp (aref def 0))) (let* ((args-desc (aref def 0)) @@ -124,6 +122,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) + ((eq (car-safe def) 'closure) (nth 2 def)) ((subrp def) (let ((arity (subr-arity def)) (arglist ())) diff --git a/lisp/subr.el b/lisp/subr.el index 5faaa2130a2..3a32a2f6558 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -124,7 +124,7 @@ ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." - `(closure () lambda (&rest args) + `(closure () (&rest args) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) (if (null (featurep 'cl)) diff --git a/src/ChangeLog b/src/ChangeLog index bbf7f99bb32..00d8e4b8ee3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-03-13 Stefan Monnier + + * eval.c (Ffunction): Use simpler format for closures. + (Fcommandp, funcall_lambda): + * doc.c (Fdocumentation, store_function_docstring): + * data.c (Finteractive_form): Adjust to new closure format. + 2011-03-11 Stefan Monnier * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. diff --git a/src/data.c b/src/data.c index 186e9cb9859..6039743b1d5 100644 --- a/src/data.c +++ b/src/data.c @@ -746,8 +746,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) { Lisp_Object funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); + else if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) { diff --git a/src/doc.c b/src/doc.c index de20edb2d98..b56464e7219 100644 --- a/src/doc.c +++ b/src/doc.c @@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */) else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); else if (EQ (funcar, Qlambda) + || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) || EQ (funcar, Qautoload)) { Lisp_Object tem1; @@ -384,8 +385,6 @@ string is passed through `substitute-command-keys'. */) else return Qnil; } - else if (EQ (funcar, Qclosure)) - return Fdocumentation (Fcdr (XCDR (fun)), raw); else if (EQ (funcar, Qmacro)) return Fdocumentation (Fcdr (fun), raw); else @@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) Lisp_Object tem; tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) + if (EQ (tem, Qlambda) || EQ (tem, Qautoload) + || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && INTEGERP (XCAR (tem))) @@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) } else if (EQ (tem, Qmacro)) store_function_docstring (XCDR (fun), offset); - else if (EQ (tem, Qclosure)) - store_function_docstring (Fcdr (XCDR (fun)), offset); } /* Bytecode objects sometimes have slots for it. */ diff --git a/src/eval.c b/src/eval.c index 36c63a5c8a7..2fb89ce404e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -487,7 +487,8 @@ usage: (function ARG) */) && EQ (XCAR (quoted), Qlambda)) /* This is a lambda expression within a lexical environment; return an interpreted closure instead of a simple lambda. */ - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted)); + return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, + XCDR (quoted))); else /* Simply quote the argument. */ return quoted; @@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; @@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs, { fun = XCDR (fun); /* Drop `closure'. */ lexenv = XCAR (fun); - fun = XCDR (fun); /* Drop the lexical environment. */ + CHECK_LIST_CONS (fun, fun); } else lexenv = Qnil; -- 2.39.5