Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 4997:8800b5350a13
Move #'some, #'every to C, implementing them with mapcarX.
src/ChangeLog addition:
2010-02-03 Aidan Kehoe <kehoea@parhasard.net>
* fns.c (mapcarX):
Accept a new argument, indicating whether the function is being
called from #'some or #'every. Implement it.
Discard any multiple values where that is appropriate.
(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
(Fmap_into):
Pass the new flag to mapcarX.
(Fsome, Fevery): Move these functions here from cl-extra.el;
implement them in terms of mapcarX.
(maplist): Discard multiple values where appropriate.
lisp/ChangeLog addition:
2010-02-03 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (some, every):
Move these functions to C.
* cl-macs.el (notany, notevery): Add compiler macros for these
functions, no longer proclaim them inline (which would involve
specbinding that's not necessary with the compiler macros).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 03 Feb 2010 20:26:47 +0000 |
parents | c17c857e20bf |
children | 6aba0daedb7c b0f4adffca7d |
comparison
equal
deleted
inserted
replaced
4996:c17c857e20bf | 4997:8800b5350a13 |
---|---|
3543 ;; ;; Neither side is a constant expression, do all our evaluation at | 3543 ;; ;; Neither side is a constant expression, do all our evaluation at |
3544 ;; ;; runtime (or both are, and equalp will be called from | 3544 ;; ;; runtime (or both are, and equalp will be called from |
3545 ;; ;; byte-optimize.el). | 3545 ;; ;; byte-optimize.el). |
3546 ;; (t form))))) | 3546 ;; (t form))))) |
3547 | 3547 |
3548 (define-compiler-macro notany (&whole form &rest cl-rest) | |
3549 (cons 'not (cons 'some (cdr cl-rest)))) | |
3550 | |
3551 (define-compiler-macro notevery (&whole form &rest cl-rest) | |
3552 (cons 'not (cons 'every (cdr cl-rest)))) | |
3553 | |
3548 (mapc | 3554 (mapc |
3549 #'(lambda (y) | 3555 #'(lambda (y) |
3550 (put (car y) 'side-effect-free t) | 3556 (put (car y) 'side-effect-free t) |
3551 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) | 3557 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) |
3552 (put (car y) 'cl-compiler-macro | 3558 (put (car y) 'cl-compiler-macro |
3570 (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) | 3576 (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) |
3571 (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) | 3577 (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) |
3572 (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr))) | 3578 (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr))) |
3573 | 3579 |
3574 ;;; Things that are inline. | 3580 ;;; Things that are inline. |
3575 (proclaim '(inline acons map concatenate notany notevery | 3581 (proclaim '(inline acons map concatenate |
3576 ;; XEmacs omission: gethash is builtin | 3582 ;; XEmacs omission: gethash is builtin |
3577 cl-set-elt revappend nreconc)) | 3583 cl-set-elt revappend nreconc)) |
3578 | 3584 |
3579 ;;; Things that are side-effect-free. Moved to byte-optimize.el | 3585 ;;; Things that are side-effect-free. Moved to byte-optimize.el |
3580 ;(mapcar (function (lambda (x) (put x 'side-effect-free t))) | 3586 ;(mapcar (function (lambda (x) (put x 'side-effect-free t))) |