diff options
| author | Stefan Monnier | 2011-03-13 18:31:49 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2011-03-13 18:31:49 -0400 |
| commit | 23aba0ea0e4922cfd8534f43667d3a758f2d2974 (patch) | |
| tree | 798c1de793ca32e93da9edac4705bcdb93aeecc7 | |
| parent | 2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 (diff) | |
| download | emacs-23aba0ea0e4922cfd8534f43667d3a758f2d2974.tar.gz emacs-23aba0ea0e4922cfd8534f43667d3a758f2d2974.zip | |
* 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.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/disass.el | 3 | ||||
| -rw-r--r-- | lisp/help-fns.el | 3 | ||||
| -rw-r--r-- | lisp/subr.el | 2 | ||||
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/data.c | 4 | ||||
| -rw-r--r-- | src/doc.c | 8 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2011-03-13 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * help-fns.el (help-function-arglist): | ||
| 4 | * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): | ||
| 5 | * subr.el (apply-partially): Adjust to new format. | ||
| 6 | * emacs-lisp/disass.el (disassemble-internal): Catch closures. | ||
| 7 | |||
| 1 | 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> | 8 | 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 9 | ||
| 3 | * subr.el (apply-partially): Move from subr.el; don't use lexical-let. | 10 | * 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." | |||
| 1345 | (let ((sig1 (byte-compile-arglist-signature | 1345 | (let ((sig1 (byte-compile-arglist-signature |
| 1346 | (pcase old | 1346 | (pcase old |
| 1347 | (`(lambda ,args . ,_) args) | 1347 | (`(lambda ,args . ,_) args) |
| 1348 | (`(closure ,_ ,_ ,args . ,_) args) | 1348 | (`(closure ,_ ,args . ,_) args) |
| 1349 | ((pred byte-code-function-p) (aref old 0)) | 1349 | ((pred byte-code-function-p) (aref old 0)) |
| 1350 | (t '(&rest def))))) | 1350 | (t '(&rest def))))) |
| 1351 | (sig2 (byte-compile-arglist-signature (nth 2 form)))) | 1351 | (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." | |||
| 86 | (setq macro t | 86 | (setq macro t |
| 87 | obj (cdr obj))) | 87 | obj (cdr obj))) |
| 88 | (when (and (listp obj) (eq (car obj) 'closure)) | 88 | (when (and (listp obj) (eq (car obj) 'closure)) |
| 89 | (setq lexical-binding t) | 89 | (error "Don't know how to compile an interpreted closure")) |
| 90 | (setq obj (cddr obj))) | ||
| 91 | (if (and (listp obj) (eq (car obj) 'byte-code)) | 90 | (if (and (listp obj) (eq (car obj) 'byte-code)) |
| 92 | (setq obj (list 'lambda nil obj))) | 91 | (setq obj (list 'lambda nil obj))) |
| 93 | (if (and (listp obj) (not (eq (car obj) 'lambda))) | 92 | (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 ...)\"." | |||
| 104 | (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) | 104 | (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) |
| 105 | ;; If definition is a macro, find the function inside it. | 105 | ;; If definition is a macro, find the function inside it. |
| 106 | (if (eq (car-safe def) 'macro) (setq def (cdr def))) | 106 | (if (eq (car-safe def) 'macro) (setq def (cdr def))) |
| 107 | ;; and do the same for interpreted closures | ||
| 108 | (if (eq (car-safe def) 'closure) (setq def (cddr def))) | ||
| 109 | (cond | 107 | (cond |
| 110 | ((and (byte-code-function-p def) (integerp (aref def 0))) | 108 | ((and (byte-code-function-p def) (integerp (aref def 0))) |
| 111 | (let* ((args-desc (aref def 0)) | 109 | (let* ((args-desc (aref def 0)) |
| @@ -124,6 +122,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." | |||
| 124 | (nreverse arglist))) | 122 | (nreverse arglist))) |
| 125 | ((byte-code-function-p def) (aref def 0)) | 123 | ((byte-code-function-p def) (aref def 0)) |
| 126 | ((eq (car-safe def) 'lambda) (nth 1 def)) | 124 | ((eq (car-safe def) 'lambda) (nth 1 def)) |
| 125 | ((eq (car-safe def) 'closure) (nth 2 def)) | ||
| 127 | ((subrp def) | 126 | ((subrp def) |
| 128 | (let ((arity (subr-arity def)) | 127 | (let ((arity (subr-arity def)) |
| 129 | (arglist ())) | 128 | (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. | |||
| 124 | The result is a new function which does the same as FUN, except that | 124 | The result is a new function which does the same as FUN, except that |
| 125 | the first N arguments are fixed at the values with which this function | 125 | the first N arguments are fixed at the values with which this function |
| 126 | was called." | 126 | was called." |
| 127 | `(closure () lambda (&rest args) | 127 | `(closure () (&rest args) |
| 128 | (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) | 128 | (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) |
| 129 | 129 | ||
| 130 | (if (null (featurep 'cl)) | 130 | (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 @@ | |||
| 1 | 2011-03-13 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * eval.c (Ffunction): Use simpler format for closures. | ||
| 4 | (Fcommandp, funcall_lambda): | ||
| 5 | * doc.c (Fdocumentation, store_function_docstring): | ||
| 6 | * data.c (Finteractive_form): Adjust to new closure format. | ||
| 7 | |||
| 1 | 2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> | 8 | 2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 9 | ||
| 3 | * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. | 10 | * 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). */) | |||
| 746 | { | 746 | { |
| 747 | Lisp_Object funcar = XCAR (fun); | 747 | Lisp_Object funcar = XCAR (fun); |
| 748 | if (EQ (funcar, Qclosure)) | 748 | if (EQ (funcar, Qclosure)) |
| 749 | fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); | 749 | return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); |
| 750 | if (EQ (funcar, Qlambda)) | 750 | else if (EQ (funcar, Qlambda)) |
| 751 | return Fassq (Qinteractive, Fcdr (XCDR (fun))); | 751 | return Fassq (Qinteractive, Fcdr (XCDR (fun))); |
| 752 | else if (EQ (funcar, Qautoload)) | 752 | else if (EQ (funcar, Qautoload)) |
| 753 | { | 753 | { |
| @@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */) | |||
| 369 | else if (EQ (funcar, Qkeymap)) | 369 | else if (EQ (funcar, Qkeymap)) |
| 370 | return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); | 370 | return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); |
| 371 | else if (EQ (funcar, Qlambda) | 371 | else if (EQ (funcar, Qlambda) |
| 372 | || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) | ||
| 372 | || EQ (funcar, Qautoload)) | 373 | || EQ (funcar, Qautoload)) |
| 373 | { | 374 | { |
| 374 | Lisp_Object tem1; | 375 | Lisp_Object tem1; |
| @@ -384,8 +385,6 @@ string is passed through `substitute-command-keys'. */) | |||
| 384 | else | 385 | else |
| 385 | return Qnil; | 386 | return Qnil; |
| 386 | } | 387 | } |
| 387 | else if (EQ (funcar, Qclosure)) | ||
| 388 | return Fdocumentation (Fcdr (XCDR (fun)), raw); | ||
| 389 | else if (EQ (funcar, Qmacro)) | 388 | else if (EQ (funcar, Qmacro)) |
| 390 | return Fdocumentation (Fcdr (fun), raw); | 389 | return Fdocumentation (Fcdr (fun), raw); |
| 391 | else | 390 | else |
| @@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) | |||
| 505 | Lisp_Object tem; | 504 | Lisp_Object tem; |
| 506 | 505 | ||
| 507 | tem = XCAR (fun); | 506 | tem = XCAR (fun); |
| 508 | if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | 507 | if (EQ (tem, Qlambda) || EQ (tem, Qautoload) |
| 508 | || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) | ||
| 509 | { | 509 | { |
| 510 | tem = Fcdr (Fcdr (fun)); | 510 | tem = Fcdr (Fcdr (fun)); |
| 511 | if (CONSP (tem) && INTEGERP (XCAR (tem))) | 511 | if (CONSP (tem) && INTEGERP (XCAR (tem))) |
| @@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) | |||
| 513 | } | 513 | } |
| 514 | else if (EQ (tem, Qmacro)) | 514 | else if (EQ (tem, Qmacro)) |
| 515 | store_function_docstring (XCDR (fun), offset); | 515 | store_function_docstring (XCDR (fun), offset); |
| 516 | else if (EQ (tem, Qclosure)) | ||
| 517 | store_function_docstring (Fcdr (XCDR (fun)), offset); | ||
| 518 | } | 516 | } |
| 519 | 517 | ||
| 520 | /* Bytecode objects sometimes have slots for it. */ | 518 | /* 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) */) | |||
| 487 | && EQ (XCAR (quoted), Qlambda)) | 487 | && EQ (XCAR (quoted), Qlambda)) |
| 488 | /* This is a lambda expression within a lexical environment; | 488 | /* This is a lambda expression within a lexical environment; |
| 489 | return an interpreted closure instead of a simple lambda. */ | 489 | return an interpreted closure instead of a simple lambda. */ |
| 490 | return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted)); | 490 | return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, |
| 491 | XCDR (quoted))); | ||
| 491 | else | 492 | else |
| 492 | /* Simply quote the argument. */ | 493 | /* Simply quote the argument. */ |
| 493 | return quoted; | 494 | return quoted; |
| @@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */) | |||
| 2079 | return Qnil; | 2080 | return Qnil; |
| 2080 | funcar = XCAR (fun); | 2081 | funcar = XCAR (fun); |
| 2081 | if (EQ (funcar, Qclosure)) | 2082 | if (EQ (funcar, Qclosure)) |
| 2082 | fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); | 2083 | return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; |
| 2083 | if (EQ (funcar, Qlambda)) | 2084 | else if (EQ (funcar, Qlambda)) |
| 2084 | return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; | 2085 | return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; |
| 2085 | else if (EQ (funcar, Qautoload)) | 2086 | else if (EQ (funcar, Qautoload)) |
| 2086 | return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; | 2087 | return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; |
| @@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs, | |||
| 3121 | { | 3122 | { |
| 3122 | fun = XCDR (fun); /* Drop `closure'. */ | 3123 | fun = XCDR (fun); /* Drop `closure'. */ |
| 3123 | lexenv = XCAR (fun); | 3124 | lexenv = XCAR (fun); |
| 3124 | fun = XCDR (fun); /* Drop the lexical environment. */ | 3125 | CHECK_LIST_CONS (fun, fun); |
| 3125 | } | 3126 | } |
| 3126 | else | 3127 | else |
| 3127 | lexenv = Qnil; | 3128 | lexenv = Qnil; |