Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 4810:6ee5e50a8772
Add a compiler macro for #'map, where CL-TYPE is constant and understood.
2010-01-07 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (map):
Add a compiler macro for this function, for cases where CL-TYPE is
constant and understood.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 07 Jan 2010 21:50:39 +0000 |
| parents | 8484c6c76837 |
| children | e6dec75ded0e |
comparison
equal
deleted
inserted
replaced
| 4808:53071486ff7a | 4810:6ee5e50a8772 |
|---|---|
| 3459 ;; Neither side is a constant expression, do all our evaluation at | 3459 ;; Neither side is a constant expression, do all our evaluation at |
| 3460 ;; runtime (or both are, and equalp will be called from | 3460 ;; runtime (or both are, and equalp will be called from |
| 3461 ;; byte-optimize.el). | 3461 ;; byte-optimize.el). |
| 3462 (t form))))) | 3462 (t form))))) |
| 3463 | 3463 |
| 3464 (define-compiler-macro map (&whole form cl-type cl-func cl-seq | |
| 3465 &rest cl-rest) | |
| 3466 "If CL-TYPE is a constant expression that we know how to handle, transform | |
| 3467 the call to `map' to a more efficient expression." | |
| 3468 (cond | |
| 3469 ;; The first two here rely on the compiler macros for mapc and mapcar*, | |
| 3470 ;; to convert to mapc-internal and mapcar, where appropriate (that is, in | |
| 3471 ;; the absence of cl-rest.) | |
| 3472 ((null cl-type) | |
| 3473 `(prog1 nil (mapc ,@(nthcdr 2 form)))) | |
| 3474 ((equal '(quote list) cl-type) | |
| 3475 (cons 'mapcar* (nthcdr 2 form))) | |
| 3476 ((or (equal '(quote vector) cl-type) | |
| 3477 (equal '(quote array) cl-type)) | |
| 3478 (if cl-rest | |
| 3479 `(vconcat (mapcar* ,@(nthcdr 2 form))) | |
| 3480 (cons 'mapvector (nthcdr 2 form)))) | |
| 3481 ((equal '(quote string) cl-type) | |
| 3482 `(concat (mapcar* ,@(nthcdr 2 form)))) | |
| 3483 ((equal '(quote bit-vector) cl-type) | |
| 3484 `(bvconcat (mapcar* ,@(nthcdr 2 form)))) | |
| 3485 (t form))) | |
| 3486 | |
| 3464 (mapc | 3487 (mapc |
| 3465 #'(lambda (y) | 3488 #'(lambda (y) |
| 3466 (put (car y) 'side-effect-free t) | 3489 (put (car y) 'side-effect-free t) |
| 3467 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) | 3490 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) |
| 3468 (put (car y) 'cl-compiler-macro | 3491 (put (car y) 'cl-compiler-macro |