aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-03-13 18:31:49 -0400
committerStefan Monnier2011-03-13 18:31:49 -0400
commit23aba0ea0e4922cfd8534f43667d3a758f2d2974 (patch)
tree798c1de793ca32e93da9edac4705bcdb93aeecc7
parent2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 (diff)
downloademacs-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/ChangeLog7
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/disass.el3
-rw-r--r--lisp/help-fns.el3
-rw-r--r--lisp/subr.el2
-rw-r--r--src/ChangeLog7
-rw-r--r--src/data.c4
-rw-r--r--src/doc.c8
-rw-r--r--src/eval.c9
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 @@
12011-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
12011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> 82011-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.
124The result is a new function which does the same as FUN, except that 124The result is a new function which does the same as FUN, except that
125the first N arguments are fixed at the values with which this function 125the first N arguments are fixed at the values with which this function
126was called." 126was 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 @@
12011-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
12011-03-11 Stefan Monnier <monnier@iro.umontreal.ca> 82011-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 {
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'. */)
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;