xemacs-beta: lisp/byte-optimize.el comparison

comparison lisp/byte-optimize.el @ 5656:e9c3fe82127d

Co-operate with the byte-optimizer in the bytecomp.el labels implementation. lisp/ChangeLog addition: 2012-05-05 Aidan Kehoe <kehoea@parhasard.net> Co-operate with the byte-optimizer in the bytecomp.el labels implementation, don't work against it. * byte-optimize.el: * byte-optimize.el (byte-compile-inline-expand): Call #'byte-compile-unfold-lambda explicitly here, don't assume that the byte-optimizer will do it. * byte-optimize.el (byte-compile-unfold-lambda): Call #'byte-optimize-body on the body, don't just mapcar #'byte-optimize-form along it. * byte-optimize.el (byte-optimize-lambda): New. Optimize a lambda form. * byte-optimize.el (byte-optimize-form-code-walker): Descend lambda expressions, defun, and defmacro, relevant for lexically-oriented operators like #'labels. * byte-optimize.el (byte-optimize-body): Only return a non-eq object if we've actually optimized something * bytecomp.el (byte-compile-initial-macro-environment): In the labels implementation, work with the byte optimizer, not against it; warn when labels are defined but not used, automatically inline labels that are used only once. * bytecomp.el (byte-recompile-directory): No need to wrap #'byte-compile-report-error in a lambda with #'call-with-condition-handler here. * bytecomp.el (byte-compile-form): Don't inline compiled-function objects, they're probably labels. * bytecomp.el (byte-compile-funcall): No longer inline lambdas, trust the byte optimizer to have done it properly, even for labels. * cl-extra.el (cl-macroexpand-all): Treat labels established by the byte compiler distinctly from those established by cl-macs.el. * cl-macs.el (cl-do-proclaim): Treat labels established by the byte compiler distinctly from those established by cl-macs.el. * gui.el (make-gui-button): When referring to the #'gui-button-action label, quote it using function, otherwise there's a warning from the byte compiler.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sat, 05 May 2012 20:48:24 +0100
parents	cc6f0266bc36
children	2a870a7b86bd

comparison

equal deleted inserted replaced

-:b7ae5f44b950
+:e9c3fe82127d
 			 (and (fboundp name) (symbol-function name))))))
 (if (and (consp fn) (eq (car fn) 'autoload))
 	  (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
 (if (symbolp fn)
 	  (byte-compile-inline-expand (cons fn (cdr form)))
-	(if (compiled-function-p fn)
+	(if (or (eq (car-safe fn) 'lambda) (compiled-function-p fn))
-	    (progn
+	    (byte-compile-unfold-lambda (cons fn (cdr form)))
-	      (fetch-bytecode fn)
+	  ;; Give up on inlining.
-	      (cons (list 'lambda (compiled-function-arglist fn)
+	  form)))))
-			  (list 'byte-code
-				(compiled-function-instructions fn)
-				(compiled-function-constants fn)
-				(compiled-function-stack-depth fn)))
-		    (cdr form)))
-	  (if (eq (car-safe fn) 'lambda)
-	      (cons fn (cdr form))
-	    ;; Give up on inlining.
-	    form))))))
 ;;; ((lambda ...) ...)
 ;;;
 (defun byte-compile-unfold-lambda (form &optional name)
 (or name (setq name "anonymous lambda"))
 	  (progn
 	    (or (eq values 'too-few)
 		(byte-compile-warn
 		 "attempt to open-code %s with too many arguments" name))
 	    form)
-	(setq body (mapcar 'byte-optimize-form body))
+	(setq body (byte-optimize-body body nil))
 	(let ((newform
 	       (if bindings
 		   (cons 'let (cons (nreverse bindings) body))
 		 (cons 'progn body))))
 	  (byte-compile-log "  %s\t==>\t%s" form newform)
 	  newform)))))
+(defun byte-optimize-lambda (form)
+(let* ((offset 2) (body (nthcdr offset form)))
+(if (stringp (car body)) (setq body (nthcdr (incf offset) form)))
+(if (eq 'interactive (car-safe (car body)))
+	(setq body (nthcdr (incf offset) form)))
+(if (eq body (setq body (byte-optimize-body body nil)))
+form
+(nconc (subseq form 0 offset) body))))
 ;;; implementing source-level optimizers
 (defun byte-optimize-form-code-walker (form for-effect)
 ;;
 ;; For normal function calls, We can just mapcar the optimizer the cdr.  But
 	   ;; map (quote nil) to nil to simplify optimizer logic.
 	   ;; map quoted constants to nil if for-effect (just because).
 	   (and (nth 1 form)
 		(not for-effect)
 		form))
-	  ((or (compiled-function-p fn)
+	  ((eq fn 'function)
-	       (eq 'lambda (car-safe fn)))
+	   (when (cddr form)
-	   (byte-compile-unfold-lambda form))
+(byte-compile-warn "malformed function form: %S" form))
+	   (cond
+(for-effect nil)
+((and (eq (car-safe (cadr form)) 'lambda)
+(not (eq (cadr form) (setq tmp (byte-optimize-lambda
+(cadr form))))))
+(list fn tmp))
+(t form)))
+	  ((and (eq 'lambda (car-safe fn))
+(not (eq form (setq form (byte-compile-unfold-lambda form)))))
+form)
 	  ((memq fn '(let let*))
 	   ;; 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
 	  ((eq fn 'interactive)
 	   (byte-compile-warn "misplaced interactive spec: %s"
 			      (prin1-to-string form))
 	   nil)
-	  ((memq fn '(defun defmacro function
+((memq fn '(defun defmacro))
-		      condition-case save-window-excursion))
+(if (eq (setq tmp (cons 'lambda (cddr form)))
-	   ;; These forms are compiled as constants or by breaking out
+(setq tmp (byte-optimize-lambda tmp)))
-	   ;; all the subexpressions and compiling them separately.
+(cons fn (cdr tmp))
-	   form)
+form))
+((eq fn 'condition-case)
+(list* fn (nth 1 form) (byte-optimize-form (nth 2 form) for-effect)
+(mapcar #'(lambda (handler)
+(cons (car handler)
+(byte-optimize-body (cdr handler)
+for-effect)))
+(cdddr form))))
 	  ((eq fn 'unwind-protect)
 	   ;; the "protected" part of an unwind-protect is compiled (and thus
 	   ;; optimized) as a top-level form, so don't do it here.  But the
 	   ;; non-protected part has the same for-effect status as the
 	  ((not (eq form
 		    (setq form (macroexpand form
 					    byte-compile-macro-environment))))
 	   (byte-optimize-form form for-effect))
+	  ((compiled-function-p fn)
+(cons fn (mapcar #'byte-optimize-form (cdr form))))
 	  ((not (symbolp fn))
-	   (byte-compile-warn "%s is a malformed function" (prin1-to-string fn))
+(byte-compile-warn "%S is a malformed function" fn)
 	   form)
 	  ;; Support compiler macros as in cl.el.
 	  ((and (get fn 'cl-compiler-macro)
 	        (not (eq form (setq form (compiler-macroexpand form)))))
 ;; forms, all but the last of which are optimized with the assumption that
 ;; they are being called for effect.  The last is for-effect as well if
 ;; all-for-effect is true.  Returns a new list of forms.
 (let ((rest forms)
 	(result nil)
+(modified nil)
 	fe new)
 (while rest
 (setq fe (or all-for-effect (cdr rest)))
 (setq new (and (car rest) (byte-optimize-form (car rest) fe)))
 (if (or new (not fe))
-	  (setq result (cons new result)))
+	  (setq result (cons new result)
+modified (or modified (not (eq new (car rest)))))
+(setq modified t))
 (setq rest (cdr rest)))
-(nreverse result)))
+(if modified (nreverse result) forms)))
 ;;; some source-level optimizers
 ;;;
 ;;; when writing optimizers, be VERY careful that the optimizer returns

Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 5656:e9c3fe82127d