Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5085:1ee30d3f9dd0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle the :from-end argument correctly, #'delete-duplicates compiler macro. 2010-03-02 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-dups): New compiler macro for this function, expanding to inline byte codes. (delete-duplicates): Handle the :from-end argument correctly in this compiler macro.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 02 Mar 2010 13:02:36 +0000
parents 6afe991b8135
children a24f2ab0093b
comparison
equal deleted inserted replaced
5084:6afe991b8135 5085:1ee30d3f9dd0
3290 (cl-simple-expr-p val)) res 3290 (cl-simple-expr-p val)) res
3291 (let ((temp (gensym))) 3291 (let ((temp (gensym)))
3292 (list 'let (list (list temp val)) (subst temp val res))))) 3292 (list 'let (list (list temp val)) (subst temp val res)))))
3293 form)) 3293 form))
3294 3294
3295 ;; XEmacs; inline delete-duplicates if it's called with a literal 3295 (define-compiler-macro delete-dups (list)
3296 ;; #'equal or #'eq and no other keywords, we want the speed in 3296 `(delete-duplicates (the list ,list) :test #'equal :from-end t))
3297 ;; font-lock.el. 3297
3298 ;; XEmacs; inline delete-duplicates if it's called with one of the
3299 ;; common compile-time constant tests and an optional :from-end
3300 ;; argument, we want the speed in font-lock.el.
3298 (define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys) 3301 (define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
3299 (let ((listp-check 3302 (let ((listp-check
3300 (if (memq (car-safe cl-seq) 3303 (cond
3301 ;; No need to check for a list at runtime with these. We 3304 ((memq (car-safe cl-seq)
3302 ;; could expand the list, but these are all the functions 3305 ;; No need to check for a list at runtime with these. We
3303 ;; in the relevant context at the moment. 3306 ;; could expand the list, but these are all the functions
3304 '(nreverse append nconc mapcan mapcar)) 3307 ;; in the relevant context at the moment.
3305 t 3308 '(nreverse append nconc mapcan mapcar string-to-list))
3306 '(listp begin)))) 3309 t)
3307 (cond ((and (= 4 (length form)) 3310 ((and (listp cl-seq) (eq (first cl-seq) 'the)
3308 (eq :test (third form)) 3311 (eq (second cl-seq) 'list))
3309 (or (equal '(quote eq) (fourth form)) 3312 ;; Allow users to force this, if they really want to.
3310 (equal '(function eq) (fourth form)))) 3313 t)
3314 (t
3315 '(listp begin)))))
3316 (cond ((loop
3317 for relevant-key-values
3318 in '((:test 'eq)
3319 (:test #'eq)
3320 (:test 'eq :from-end nil)
3321 (:test #'eq :from-end nil))
3322 ;; One of the above corresponds exactly to CL-KEYS:
3323 thereis (not (set-difference cl-keys relevant-key-values
3324 :test #'equal)))
3325 `(let* ((begin ,cl-seq)
3326 cl-seq)
3327 (if ,listp-check
3328 (progn
3329 (while (memq (car begin) (cdr begin))
3330 (setq begin (cdr begin)))
3331 (setq cl-seq begin)
3332 (while (cddr cl-seq)
3333 (if (memq (cadr cl-seq) (cddr cl-seq))
3334 (setcdr (cdr cl-seq) (cddr cl-seq))
3335 (setq cl-seq (cdr cl-seq))))
3336 begin)
3337 ;; Call cl-delete-duplicates explicitly, to avoid the form
3338 ;; getting compiler-macroexpanded again:
3339 (cl-delete-duplicates begin ',cl-keys nil))))
3340 ((loop
3341 for relevant-key-values
3342 in '((:test 'eq :from-end t)
3343 (:test #'eq :from-end t))
3344 ;; One of the above corresponds exactly to CL-KEYS:
3345 thereis (not (set-difference cl-keys relevant-key-values
3346 :test #'equal)))
3347 `(let* ((begin ,cl-seq)
3348 (cl-seq begin))
3349 (if ,listp-check
3350 (progn
3351 (while cl-seq
3352 (setq cl-seq (setcdr cl-seq
3353 (delq (car cl-seq) (cdr cl-seq)))))
3354 begin)
3355 ;; Call cl-delete-duplicates explicitly, to avoid the form
3356 ;; getting compiler-macroexpanded again:
3357 (cl-delete-duplicates begin ',cl-keys nil))))
3358
3359 ((loop
3360 for relevant-key-values
3361 in '((:test 'equal)
3362 (:test #'equal)
3363 (:test 'equal :from-end nil)
3364 (:test #'equal :from-end nil))
3365 ;; One of the above corresponds exactly to CL-KEYS:
3366 thereis (not (set-difference cl-keys relevant-key-values
3367 :test #'equal)))
3368 `(let* ((begin ,cl-seq)
3369 cl-seq)
3370 (if ,listp-check
3371 (progn
3372 (while (member (car begin) (cdr begin))
3373 (setq begin (cdr begin)))
3374 (setq cl-seq begin)
3375 (while (cddr cl-seq)
3376 (if (member (cadr cl-seq) (cddr cl-seq))
3377 (setcdr (cdr cl-seq) (cddr cl-seq)))
3378 (setq cl-seq (cdr cl-seq)))
3379 begin)
3380 ;; Call cl-delete-duplicates explicitly, to avoid the form
3381 ;; getting compiler-macroexpanded again:
3382 (cl-delete-duplicates begin ',cl-keys nil))))
3383 ((loop
3384 for relevant-key-values
3385 in '((:test 'equal :from-end t)
3386 (:test #'equal :from-end t))
3387 ;; One of the above corresponds exactly to CL-KEYS:
3388 thereis (not (set-difference cl-keys relevant-key-values
3389 :test #'equal)))
3311 `(let* ((begin ,cl-seq) 3390 `(let* ((begin ,cl-seq)
3312 (cl-seq begin)) 3391 (cl-seq begin))
3313 (if ,listp-check 3392 (if ,listp-check
3314 (progn 3393 (progn
3315 (while cl-seq 3394 (while cl-seq
3316 (setq cl-seq (setcdr cl-seq (delq (car cl-seq) 3395 (setq cl-seq
3317 (cdr cl-seq))))) 3396 (setcdr cl-seq (delete (car cl-seq) (cdr cl-seq)))))
3318 begin) 3397 begin)
3319 ;; Call cl-delete-duplicates explicitly, to avoid the form 3398 ;; Call cl-delete-duplicates explicitly, to avoid the form
3320 ;; getting compiler-macroexpanded again: 3399 ;; getting compiler-macroexpanded again:
3321 (cl-delete-duplicates begin ',cl-keys nil)))) 3400 (cl-delete-duplicates begin ',cl-keys nil))))
3322 ((and (= 4 (length form)) 3401 (t form))))
3323 (eq :test (third form))
3324 (or (equal '(quote equal) (fourth form))
3325 (equal '(function equal) (fourth form))))
3326 `(let* ((begin ,cl-seq)
3327 (cl-seq begin))
3328 (if ,listp-check
3329 (progn
3330 (while cl-seq
3331 (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
3332 (cdr cl-seq)))))
3333 begin)
3334 ;; Call cl-delete-duplicates explicitly, to avoid the form
3335 ;; getting compiler-macroexpanded again:
3336 (cl-delete-duplicates begin ',cl-keys nil))))
3337 (t
3338 form))))
3339 3402
3340 ;; XEmacs; it's perfectly reasonable, and often much clearer to those 3403 ;; XEmacs; it's perfectly reasonable, and often much clearer to those
3341 ;; reading the code, to call regexp-quote on a constant string, which is 3404 ;; reading the code, to call regexp-quote on a constant string, which is
3342 ;; something we can optimise here easily. 3405 ;; something we can optimise here easily.
3343 (define-compiler-macro regexp-quote (&whole form string) 3406 (define-compiler-macro regexp-quote (&whole form string)