# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1293666190 0
# Node ID 5ed261fd2bd96afdcdd4a8e25802213ab9e79c0a
# Parent  f6471e4ae703ecb5f712c9dfcaabdc2a15f3bd65
Unrool a load-time loop at macro expansion time, cl-macs.el

2010-12-29  Aidan Kehoe  <kehoea@parhasard.net>

	* 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@parhasard.net>
+
+	* 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@parhasard.net>
 
 	* 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)