Path: utzoo!utgpu!jarvis.csri.toronto.edu!clyde.concordia.ca!uunet!bu.edu!bu-cs!snorkelwacker!tut.cis.ohio-state.edu!BOURBAKI.MIT.EDU!drw
From: drw@BOURBAKI.MIT.EDU
Newsgroups: gnu.emacs.bug
Subject: Improvements to byte-compile
Message-ID: <9001050155.AA04895@hermite.mit.edu>
Date: 5 Jan 90 01:55:55 GMT
Sender: daemon@tut.cis.ohio-state.edu
Distribution: gnu
Organization: GNUs Not Usenet
Lines: 210

I've worked out some improvements to the byte compiler.  It has two
improvements over the existing (18.54) version:

1) It handles defun's that are not at the top level of an expression.
Thus

	(if (not (fboundp 'foo))
	    (defun foo ...))

and

	(global-set-key "xxx" (function (lambda ...)))

will have the bodies byte-compiled.  The present compiler does not
byte compile the bodies.

2) defun, defmacro, defconst, and defvar special forms that are not at
the top level of an expression are byte-compiled into correct (but
inefficient) code.  The present compiler compiles these forms as if
they were function calls, and the code fails at runtime.

This code also includes the code I sent in earlier that allows forms
like

	((lambda (x) ...) (...))

to compile correctly.

Since the new compiler compiles more bodies, code that has compiled
before may fail to compile because it contains macros that cannot be
successfully expanded at byte-compile time.  I have added the macros
byte-compile-protect and defmacro-protect to allow the user to protect
code from macro expansion at byte-compile time, at the cost of
interpretation at run time.

I have compiled all the .el's shipped with Gnu Emacs 18.54 and
compared the results with the .elc's that our installation now has.
The differences I have found are:

. bibtex.el uses the defmenu macro, so it should have a
"(require 'sun-mouse)" at the top.

. doctor.el has a spurious trailing "4" on line 759.

. The definition of the macro defcursor in sun-cursors.el should use
defmacro-protect.  Better, the definition should be changed to:

	(defmacro defcursor (name x y string)
	  (` (progn
	       (if (not (memq '(, name) sc::cursors)) 
		   (setq sc::cursors (cons '(, name) sc::cursors)))
	       (defconst (, name) '(, (list 'vector x y string))))))

so that the insertion into the list sc::cursors is done at the time
that the defconst of the name is done, not at the time that the
defcursor macro is expanded.

. cl.el is not compilable with the 18.54 byte compiler, due to using the
"do" macro before defining it.  (Where the cl.elc in 18.54 comes from,
I have no idea.)

Once these revisions are made, the new bytecomp produces the same
.elc's as the old, except that certain macros which expand to defun's
now have the generated code compiled.

----------------------------------------------------------------------
(require 'byte-compile "bytecomp")

;; (byte-comp-protect form) becomes (eval 'form)
(defmacro byte-comp-protect (form)
  "The macro call `(byte-comp-protect FORM)' will execute FORM at run
time, but will protect it from being examined at byte-compile time.
This is useful if FORM contains macros which must be expanded at run time."
  (` (eval (quote (, form)))))

;; A clever piece of code to control exactly when everything is evaluated,
;; if I do say so myself.
(defmacro defmacro-protect (name arg-list &rest body)
  "Takes the same arguments and has the same effect as defmacro, but
guarantees that the body of the macro will not be executed when the code
is byte-compiled, but rather will be executed at runtime.
Of course, the resulting code is not very efficient.  Any macro that needs to
be defined with defmacro-protect should be rewritten."
  (let (doc-string)
    (if (stringp (car body))
	(progn (setq doc-string (list (car body)))
	       (setq body (cdr body))))
    (` (defmacro
	 (, name)
	 (, arg-list)
	 (,@ doc-string)
	 (` (eval
	     (let (, (mapcar (function 
			      (lambda (x) (` ((, x) (quote ((, ',) (, x)))))))
			     (delq '&rest
				   (delq '&optional
					 (copy-sequence arg-list)))))
	       (,@ body))))))))

(defun byte-compile-form (form)
  (setq form (macroexpand form byte-compile-macro-environment))
  (cond ((eq form 'nil)
	 (byte-compile-constant form))
	((eq form 't)
	 (byte-compile-constant form))
	((symbolp form)
	 (byte-compile-variable-ref 'byte-varref form))
	((not (consp form))
	 (byte-compile-constant form))
	((eq (car-safe (car form)) 'lambda)
	 (byte-compile-form
	  (` (funcall (quote (, (byte-compile-lambda (car form))))
		      (,@ (cdr form))))))
	((not (symbolp (car form)))
	 (signal 'invalid-function (list (car form))))
	(t
	 (let ((handler (get (car form) 'byte-compile)))
	   (if handler
	       (funcall handler form)
	     (byte-compile-normal-call form)))))
  (setq byte-compile-maxdepth
	(max byte-compile-maxdepth
	     (setq byte-compile-depth (1+ byte-compile-depth)))))

(defun byte-compile-file-form (form)
  (setq form (macroexpand form byte-compile-macro-environment))
  (cond ((not (listp form))
	 form)
	((memq (car form) '(defun defmacro))
	 (let* ((name (car (cdr form)))
		(tem (assq name byte-compile-macro-environment)))
	   (if (eq (car form) 'defun)
	       (progn
		 (message "Compiling %s (%s)..." filename (nth 1 form))
		 (cond (tem (setcdr tem nil))
		       ((and (fboundp name)
			     (eq (car-safe (symbol-function name)) 'macro))
			;; shadow existing macro definition
			(setq byte-compile-macro-environment
			      (cons (cons name nil)
				    byte-compile-macro-environment))))
		 (prog1 (byte-compile-interpreted-form form)
		   (if (not noninteractive)
		       (message "Compiling %s..." filename))))
	     ;; defmacro
	     (if tem
		 (setcdr tem (cons 'lambda (cdr (cdr form))))
	       (setq byte-compile-macro-environment
		     (cons (cons name (cons 'lambda (cdr (cdr form))))
			   byte-compile-macro-environment)))
	     (byte-compile-interpreted-form form))))
	((eq (car form) 'require)
	 (eval form)
	 form)
	(t (byte-compile-interpreted-form form))))

(defun byte-compile-interpreted-form (form)
  "Process a FORM, looking for things that can be usefully byte-compiled."
  (if (not (listp form))
      form
    (let ((f (car form)))
      (cond
	((eq f 'quote) form)
	((eq f 'function) 
	 (cond ((symbolp (car (cdr form)))
	        (` (symbol-function (quote (, (car (cdr form)))))))
	       (t
		(list f (byte-compile-lambda (car (cdr form)))))))
	((memq f '(defun defmacro))
	 (cons f (byte-compile-lambda (cdr form))))
	((eq f 'lambda)
	 (byte-compile-lambda form))
	(t (mapcar 'byte-compile-interpreted-form form))))))

;; Lambda's in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(put 'lambda 'byte-compile 'byte-compile-lambda-form)
(defun byte-compile-lambda-form (form)
  (error "Lambda used in incorrect place in byte-compiled code"))

;; (defun fff (xxx) body) => 
;;	(eval (quote (defun fff (xxx) byte-compiled-body)))
(put 'defun 'byte-compile 'byte-compile-defun-form)
(defun byte-compile-defun-form (form)
  (byte-compile-form
   (` (eval (quote (defun (,@ (byte-compile-lambda (cdr form)))))))))

;; (defmacro fff (xxx) body) => 
;;	(eval (quote (defmacro fff (xxx) byte-compiled-body)))
(put 'defmacro 'byte-compile 'byte-compile-defmacro-form)
(defun byte-compile-defmacro-form (form)
  (byte-compile-form
   (` (eval (quote (defmacro (,@ (byte-compile-lambda (cdr form)))))))))

;; (defconst xxx yyy ddd) =>
;;	(eval (list 'defconst 'xxx yyy ddd))
(put 'defconst 'byte-compile 'byte-compile-defconst-form)
(defun byte-compile-defconst-form (form)
  (byte-compile-form
   (` (eval (list 'defconst '(, (car (cdr form))) (,@ (cdr (cdr form))))))))

;; (defvar xxx yyy ddd) =>
;;	(eval (list 'defvar 'xxx yyy ddd))
(put 'defvar 'byte-compile 'byte-compile-defvar-form)
(defun byte-compile-defvar-form (form)
  (byte-compile-form
   (` (eval (list 'defvar '(, (car (cdr form))) (,@ (cdr (cdr form))))))))
----------------------------------------------------------------------

Dale Worley		drw@math.mit.edu