Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 4707:5bb0735f56e0
Handle non-list sequences better, delete-duplicates compiler macro.
2009-10-03 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
Make this compiler macro aware that CL-SEQ is a sequence, which
may not necessarily be a list.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 03 Oct 2009 14:22:08 +0100 |
| parents | eb1a409c317b |
| children | 84f870bbd17b |
comparison
equal
deleted
inserted
replaced
| 4706:7e79c8559ad1 | 4707:5bb0735f56e0 |
|---|---|
| 3216 | 3216 |
| 3217 ;; XEmacs; inline delete-duplicates if it's called with a literal | 3217 ;; XEmacs; inline delete-duplicates if it's called with a literal |
| 3218 ;; #'equal or #'eq and no other keywords, we want the speed in | 3218 ;; #'equal or #'eq and no other keywords, we want the speed in |
| 3219 ;; font-lock.el. | 3219 ;; font-lock.el. |
| 3220 (define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys) | 3220 (define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys) |
| 3221 (cond ((and (= 4 (length form)) | 3221 (let ((listp-check |
| 3222 (eq :test (third form)) | 3222 (if (memq (car-safe cl-seq) |
| 3223 (or (equal '(quote eq) (fourth form)) | 3223 ;; No need to check for a list at runtime with these. We |
| 3224 (equal '(function eq) (fourth form)))) | 3224 ;; could expand the list, but these are all the functions |
| 3225 `(let* ((begin ,cl-seq) | 3225 ;; in the relevant context at the moment. |
| 3226 (cl-seq begin)) | 3226 '(nreverse append nconc mapcan mapcar)) |
| 3227 (while cl-seq | 3227 t |
| 3228 (setq cl-seq (setcdr cl-seq (delq (car cl-seq) (cdr cl-seq))))) | 3228 '(listp begin)))) |
| 3229 begin)) | 3229 (cond ((and (= 4 (length form)) |
| 3230 ((and (= 4 (length form)) | 3230 (eq :test (third form)) |
| 3231 (eq :test (third form)) | 3231 (or (equal '(quote eq) (fourth form)) |
| 3232 (or (equal '(quote equal) (fourth form)) | 3232 (equal '(function eq) (fourth form)))) |
| 3233 (equal '(function equal) (fourth form)))) | 3233 `(let* ((begin ,cl-seq) |
| 3234 `(let* ((begin ,cl-seq) | 3234 (cl-seq begin)) |
| 3235 (cl-seq begin)) | 3235 (if ,listp-check |
| 3236 (while cl-seq | 3236 (progn |
| 3237 (setq cl-seq (setcdr cl-seq (delete (car cl-seq) (cdr cl-seq))))) | 3237 (while cl-seq |
| 3238 begin)) | 3238 (setq cl-seq (setcdr cl-seq (delq (car cl-seq) |
| 3239 (t | 3239 (cdr cl-seq))))) |
| 3240 form))) | 3240 begin) |
| 3241 ;; Call cl-delete-duplicates explicitly, to avoid the form | |
| 3242 ;; getting compiler-macroexpanded again: | |
| 3243 (cl-delete-duplicates begin ,(third form) ,(fourth form) nil)))) | |
| 3244 ((and (= 4 (length form)) | |
| 3245 (eq :test (third form)) | |
| 3246 (or (equal '(quote equal) (fourth form)) | |
| 3247 (equal '(function equal) (fourth form)))) | |
| 3248 `(let* ((begin ,cl-seq) | |
| 3249 (cl-seq begin)) | |
| 3250 (if ,listp-check | |
| 3251 (progn | |
| 3252 (while cl-seq | |
| 3253 (setq cl-seq (setcdr cl-seq (delete (car cl-seq) | |
| 3254 (cdr cl-seq))))) | |
| 3255 begin) | |
| 3256 ;; Call cl-delete-duplicates explicitly, to avoid the form | |
| 3257 ;; getting compiler-macroexpanded again: | |
| 3258 (cl-delete-duplicates begin ,(third form) ,(fourth form) nil)))) | |
| 3259 (t | |
| 3260 form)))) | |
| 3241 | 3261 |
| 3242 (mapc | 3262 (mapc |
| 3243 #'(lambda (y) | 3263 #'(lambda (y) |
| 3244 (put (car y) 'side-effect-free t) | 3264 (put (car y) 'side-effect-free t) |
| 3245 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) | 3265 (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) |