Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 4996:c17c857e20bf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 03 Feb 2010 20:18:53 +0000
parents 6bc1f3f6cf0d 8431b52e43b1
children 8800b5350a13
comparison
equal deleted inserted replaced
4927:5274591ce707 4996:c17c857e20bf
3335 ;; getting compiler-macroexpanded again: 3335 ;; getting compiler-macroexpanded again:
3336 (cl-delete-duplicates begin ',cl-keys nil)))) 3336 (cl-delete-duplicates begin ',cl-keys nil))))
3337 (t 3337 (t
3338 form)))) 3338 form))))
3339 3339
3340 ;; XEmacs change, the GNU mapc doesn't accept the Common Lisp args, so this
3341 ;; change isn't helpful.
3342 (define-compiler-macro mapc (&whole form cl-func cl-seq &rest cl-rest)
3343 (if cl-rest
3344 form
3345 (cons 'mapc-internal (cdr form))))
3346
3347 (define-compiler-macro mapcar* (&whole form cl-func cl-x &rest cl-rest)
3348 (if cl-rest
3349 form
3350 (cons 'mapcar (cdr form))))
3351
3352 ;; XEmacs; it's perfectly reasonable, and often much clearer to those 3340 ;; XEmacs; it's perfectly reasonable, and often much clearer to those
3353 ;; reading the code, to call regexp-quote on a constant string, which is 3341 ;; reading the code, to call regexp-quote on a constant string, which is
3354 ;; something we can optimise here easily. 3342 ;; something we can optimise here easily.
3355 (define-compiler-macro regexp-quote (&whole form string) 3343 (define-compiler-macro regexp-quote (&whole form string)
3356 (if (stringp string) 3344 (if (stringp string)
3555 ;; ;; Neither side is a constant expression, do all our evaluation at 3543 ;; ;; Neither side is a constant expression, do all our evaluation at
3556 ;; ;; runtime (or both are, and equalp will be called from 3544 ;; ;; runtime (or both are, and equalp will be called from
3557 ;; ;; byte-optimize.el). 3545 ;; ;; byte-optimize.el).
3558 ;; (t form))))) 3546 ;; (t form)))))
3559 3547
3560 (define-compiler-macro map (&whole form cl-type cl-func cl-seq
3561 &rest cl-rest)
3562 "If CL-TYPE is a constant expression that we know how to handle, transform
3563 the call to `map' to a more efficient expression."
3564 (cond
3565 ;; The first two here rely on the compiler macros for mapc and mapcar*,
3566 ;; to convert to mapc-internal and mapcar, where appropriate (that is, in
3567 ;; the absence of cl-rest.)
3568 ((null cl-type)
3569 `(prog1 nil (mapc ,@(nthcdr 2 form))))
3570 ((equal '(quote list) cl-type)
3571 (cons 'mapcar* (nthcdr 2 form)))
3572 ((or (equal '(quote vector) cl-type)
3573 (equal '(quote array) cl-type))
3574 (if cl-rest
3575 `(vconcat (mapcar* ,@(nthcdr 2 form)))
3576 (cons 'mapvector (nthcdr 2 form))))
3577 ((equal '(quote string) cl-type)
3578 `(concat (mapcar* ,@(nthcdr 2 form))))
3579 ((equal '(quote bit-vector) cl-type)
3580 `(bvconcat (mapcar* ,@(nthcdr 2 form))))
3581 (t form)))
3582
3583 (mapc 3548 (mapc
3584 #'(lambda (y) 3549 #'(lambda (y)
3585 (put (car y) 'side-effect-free t) 3550 (put (car y) 'side-effect-free t)
3586 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) 3551 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
3587 (put (car y) 'cl-compiler-macro 3552 (put (car y) 'cl-compiler-macro