Commit 23aba0ea authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 2ec42da9
2011-03-13 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca> 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (apply-partially): Move from subr.el; don't use lexical-let. * subr.el (apply-partially): Move from subr.el; don't use lexical-let.
......
...@@ -1345,7 +1345,7 @@ extra args." ...@@ -1345,7 +1345,7 @@ extra args."
(let ((sig1 (byte-compile-arglist-signature (let ((sig1 (byte-compile-arglist-signature
(pcase old (pcase old
(`(lambda ,args . ,_) args) (`(lambda ,args . ,_) args)
(`(closure ,_ ,_ ,args . ,_) args) (`(closure ,_ ,args . ,_) args)
((pred byte-code-function-p) (aref old 0)) ((pred byte-code-function-p) (aref old 0))
(t '(&rest def))))) (t '(&rest def)))))
(sig2 (byte-compile-arglist-signature (nth 2 form)))) (sig2 (byte-compile-arglist-signature (nth 2 form))))
......
...@@ -86,8 +86,7 @@ redefine OBJECT if it is a symbol." ...@@ -86,8 +86,7 @@ redefine OBJECT if it is a symbol."
(setq macro t (setq macro t
obj (cdr obj))) obj (cdr obj)))
(when (and (listp obj) (eq (car obj) 'closure)) (when (and (listp obj) (eq (car obj) 'closure))
(setq lexical-binding t) (error "Don't know how to compile an interpreted closure"))
(setq obj (cddr obj)))
(if (and (listp obj) (eq (car obj) 'byte-code)) (if (and (listp obj) (eq (car obj) 'byte-code))
(setq obj (list 'lambda nil obj))) (setq obj (list 'lambda nil obj)))
(if (and (listp obj) (not (eq (car obj) 'lambda))) (if (and (listp obj) (not (eq (car obj) 'lambda)))
......
...@@ -104,8 +104,6 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." ...@@ -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 (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
;; If definition is a macro, find the function inside it. ;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def))) (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 (cond
((and (byte-code-function-p def) (integerp (aref def 0))) ((and (byte-code-function-p def) (integerp (aref def 0)))
(let* ((args-desc (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 ...)\"." ...@@ -124,6 +122,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
(nreverse arglist))) (nreverse arglist)))
((byte-code-function-p def) (aref def 0)) ((byte-code-function-p def) (aref def 0))
((eq (car-safe def) 'lambda) (nth 1 def)) ((eq (car-safe def) 'lambda) (nth 1 def))
((eq (car-safe def) 'closure) (nth 2 def))
((subrp def) ((subrp def)
(let ((arity (subr-arity def)) (let ((arity (subr-arity def))
(arglist ())) (arglist ()))
......
...@@ -124,7 +124,7 @@ ARGS is a list of the first N arguments to pass to FUN. ...@@ -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 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 the first N arguments are fixed at the values with which this function
was called." was called."
`(closure () lambda (&rest args) `(closure () (&rest args)
(apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
(if (null (featurep 'cl)) (if (null (featurep 'cl))
......
2011-03-13 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca> 2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR.
......
...@@ -746,8 +746,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) ...@@ -746,8 +746,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
{ {
Lisp_Object funcar = XCAR (fun); Lisp_Object funcar = XCAR (fun);
if (EQ (funcar, Qclosure)) if (EQ (funcar, Qclosure))
fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
if (EQ (funcar, Qlambda)) else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun))); return Fassq (Qinteractive, Fcdr (XCDR (fun)));
else if (EQ (funcar, Qautoload)) else if (EQ (funcar, Qautoload))
{ {
......
...@@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */) ...@@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */)
else if (EQ (funcar, Qkeymap)) else if (EQ (funcar, Qkeymap))
return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
else if (EQ (funcar, Qlambda) else if (EQ (funcar, Qlambda)
|| (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
|| EQ (funcar, Qautoload)) || EQ (funcar, Qautoload))
{ {
Lisp_Object tem1; Lisp_Object tem1;
...@@ -384,8 +385,6 @@ string is passed through `substitute-command-keys'. */) ...@@ -384,8 +385,6 @@ string is passed through `substitute-command-keys'. */)
else else
return Qnil; return Qnil;
} }
else if (EQ (funcar, Qclosure))
return Fdocumentation (Fcdr (XCDR (fun)), raw);
else if (EQ (funcar, Qmacro)) else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw); return Fdocumentation (Fcdr (fun), raw);
else else
...@@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) ...@@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset)
Lisp_Object tem; Lisp_Object tem;
tem = XCAR (fun); 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)); tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem))) if (CONSP (tem) && INTEGERP (XCAR (tem)))
...@@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) ...@@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset)
} }
else if (EQ (tem, Qmacro)) else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset); 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. */ /* Bytecode objects sometimes have slots for it. */
......
...@@ -487,7 +487,8 @@ usage: (function ARG) */) ...@@ -487,7 +487,8 @@ usage: (function ARG) */)
&& EQ (XCAR (quoted), Qlambda)) && EQ (XCAR (quoted), Qlambda))
/* This is a lambda expression within a lexical environment; /* This is a lambda expression within a lexical environment;
return an interpreted closure instead of a simple lambda. */ 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 else
/* Simply quote the argument. */ /* Simply quote the argument. */
return quoted; return quoted;
...@@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */) ...@@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */)
return Qnil; return Qnil;
funcar = XCAR (fun); funcar = XCAR (fun);
if (EQ (funcar, Qclosure)) if (EQ (funcar, Qclosure))
fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
if (EQ (funcar, Qlambda)) else if (EQ (funcar, Qlambda))
return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
else if (EQ (funcar, Qautoload)) else if (EQ (funcar, Qautoload))
return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
...@@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs, ...@@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs,
{ {
fun = XCDR (fun); /* Drop `closure'. */ fun = XCDR (fun); /* Drop `closure'. */
lexenv = XCAR (fun); lexenv = XCAR (fun);
fun = XCDR (fun); /* Drop the lexical environment. */ CHECK_LIST_CONS (fun, fun);
} }
else else
lexenv = Qnil; lexenv = Qnil;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment