Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5285:99de5fd48e87

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tighten up Common Lisp compatibility, #'butlast, #'nbutlast, #'tailp, #'ldiff lisp/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. src/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fnbutlast, Fbutlast): Tighten up Common Lisp compatibility for these two functions; they need to operate on dotted lists without erroring. tests/ChangeLog addition: 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (x): Test #'nbutlast, #'butlast with dotted lists. Check that #'ldiff and #'tailp don't hang on circular lists; check that #'tailp returns t with circular lists when that is appropriate. Test them both with dotted lists.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 14 Oct 2010 18:50:38 +0100
parents 90a0084b3541
children bbff29a01820
comparison
equal deleted inserted replaced
5284:d27c1ee1943b 5285:99de5fd48e87
2405 (store-temp (gensym "--getf-store--"))) 2405 (store-temp (gensym "--getf-store--")))
2406 (list (append (car method) (list tag-temp def-temp)) 2406 (list (append (car method) (list tag-temp def-temp))
2407 (append (nth 1 method) (list tag def)) 2407 (append (nth 1 method) (list tag def))
2408 (list store-temp) 2408 (list store-temp)
2409 (list 'let (list (list (car (nth 2 method)) 2409 (list 'let (list (list (car (nth 2 method))
2410 (list 'cl-set-getf (nth 4 method) 2410 (list 'plist-put (nth 4 method)
2411 tag-temp store-temp))) 2411 tag-temp store-temp)))
2412 (nth 3 method) store-temp) 2412 (nth 3 method) store-temp)
2413 (list 'getf (nth 4 method) tag-temp def-temp)))) 2413 (list 'getf (nth 4 method) tag-temp def-temp))))
2414 2414
2415 (define-setf-method substring (place from &optional to) 2415 (define-setf-method substring (place from &optional to)
2595 (and tag-temp (list (list tag-temp tag)))) 2595 (and tag-temp (list (list tag-temp tag))))
2596 (list 'if (list 'eq ttag (list 'car tval)) 2596 (list 'if (list 'eq ttag (list 'car tval))
2597 (list 'progn 2597 (list 'progn
2598 (cl-setf-do-store (nth 1 method) (list 'cddr tval)) 2598 (cl-setf-do-store (nth 1 method) (list 'cddr tval))
2599 t) 2599 t)
2600 (list 'cl-do-remf tval ttag))))) 2600 (list 'plist-remprop tval ttag)))))
2601 2601
2602 ;;;###autoload 2602 ;;;###autoload
2603 (defmacro shiftf (place &rest args) 2603 (defmacro shiftf (place &rest args)
2604 "(shiftf PLACE PLACE... VAL): shift left among PLACEs. 2604 "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
2605 Example: (shiftf A B C) sets A to B, B to C, and returns the old A. 2605 Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
3803 (list 'list (list 'quote (caddr y)) 'x)) 3803 (list 'list (list 'quote (caddr y)) 'x))
3804 (cons 'list (cdr y)))))) 3804 (cons 'list (cdr y))))))
3805 '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) 3805 '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
3806 (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) 3806 (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
3807 (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) 3807 (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
3808 (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) 3808 (rest 'cdr x) (plusp '> x 0) (minusp '< x 0)
3809 (oddp 'eq (list 'logand x 1) 1) 3809 (oddp 'eq (list 'logand x 1) 1)
3810 (evenp 'eq (list 'logand x 1) 0) 3810 (evenp 'eq (list 'logand x 1) 0)
3811 (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) 3811 (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
3812 (caaar car caar) (caadr car cadr) (cadar car cdar) 3812 (caaar car caar) (caadr car cadr) (cadar car cdar)
3813 (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) 3813 (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)