Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 5380:919c77c567bb
Add compiler macros for #'revappend, #'nreconc.
2011-03-21 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (revappend, nreconc):
Add compiler macros for these two functions. (They used to be
inline, but that involves needless binding of the arguments.)
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 21 Mar 2011 12:27:07 +0000 |
parents | a32a108ae815 |
children | 3889ef128488 |
comparison
equal
deleted
inserted
replaced
5379:a32a108ae815 | 5380:919c77c567bb |
---|---|
3708 `(cons (cons ,a ,b) ,c)) | 3708 `(cons (cons ,a ,b) ,c)) |
3709 | 3709 |
3710 (define-compiler-macro pairlis (a b &optional c) | 3710 (define-compiler-macro pairlis (a b &optional c) |
3711 `(nconc (mapcar* #'cons ,a ,b) ,c)) | 3711 `(nconc (mapcar* #'cons ,a ,b) ,c)) |
3712 | 3712 |
3713 (define-compiler-macro revappend (&whole form &rest args) | |
3714 (if (eql 3 (length form)) `(nconc (reverse ,(pop args)) ,(pop args)) form)) | |
3715 | |
3716 (define-compiler-macro nreconc (&whole form &rest args) | |
3717 (if (eql 3 (length form)) `(nconc (nreverse ,(pop args)) ,(pop args)) form)) | |
3718 | |
3713 (define-compiler-macro complement (&whole form fn) | 3719 (define-compiler-macro complement (&whole form fn) |
3714 (if (or (eq (car-safe fn) 'function) (eq (car-safe fn) 'quote)) | 3720 (if (or (eq (car-safe fn) 'function) (eq (car-safe fn) 'quote)) |
3715 (cond | 3721 (cond |
3716 ((and (symbolp (second fn)) (get (second fn) 'byte-compile-negated-op)) | 3722 ((and (symbolp (second fn)) (get (second fn) 'byte-compile-negated-op)) |
3717 (list 'function (get (second fn) 'byte-compile-negated-op))) | 3723 (list 'function (get (second fn) 'byte-compile-negated-op))) |