changeset: 5371:5ed261fd2bd9 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Wed Dec 29 23:43:10 2010 +0000 files: lisp/ChangeLog lisp/cl-macs.el description: Unrool a load-time loop at macro expansion time, cl-macs.el 2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style. diff -r f6471e4ae703 -r 5ed261fd2bd9 lisp/ChangeLog --- a/lisp/ChangeLog Wed Dec 29 23:38:38 2010 +0000 +++ b/lisp/ChangeLog Wed Dec 29 23:43:10 2010 +0000 ＠＠ -1,3 +1,10 ＠＠ +2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * cl-macs.el (inline-side-effect-free-compiler-macros): + Unroll a loop here at macro-expansion time, so these compiler + macros are compiled. Use #'eql instead of #'eq in a couple of + places for better style. + 2010-12-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl-extra.el (notany, notevery): Avoid some dynamic scope diff -r f6471e4ae703 -r 5ed261fd2bd9 lisp/cl-macs.el --- a/lisp/cl-macs.el Wed Dec 29 23:38:38 2010 +0000 +++ b/lisp/cl-macs.el Wed Dec 29 23:43:10 2010 +0000 ＠＠ -3762,22 +3762,28 ＠＠ (cdr form))))))) '(= < > <= >=)) -(mapc - #'(lambda (y) - (put (car y) 'side-effect-free t) - (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) - (put (car y) 'cl-compiler-macro - (list 'lambda '(w x) - (if (symbolp (cadr y)) - (list 'list (list 'quote (cadr y)) - (list 'list (list 'quote (caddr y)) 'x)) - (cons 'list (cdr y)))))) - '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) +;; XEmacs; unroll this loop at macro-expansion time, so the compiler macros +;; are byte-compiled. +(macrolet + ((inline-side-effect-free-compiler-macros (&rest details) + (cons + 'progn + (loop + for (function . details) in details + nconc `((put ',function 'side-effect-free t) + (define-compiler-macro ,function (&whole form x) + ,(if (symbolp (car details)) + (reduce #'(lambda (object1 object2) + `(list ',object1 ,object2)) + details :from-end t :initial-value 'x) + (cons 'list details)))))))) + (inline-side-effect-free-compiler-macros + (first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) (rest 'cdr x) (plusp '> x 0) (minusp '< x 0) - (oddp 'eq (list 'logand x 1) 1) - (evenp 'eq (list 'logand x 1) 0) + (oddp 'eql (list 'logand x 1) 1) + (evenp 'eql (list 'logand x 1) 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches