* src/eval.c (Ffunction): Use simpler format for closures.
authorStefan Monnier <monnier@iro.umontreal.ca>
Sun, 13 Mar 2011 22:31:49 +0000 (18:31 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Sun, 13 Mar 2011 22:31:49 +0000 (18:31 -0400)
(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
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/disass.el
lisp/help-fns.el
lisp/subr.el
src/ChangeLog
src/data.c
src/doc.c
src/eval.c

index 01571b8..3b93d4e 100644 (file)
@@ -1,3 +1,10 @@
+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>
 
        * subr.el (apply-partially): Move from subr.el; don't use lexical-let.
index 729d91e..69733ed 100644 (file)
@@ -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))))
index 9ee02a9..9318876 100644 (file)
@@ -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)))
index f81505c..8209cde 100644 (file)
@@ -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 ()))
index 5faaa21..3a32a2f 100644 (file)
@@ -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))
index bbf7f99..00d8e4b 100644 (file)
@@ -1,3 +1,10 @@
+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>
 
        * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR.
index 186e9cb..6039743 100644 (file)
@@ -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))
        {
index de20edb..b56464e 100644 (file)
--- 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.  */
index 36c63a5..2fb89ce 100644 (file)
@@ -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;