Added delete-adjacent-duplicates

git-svn-id: svn://10.0.0.236/trunk@113625 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
waldemar%netscape.com 2002-02-04 21:09:51 +00:00
parent 57833896b4
commit 5b51f9b435

View File

@ -12,10 +12,22 @@
;;; ;;;
;;; The Initial Developer of the Original Code is Netscape Communications ;;; The Initial Developer of the Original Code is Netscape Communications
;;; Corporation. Portions created by Netscape Communications Corporation are ;;; Corporation. Portions created by Netscape Communications Corporation are
;;; Copyright (C) 1999 Netscape Communications Corporation. All ;;; Copyright (C) 1999-2002 Netscape Communications Corporation. All
;;; Rights Reserved. ;;; Rights Reserved.
;;; ;;;
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org> ;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
;;;
;;; Alternatively, the contents of this file may be used under the terms of
;;; either the GNU General Public License Version 2 or later (the "GPL"), or
;;; the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
;;; in which case the provisions of the GPL or the LGPL are applicable instead
;;; of those above. If you wish to allow use of your version of this file only
;;; under the terms of either the GPL or the LGPL, and not to allow others to
;;; use your version of this file under the terms of the MPL, indicate your
;;; decision by deleting the provisions above and replace them with the notice
;;; and other provisions required by the GPL or the LGPL. If you do not delete
;;; the provisions above, a recipient may use your version of this file under
;;; the terms of any one of the MPL, the GPL or the LGPL.
;;; ;;;
;;; Handy lisp utilities ;;; Handy lisp utilities
@ -356,6 +368,22 @@
t))) t)))
; Given a list, destructively delete elements that are equal to the previous element using the given
; equality test. Return list.
(defun delete-adjacent-duplicates (list &key (test #'eql))
(unless (endp list)
(let ((p list))
(do ((value (first p))
(rest (rest p) (rest p)))
((endp rest))
(let ((value2 (first rest)))
(if (funcall test value value2)
(setf (rest p) (rest rest))
(setq p rest))
(setq value value2))))
list))
; Given an association list ((key1 . data1) (key2 . data2) ... (keyn datan)), ; Given an association list ((key1 . data1) (key2 . data2) ... (keyn datan)),
; produce another association list whose keys are sets of the keys of the original list, ; produce another association list whose keys are sets of the keys of the original list,
; where the data elements of each such set are equal according to the given test function. ; where the data elements of each such set are equal according to the given test function.