comparison lisp/emacs-lisp/bytecomp.el @ 105337:507e3735eed8

(byte-compile-defmacro-declaration): New fun. (byte-compile-file-form-defmumble, byte-compile-defmacro): Use it. (byte-compile-defmacro): Use backquotes.

105336:bd4a08d4865a

(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
(defun byte-compile-file-form-defmacro (form)
  (byte-compile-file-form-defmumble form t))

(defun byte-compile-file-form-defmumble (form macrop)
  (let* ((bytecomp-name (car (cdr form)))
	 (bytecomp-this-kind (if macrop 'byte-compile-macro-environment
		      'byte-compile-function-environment))
	 (bytecomp-that-kind (if macrop 'byte-compile-function-environment

			   (nth 1 form))))

    ;; Generate code for declarations in macro definitions.
    ;; Remove declarations from the body of the macro definition.
    (when macrop
      (let ((tail (nthcdr 2 form)))
	(when (stringp (car (cdr tail)))
	  (setq tail (cdr tail)))
	(while (and (consp (car (cdr tail)))
		    (eq (car (car (cdr tail))) 'declare))
	  (let ((declaration (car (cdr tail))))
	    (setcdr tail (cdr (cdr tail)))
	    (prin1 `(if macro-declaration-function
			(funcall macro-declaration-function
				 ',bytecomp-name ',declaration))
		   bytecomp-outbuffer)))))

    (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
	   (code (byte-compile-byte-code-maker new-one)))
      (if bytecomp-this-one
	  (setcdr bytecomp-this-one new-one)

  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect
   (list (list 'fset (list 'quote (nth 1 form))
	       (let ((code (byte-compile-byte-code-maker
			    (byte-compile-lambda (cdr (cdr form)) t))))
		 (if (eq (car-safe code) 'make-byte-code)
		     (list 'cons ''macro code)
		   (list 'quote (cons 'macro (eval code))))))
	 (list 'quote (nth 1 form)))))

(defun byte-compile-defvar (form)
  ;; This is not used for file-level defvar/consts with doc strings.
  (let ((fun (nth 0 form))
	(var (nth 1 form))

105337:507e3735eed8

(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
(defun byte-compile-file-form-defmacro (form)
  (byte-compile-file-form-defmumble form t))

(defun byte-compile-defmacro-declaration (form)
  "Generate code for declarations in macro definitions.
Remove declarations from the body of the macro definition
by side-effects."
  (let ((tail (nthcdr 2 form))
        (res '()))
    (when (stringp (car (cdr tail)))
      (setq tail (cdr tail)))
    (while (and (consp (car (cdr tail)))
                (eq (car (car (cdr tail))) 'declare))
      (let ((declaration (car (cdr tail))))
        (setcdr tail (cdr (cdr tail)))
        (push `(if macro-declaration-function
                   (funcall macro-declaration-function
                            ',(car (cdr form)) ',declaration))
              res)))
    res))

(defun byte-compile-file-form-defmumble (form macrop)
  (let* ((bytecomp-name (car (cdr form)))
	 (bytecomp-this-kind (if macrop 'byte-compile-macro-environment
		      'byte-compile-function-environment))
	 (bytecomp-that-kind (if macrop 'byte-compile-function-environment

			   (nth 1 form))))

    ;; Generate code for declarations in macro definitions.
    ;; Remove declarations from the body of the macro definition.
    (when macrop
      (dolist (decl (byte-compile-defmacro-declaration form))
        (prin1 decl bytecomp-outbuffer)))

    (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
	   (code (byte-compile-byte-code-maker new-one)))
      (if bytecomp-this-one
	  (setcdr bytecomp-this-one new-one)

  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect
   (let ((decls (byte-compile-defmacro-declaration form))
         (code (byte-compile-byte-code-maker
                (byte-compile-lambda (cdr (cdr form)) t))))
     `((defalias ',(nth 1 form)
         ,(if (eq (car-safe code) 'make-byte-code)
              `(cons 'macro ,code)
            `'(macro . ,(eval code))))
       ,@decls
       ',(nth 1 form)))))

(defun byte-compile-defvar (form)
  ;; This is not used for file-level defvar/consts with doc strings.
  (let ((fun (nth 0 form))
	(var (nth 1 form))