changeset 5506:b0d87f92e60b

Complete support for macro-declaration-function, bytecomp{,-runtime}.el lisp/ChangeLog addition: 2011-05-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp-runtime.el: * bytecomp.el (byte-compile-file-form-defmumble): * bytecomp-runtime.el (macro-declaration-function): New. * subr.el: * subr.el (macro-declaration-function): Removed. Add support for macro-declaration-function, which is a GNU mechanism for indicating indentation and edebug information in macros (and only in macros). src/ChangeLog addition: 2011-05-07 Aidan Kehoe <kehoea@parhasard.net> * eval.c: * eval.c (Fdefmacro): * eval.c (syms_of_eval): Support macro-declaration-function in defmacro, incompletely and without documentation. * lisp.h: Declare Fnth here, necessary for the previous changes.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 08 May 2011 09:19:25 +0100
parents 3b220aa03f89
children 3fe8358ad59a
files lisp/ChangeLog lisp/bytecomp-runtime.el lisp/bytecomp.el lisp/subr.el src/ChangeLog src/eval.c src/lisp.h
diffstat 7 files changed, 119 insertions(+), 17 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat May 07 21:27:27 2011 +0100
+++ b/lisp/ChangeLog	Sun May 08 09:19:25 2011 +0100
@@ -1,3 +1,14 @@
+2011-05-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp-runtime.el:
+	* bytecomp.el (byte-compile-file-form-defmumble):
+	* bytecomp-runtime.el (macro-declaration-function): New.
+	* subr.el:
+	* subr.el (macro-declaration-function): Removed.
+	Add support for macro-declaration-function, which is a GNU
+	mechanism for indicating indentation and edebug information in
+	macros (and only in macros).
+
 2011-05-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* subr.el:
--- a/lisp/bytecomp-runtime.el	Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp-runtime.el	Sun May 08 09:19:25 2011 +0100
@@ -38,6 +38,43 @@
 
 ;;; Code:
 
+;; We define macro-declaration-function here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
+(defun macro-declaration-function (macro decl)
+  "Process a declaration found in a macro definition.
+This is set as the value of the variable `macro-declaration-function'.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The return value of this function is not used.
+
+XEmacs; any forms handed to the function described by the variable
+`macro-declaration-function' will also (eventually) be handled by the
+`declare' macro; see its documentation for further details of this."
+  ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+  (let (d)
+    ;; Ignore the first element of `decl' (it's always `declare').
+    (while (setq decl (cdr decl))
+      (setq d (car decl))
+      (if (and (consp d)
+	       (listp (cdr d))
+	       (null (cdr (cdr d))))
+	  (cond ((eq (car d) 'indent)
+		 (put macro 'lisp-indent-function (car (cdr d))))
+		((eq (car d) 'debug)
+		 (put macro 'edebug-form-spec (car (cdr d))))
+		((eq (car d) 'doc-string)
+                 ;;; #### XEmacs; not sure that this does anything sensible.
+		 (put macro 'doc-string-elt (car (cdr d))))
+                ;; XEmacs; don't warn about the known XEmacs declarations.
+                ((memq (car d) '(special inline notinline optimize warn)))
+		(t
+		 (message "Unknown declaration %s" d)))
+	(message "Invalid declaration %s" d)))))
+
+(setq macro-declaration-function 'macro-declaration-function)
+
+
 ;; Redefined in byte-optimize.el.
 ;; This is not documented--it's not clear that we should promote it.
 (fset 'inline 'progn)
--- a/lisp/bytecomp.el	Sat May 07 21:27:27 2011 +0100
+++ b/lisp/bytecomp.el	Sun May 08 09:19:25 2011 +0100
@@ -2297,6 +2297,26 @@
 	       (stringp (car-safe (cdr-safe (cdr-safe body)))))
 	  (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
 			     (nth 1 form))))
+
+    ;; Generate code for declarations in macro definitions.
+    ;; Remove declarations from the body of the macro definition.
+    (when macrop
+      (let ((byte-compile-defmacro-body (nthcdr 3 form)))
+        (if (stringp (car byte-compile-defmacro-body))
+            (setq byte-compile-defmacro-body (nthcdr 4 form)))
+        (when (and (consp byte-compile-defmacro-body)
+                   (eq 'declare (car-safe (car byte-compile-defmacro-body))))
+          (if (eq 'declare (car-safe (car-safe
+                                      (cdr byte-compile-defmacro-body))))
+              (byte-compile-warn "Multiple macro-specific `declare' calls \
+not supported by XEmacs."))
+          (setq byte-compile-output-preface
+                (byte-compile-top-level
+                 `(progn (and macro-declaration-function
+                              (funcall macro-declaration-function
+                                       ',name
+                                       ',(car byte-compile-defmacro-body)))
+                         ,byte-compile-output-preface) t 'file)))))
     (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
 	   (code (byte-compile-byte-code-maker new-one))
            (docform-info
--- a/lisp/subr.el	Sat May 07 21:27:27 2011 +0100
+++ b/lisp/subr.el	Sun May 08 09:19:25 2011 +0100
@@ -39,22 +39,6 @@
 
 ;; XEmacs; no need for custom-declare-variable-list, preloaded-file-list is
 ;; ordered to make it unnecessary.
-
-(defun macro-declaration-function (macro decl)
-  "Process a declaration found in a macro definition.
-This is set as the value of the variable `macro-declaration-function'.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The return value of this function is not used."
-  (dolist (d (cdr decl))
-    (cond ((and (consp d) (eq (car d) 'indent))
-	   (put macro 'lisp-indent-function (cadr d)))
-	  ((and (consp d) (eq (car d) 'debug))
-	   (put macro 'edebug-form-spec (cadr d)))
-	  (t
-	   (message "Unknown declaration %s" d)))))
-
-(setq macro-declaration-function 'macro-declaration-function)
 
 ;; XEmacs; this is here because we use it in backquote.el, so it needs to be
 ;; available the first time a `(...) form is expanded.
--- a/src/ChangeLog	Sat May 07 21:27:27 2011 +0100
+++ b/src/ChangeLog	Sun May 08 09:19:25 2011 +0100
@@ -1,3 +1,13 @@
+2011-05-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* eval.c:
+	* eval.c (Fdefmacro):
+	* eval.c (syms_of_eval):
+	Support macro-declaration-function in defmacro, incompletely and
+	without documentation.
+	* lisp.h:
+	Declare Fnth here, necessary for the previous changes.
+
 2011-05-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* s/netbsd.h:
--- a/src/eval.c	Sat May 07 21:27:27 2011 +0100
+++ b/src/eval.c	Sun May 08 09:19:25 2011 +0100
@@ -224,7 +224,7 @@
    every attempt to throw past this level. */
 Lisp_Object Vcatch_everything_tag;
 
-Lisp_Object Qautoload, Qmacro, Qexit;
+Lisp_Object Qautoload, Qmacro, Qexit, Qdeclare;
 Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
 Lisp_Object Vquit_flag, Vinhibit_quit;
 Lisp_Object Qand_rest, Qand_optional;
@@ -273,6 +273,8 @@
    (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */
 Lisp_Object Vautoload_queue;
 
+Lisp_Object Vmacro_declaration_function;
+
 /* Current number of specbindings allocated in specpdl.  */
 int specpdl_size;
 
@@ -1406,6 +1408,33 @@
        (args))
 {
   /* This function can GC */
+  if (!NILP (Vmacro_declaration_function))
+    {
+      Lisp_Object declare = Fnth (make_int (2), args);
+
+      /* Sigh. This GNU interface is incompatible with the CL declare macro,
+         and the latter is much older.
+
+         GNU describe this syntax in their docstrings. It's sufficiently
+         ugly in the XEmacs context (and in general, but ...) that I'm not
+         rushing to document it.
+
+         The GNU interface accepts multiple (declare ...) sexps at the
+         beginning of a macro. Nothing uses this, and the XEmacs byte
+         compiler (will) warn(s) if it encounters code that attempts to use
+         it. */
+
+      if (STRINGP (declare))
+        {
+          declare = Fnth (make_int (3), args);
+        }
+
+      if (CONSP (declare) && EQ (Qdeclare, XCAR (declare)))
+        {
+          call2 (Vmacro_declaration_function, XCAR (args), declare);
+        }
+    }
+
   return define_function (XCAR (args),
 			  Fcons (Qmacro, Fcons (Qlambda, XCDR (args))));
 }
@@ -7315,6 +7344,7 @@
   defsymbol (&Qand_optional, "&optional");
   /* Note that the process code also uses Qexit */
   DEFSYMBOL (Qexit);
+  DEFSYMBOL (Qdeclare);
   DEFSYMBOL (Qsetq);
   DEFSYMBOL (Qinteractive);
   DEFSYMBOL (Qcommandp);
@@ -7572,6 +7602,15 @@
 */);
   Vmultiple_values_limit = EMACS_INT_MAX > INT_MAX ? INT_MAX : EMACS_INT_MAX;
 
+  DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function /*
+Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.
+*/);
+  Vmacro_declaration_function = Qnil;
+
   staticpro (&Vcatch_everything_tag);
   Vcatch_everything_tag = make_opaque (OPAQUE_CLEAR, 0);
 
--- a/src/lisp.h	Sat May 07 21:27:27 2011 +0100
+++ b/src/lisp.h	Sun May 08 09:19:25 2011 +0100
@@ -5247,6 +5247,7 @@
 EXFUN (Fnconc, MANY);
 MODULE_API EXFUN (Fnreverse, 1);
 EXFUN (Fnthcdr, 2);
+EXFUN (Fnth, 2);
 EXFUN (Fold_assq, 2);
 EXFUN (Fold_equal, 2);
 EXFUN (Fold_member, 2);