changeset 5667:b4715fcbe001

#'byte-optimize-letX; group constant initialisations together in let forms lisp/ChangeLog addition: 2012-05-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-letX): In (let ...) forms, group constant initialisations together, so we can just dup in the byte code.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 14 May 2012 15:16:47 +0100
parents daf5accfe973
children ee95ef1e644c
files lisp/ChangeLog lisp/byte-optimize.el
diffstat 2 files changed, 27 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon May 14 08:46:05 2012 +0100
+++ b/lisp/ChangeLog	Mon May 14 15:16:47 2012 +0100
@@ -1,3 +1,9 @@
+2012-05-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* byte-optimize.el (byte-optimize-letX):
+	In (let ...) forms, group constant initialisations together, so we
+	can just dup in the byte code.
+
 2012-05-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	Update minibuf.el to use #'test-completion, use the generality of
--- a/lisp/byte-optimize.el	Mon May 14 08:46:05 2012 +0100
+++ b/lisp/byte-optimize.el	Mon May 14 15:16:47 2012 +0100
@@ -1194,7 +1194,27 @@
 	 ;; No bindings
 	 (cons 'progn (cdr (cdr form))))
 	((or (nth 2 form) (nthcdr 3 form))
-	 form)
+	 (if (and (eq 'let (car form)) (> (length (nth 1 form)) 2))
+	     ;; Group constant initialisations together, so we can
+	     ;; just dup in the lap code. Can't group other
+	     ;; initialisations together if they have side-effects,
+	     ;; that would re-order them.
+	     (let ((sort (stable-sort
+			  (copy-list (nth 1 form))
+			  #'< :key #'(lambda (object)
+				       (cond ((atom object)
+					      most-positive-fixnum)
+					     ((null (cadr object))
+					      most-positive-fixnum)
+					     ((byte-compile-trueconstp
+					       (cadr object))
+					      (mod (sxhash (cadr object))
+						   most-positive-fixnum))
+					     (t 0))))))
+	       (if (equal sort (nth 1 form))
+		   form
+		 `(let ,sort ,@(cddr form))))
+	   form))
 	 ;; The body is nil
 	((eq (car form) 'let)
 	 (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))