Mercurial > hg > xemacs-beta

comparison lisp/cl.el @ 5420:b9167d522a9a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rebase with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 28 Oct 2010 23:53:24 +0200
parents 308d34e9f07d bbff29a01820
children 6506fcb40fcf
comparison
equal deleted inserted replaced
5419:eaf01113cd42 5420:b9167d522a9a
361 ;; These functions are made known to the byte-compiler by cl-macs.el 361 ;; These functions are made known to the byte-compiler by cl-macs.el
362 ;; and turned into efficient car and cdr bytecodes. 362 ;; and turned into efficient car and cdr bytecodes.
363 363
364 (defalias 'first 'car) 364 (defalias 'first 'car)
365 (defalias 'rest 'cdr) 365 (defalias 'rest 'cdr)
366 (defalias 'endp 'null) 366
367 ;; XEmacs change; this needs to error if handed a non-list.
368 (defun endp (list)
369 "Return t if LIST is nil, or nil if LIST is a cons. Error otherwise."
370 (prog1
371 (null list)
372 (and list (atom list) (error 'wrong-type-argument #'listp list))))
367 373
368 ;; XEmacs change: make it a real function 374 ;; XEmacs change: make it a real function
369 (defun second (x) 375 (defun second (x)
370 "Return the second element of the list LIST." 376 "Return the second element of the list LIST."
371 (car (cdr x))) 377 (car (cdr x)))
515 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." 521 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
516 (cdr (cdr (cdr (cdr x))))) 522 (cdr (cdr (cdr (cdr x)))))
517 523
518 ;;; `last' is implemented as a C primitive, as of 1998-11 524 ;;; `last' is implemented as a C primitive, as of 1998-11
519 525
520 (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el 526 ;;; XEmacs: `list*' is in subr.el.
521 "Return a new list with specified args as elements, cons'd to last arg. 527
522 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to 528 ;; XEmacs; handle dotted lists properly, error on circularity and if LIST is
523 `(cons A (cons B (cons C D)))'." 529 ;; not a list.
524 (cond ((not rest) arg)
525 ((not (cdr rest)) (cons arg (car rest)))
526 (t (let* ((n (length rest))
527 (copy (copy-sequence rest))
528 (last (nthcdr (- n 2) copy)))
529 (setcdr last (car (cdr last)))
530 (cons arg copy)))))
531
532 (defun ldiff (list sublist) 530 (defun ldiff (list sublist)
533 "Return a copy of LIST with the tail SUBLIST removed." 531 "Return a copy of LIST with the tail SUBLIST removed.
534 (let ((res nil)) 532
535 (while (and (consp list) (not (eq list sublist))) 533 If SUBLIST is the same Lisp object as LIST, return nil. If SUBLIST is
536 (push (pop list) res)) 534 not present in the list structure of LIST (that is, it is not the cdr
537 (nreverse res))) 535 of some cons making up LIST), this function is equivalent to
536 `copy-list'. LIST may be dotted."
537 (check-argument-type #'listp list)
538 (and list (not (eq list sublist))
539 (let ((before list) (evenp t) result)
540 (prog1
541 (setq result (list (car list)))
542 (while (and (setq list (cdr-safe list)) (not (eql list sublist)))
543 (setcdr result (if (consp list) (list (car list)) list))
544 (setq result (cdr result)
545 evenp (not evenp))
546 (if evenp (setq before (cdr before)))
547 (if (eq before list) (error 'circular-list list)))))))
538 548
539 ;;; `copy-list' is implemented as a C primitive, as of 1998-11 549 ;;; `copy-list' is implemented as a C primitive, as of 1998-11
540 550
541 (defalias 'cl-member 'memq) ; for compatibility with old CL package 551 (defalias 'cl-member 'memq) ; for compatibility with old CL package
542 (defalias 'cl-floor 'floor*) 552 (defalias 'cl-floor 'floor*)