Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 5667:b4715fcbe001

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
#'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 0df4d95bd98a
children 236e4afc565d
comparison
equal deleted inserted replaced
5666:daf5accfe973 5667:b4715fcbe001
1192 (defun byte-optimize-letX (form) 1192 (defun byte-optimize-letX (form)
1193 (cond ((null (nth 1 form)) 1193 (cond ((null (nth 1 form))
1194 ;; No bindings 1194 ;; No bindings
1195 (cons 'progn (cdr (cdr form)))) 1195 (cons 'progn (cdr (cdr form))))
1196 ((or (nth 2 form) (nthcdr 3 form)) 1196 ((or (nth 2 form) (nthcdr 3 form))
1197 form) 1197 (if (and (eq 'let (car form)) (> (length (nth 1 form)) 2))
1198 ;; Group constant initialisations together, so we can
1199 ;; just dup in the lap code. Can't group other
1200 ;; initialisations together if they have side-effects,
1201 ;; that would re-order them.
1202 (let ((sort (stable-sort
1203 (copy-list (nth 1 form))
1204 #'< :key #'(lambda (object)
1205 (cond ((atom object)
1206 most-positive-fixnum)
1207 ((null (cadr object))
1208 most-positive-fixnum)
1209 ((byte-compile-trueconstp
1210 (cadr object))
1211 (mod (sxhash (cadr object))
1212 most-positive-fixnum))
1213 (t 0))))))
1214 (if (equal sort (nth 1 form))
1215 form
1216 `(let ,sort ,@(cddr form))))
1217 form))
1198 ;; The body is nil 1218 ;; The body is nil
1199 ((eq (car form) 'let) 1219 ((eq (car form) 'let)
1200 (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form))) 1220 (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
1201 '(nil))) 1221 '(nil)))
1202 (t 1222 (t