comparison lisp/emacs-lisp/byte-opt.el @ 29580:2f88e6f0d32b

(byte-compile-log-lap-1) (byte-optimize-inline-handler, byte-optimize-form-code-walker) (byte-optimize-apply, end of file): Don't quote lambda.

29579:05016ef95d0f

;; to get it there.
;;

;; TO DO:
;;
;; (apply '(lambda (x &rest y) ...) 1 (foo))
;;
;; maintain a list of functions known not to access any global variables
;; (actually, give them a 'dynamically-safe property) and then
;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )

  (if (aref byte-code-vector 0)
      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
  (byte-compile-log-1
   (apply 'format format
     (let (c a)
       (mapcar '(lambda (arg)
		  (if (not (consp arg))
		      (if (and (symbolp arg)
			       (string-match "^byte-" (symbol-name arg)))
			  (intern (substring (symbol-name arg) 5))
			arg)

(defun byte-optimize-inline-handler (form)
  "byte-optimize-handler for the `inline' special-form."
  (cons 'progn
	(mapcar
	 '(lambda (sexp)
	    (let ((fn (car-safe sexp)))
	      (if (and (symbolp fn)
		    (or (cdr (assq fn byte-compile-function-environment))
		      (and (fboundp fn)
			(not (or (cdr (assq fn byte-compile-macro-environment))

	   ;; recursively enter the optimizer for the bindings and body
	   ;; of a let or let*.  This for depth-firstness: forms that
	   ;; are more deeply nested are optimized first.
	   (cons fn
	     (cons
	      (mapcar '(lambda (binding)
			 (if (symbolp binding)
			     binding
			   (if (cdr (cdr binding))
			       (byte-compile-warn "Malformed let binding: `%s'"
						  (prin1-to-string binding)))

				 (byte-optimize-form (nth 1 binding) nil))))
		      (nth 1 form))
	      (byte-optimize-body (cdr (cdr form)) for-effect))))
	  ((eq fn 'cond)
	   (cons fn
		 (mapcar '(lambda (clause)
			    (if (consp clause)
				(cons
				 (byte-optimize-form (car clause) nil)
				 (byte-optimize-body (cdr clause) for-effect))
			      (byte-compile-warn "Malformed cond form: `%s'"

(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)


(defun byte-optimize-funcall (form)
  ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...)
  ;; (funcall 'foo ...) ==> (foo ...)
  (let ((fn (nth 1 form)))
    (if (memq (car-safe fn) '(quote function))
	(cons (nth 1 fn) (cdr (cdr form)))
	form)))

    (or (if (or (null last)
		(eq (car-safe last) 'quote))
	    (if (listp (nth 1 last))
		(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
		  (nconc (list 'funcall fn) butlast
			 (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
	      (byte-compile-warn
	       "Last arg to apply can't be a literal atom: `%s'"
	       (prin1-to-string last))
	      nil))
	form)))

(eval-when-compile
 (or (byte-code-function-p (symbol-function 'byte-optimize-form))
     (assq 'byte-code (symbol-function 'byte-optimize-form))
     (let ((byte-optimize nil)
	   (byte-compile-warnings nil))
       (mapcar '(lambda (x)
		  (or noninteractive (message "compiling %s..." x))
		  (byte-compile x)
		  (or noninteractive (message "compiling %s...done" x)))
	       '(byte-optimize-form
		 byte-optimize-body
		 byte-optimize-predicate
		 byte-optimize-binary-predicate
		 ;; Inserted some more than necessary, to speed it up.

29580:2f88e6f0d32b

;; to get it there.
;;

;; TO DO:
;;
;; (apply (lambda (x &rest y) ...) 1 (foo))
;;
;; maintain a list of functions known not to access any global variables
;; (actually, give them a 'dynamically-safe property) and then
;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )

  (if (aref byte-code-vector 0)
      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
  (byte-compile-log-1
   (apply 'format format
     (let (c a)
       (mapcar (lambda (arg)
		  (if (not (consp arg))
		      (if (and (symbolp arg)
			       (string-match "^byte-" (symbol-name arg)))
			  (intern (substring (symbol-name arg) 5))
			arg)

(defun byte-optimize-inline-handler (form)
  "byte-optimize-handler for the `inline' special-form."
  (cons 'progn
	(mapcar
	 (lambda (sexp)
	    (let ((fn (car-safe sexp)))
	      (if (and (symbolp fn)
		    (or (cdr (assq fn byte-compile-function-environment))
		      (and (fboundp fn)
			(not (or (cdr (assq fn byte-compile-macro-environment))

	   ;; recursively enter the optimizer for the bindings and body
	   ;; of a let or let*.  This for depth-firstness: forms that
	   ;; are more deeply nested are optimized first.
	   (cons fn
	     (cons
	      (mapcar (lambda (binding)
			 (if (symbolp binding)
			     binding
			   (if (cdr (cdr binding))
			       (byte-compile-warn "Malformed let binding: `%s'"
						  (prin1-to-string binding)))

				 (byte-optimize-form (nth 1 binding) nil))))
		      (nth 1 form))
	      (byte-optimize-body (cdr (cdr form)) for-effect))))
	  ((eq fn 'cond)
	   (cons fn
		 (mapcar (lambda (clause)
			    (if (consp clause)
				(cons
				 (byte-optimize-form (car clause) nil)
				 (byte-optimize-body (cdr clause) for-effect))
			      (byte-compile-warn "Malformed cond form: `%s'"

(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)


(defun byte-optimize-funcall (form)
  ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
  ;; (funcall foo ...) ==> (foo ...)
  (let ((fn (nth 1 form)))
    (if (memq (car-safe fn) '(quote function))
	(cons (nth 1 fn) (cdr (cdr form)))
	form)))

    (or (if (or (null last)
		(eq (car-safe last) 'quote))
	    (if (listp (nth 1 last))
		(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
		  (nconc (list 'funcall fn) butlast
			 (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
	      (byte-compile-warn
	       "Last arg to apply can't be a literal atom: `%s'"
	       (prin1-to-string last))
	      nil))
	form)))

(eval-when-compile
 (or (byte-code-function-p (symbol-function 'byte-optimize-form))
     (assq 'byte-code (symbol-function 'byte-optimize-form))
     (let ((byte-optimize nil)
	   (byte-compile-warnings nil))
       (mapcar (lambda (x)
		 (or noninteractive (message "compiling %s..." x))
		 (byte-compile x)
		 (or noninteractive (message "compiling %s...done" x)))
	       '(byte-optimize-form
		 byte-optimize-body
		 byte-optimize-predicate
		 byte-optimize-binary-predicate
		 ;; Inserted some more than necessary, to speed it up.