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

[Lars Ingebrigtsen <larsi@gnus.org>]

Shigeru Fukaya <shigeru.fukaya@gmail.com> writes:

> 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.

I think the patch below looks sensible, but the bytecode optimiser is
not something I'm familiar with.  Does this look OK to all y'all?

>
> Regards,
> Shigeru
>
> *** 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."
>     ;;
>

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no