bug#14769: 24.3.50; [PATCH] optimize `concat's literals

[Shigeru Fukaya <shigeru.fukaya@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 422 bytes --]


Current bytecode optimizer works only when all arguments are
constants.

With the attached small patch, adjacent successive literal arguments
of `concat' will become optimized to a string respectively.

	Make successive literals of `concat' optimized to a string.
	* byte-opt.el (byte-optimize-form-code-walker): call
	byte-optimize-concat-args for `concat'.
	(byte-optimize-concat-args): New function.

Regards,
Shigeru

[-- Attachment #2: byte-opt.patch --]
[-- Type: application/octet-stream, Size: 1704 bytes --]

*** byte-opt.el	Fri Jun 14 19:32:39 2013
--- byte-opt.new.el	Wed Jul  3 01:48:29 2013
***************
*** 562,568 ****
  	     (if (and (get fn 'pure)
  		      (byte-optimize-all-constp args))
  		   (list 'quote (apply fn (mapcar #'eval args)))
! 	       (cons fn args)))))))
  
  (defun byte-optimize-all-constp (list)
    "Non-nil if all elements of LIST satisfy `macroexp-const-p"
--- 562,572 ----
  	     (if (and (get fn 'pure)
  		      (byte-optimize-all-constp args))
  		   (list 'quote (apply fn (mapcar #'eval args)))
! 	       (if (eq fn 'concat)
! 		   ;; Not all arguments are literals.
! 		   (cons fn (byte-optimize-concat-args args))
! 		 ;; Other than `concat'.
! 		 (cons fn args))))))))
  
  (defun byte-optimize-all-constp (list)
    "Non-nil if all elements of LIST satisfy `macroexp-const-p"
***************
*** 573,578 ****
--- 577,605 ----
        (setq list (cdr list)))
      constant))
  
+ (defun byte-optimize-concat-args (args)
+   ;;
+   ;; Convert arguments of `concat' such that adjacent successive
+   ;; literal arguments to one string, and remove null strings.
+   ;;
+   (let (newargs)
+     (while args
+       ;; loop for literals
+       (let (l)
+ 	(while (and args (macroexp-const-p (car args)))
+ 	  (push (car args) l)
+ 	  (setq args (cdr args)))
+ 	(when l
+ 	  (let ((s (apply #'concat (mapcar #'eval (nreverse l)))))
+ 	    ;; keep non-null string
+ 	    (unless (equal s "")
+ 	      (push s newargs)))))
+       ;; non-literal argument
+       (when args
+ 	(push (car args) newargs)
+ 	(setq args (cdr args))))
+     (nreverse newargs)))
+ 
  (defun byte-optimize-form (form &optional for-effect)
    "The source-level pass of the optimizer."
    ;;