Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 5522:544e6336d37c
Reimplement a few GNU functions in terms of CL functions, subr.el
2011-06-19 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el:
* cl-macs.el (assoc-ignore-case, assoc-ignore-representation):
* cl-macs.el (member-ignore-case): New compiler macros.
* subr.el (assoc-ignore-case):
* subr.el (assoc-ignore-representation):
* subr.el (member-ignore-case):
* subr.el (split-path):
* subr.el (delete-dups):
Reimplement a few GNU functions in terms of their CL counterparts,
for the sake of circularity checking and some speed; add type
checking (used in interpreted code and with low speed and safety
checking) for the sake of revealing incompatibilities when
developing.
* subr.el (remove-hook):
There's no need for flet here, an explicit lambda is enough.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 19 Jun 2011 17:43:03 +0100 |
| parents | 9d519ab9fd68 |
| children | 810b77562486 |
comparison
equal
deleted
inserted
replaced
| 5521:3310f36295a0 | 5522:544e6336d37c |
|---|---|
| 3764 (if (every #'cl-safe-expr-p (cdr form)) | 3764 (if (every #'cl-safe-expr-p (cdr form)) |
| 3765 `(funcall (if ,inplace #'nsubstitute #'substitute) ,tochar ,fromchar | 3765 `(funcall (if ,inplace #'nsubstitute #'substitute) ,tochar ,fromchar |
| 3766 (the string ,string) :test #'eq) | 3766 (the string ,string) :test #'eq) |
| 3767 form)) | 3767 form)) |
| 3768 | 3768 |
| 3769 (define-compiler-macro assoc-ignore-case (&whole form &rest args) | |
| 3770 (if (eql 2 (length args)) | |
| 3771 `(assoc* (the string ,(pop args)) | |
| 3772 (the (and list (satisfies | |
| 3773 (lambda (list) | |
| 3774 (not (find-if-not 'stringp list :key 'car))))) | |
| 3775 ,(pop args)) | |
| 3776 :test 'equalp) | |
| 3777 form)) | |
| 3778 | |
| 3779 (define-compiler-macro assoc-ignore-representation (&whole form &rest args) | |
| 3780 (if (eql 2 (length args)) | |
| 3781 `(assoc* (the string ,(pop args)) | |
| 3782 (the (and list (satisfies | |
| 3783 (lambda (list) | |
| 3784 (not (find-if-not 'stringp list :key 'car))))) | |
| 3785 ,(pop args)) | |
| 3786 :test 'equalp) | |
| 3787 form)) | |
| 3788 | |
| 3789 (define-compiler-macro member-ignore-case (&whole form &rest args) | |
| 3790 (if (eql 2 (length args)) | |
| 3791 `(member* (the string ,(pop args)) | |
| 3792 (the (and list (satisfies | |
| 3793 (lambda (list) (every 'stringp list)))) | |
| 3794 ,(pop args)) | |
| 3795 :test 'equalp) | |
| 3796 form)) | |
| 3797 | |
| 3769 (define-compiler-macro stable-union (&whole form &rest cl-keys) | 3798 (define-compiler-macro stable-union (&whole form &rest cl-keys) |
| 3770 (if (> (length form) 2) | 3799 (if (> (length form) 2) |
| 3771 (list* 'union (pop cl-keys) (pop cl-keys) :stable t cl-keys) | 3800 (list* 'union (pop cl-keys) (pop cl-keys) :stable t cl-keys) |
| 3772 form)) | 3801 form)) |
| 3773 | 3802 |