r9992: new function

diff --git a/datetime.lisp b/datetime.lisp
index 52d45b2a43b044e6919f77778fd6f9d4f7218296..f8aca20d74cd6b235c8fcec8b73d151dc783386b 100644 (file)
--- a/datetime.lisp
+++ b/datetime.lisp
@@ -89,7 +89,7 @@
     (10 . "October")
     (11 . "November")
     (12 . "December")))
     (10 . "October")
     (11 . "November")
     (12 . "December")))

-    
+

 (defun monthname (stream arg colon-p at-p &optional width (mincol 0) (colinc 1) (minpad 0) (padchar #\Space))
   "Print the name of the month (1=January) corresponding to ARG on STREAM.  This is intended for embedding in a FORMAT directive: WIDTH governs the number of characters of text printed, MINCOL, COLINC, MINPAD, PADCHAR work as for ~A"
   (let ((monthstring (cdr (assoc arg *monthnames*))))
 (defun monthname (stream arg colon-p at-p &optional width (mincol 0) (colinc 1) (minpad 0) (padchar #\Space))
   "Print the name of the month (1=January) corresponding to ARG on STREAM.  This is intended for embedding in a FORMAT directive: WIDTH governs the number of characters of text printed, MINCOL, COLINC, MINPAD, PADCHAR work as for ~A"
   (let ((monthstring (cdr (assoc arg *monthnames*))))

diff --git a/lists.lisp b/lists.lisp
index 9793f273d863227009390e794295864af9e63536..c18fe7e1982bf7ba03041b05315b34df815fcd54 100644 (file)
--- a/lists.lisp
+++ b/lists.lisp
@@ -192,3 +192,10 @@
         (setf ,plist (append ,plist (list ,pkey ,value)))))))
 
 
         (setf ,plist (append ,plist (list ,pkey ,value)))))))
 
 

+(defun unique-slot-values (list slot &key (test 'eql))
+  (let ((uniq '()))
+    (dolist (item list (nreverse uniq))
+      (let ((value (slot-value item slot)))
+       (unless (find value uniq :test test)
+         (push value uniq))))))
+

diff --git a/package.lisp b/package.lisp
index 9b9316f9f05f9e23e1bde6adb93a968c1d6aee28..fe5e7a4ecb8b73d99cf31d00423adad3f8c7d6ab 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -135,7 +135,8 @@
    #:update-plist
    #:get-plist
    #:flatten
    #:update-plist
    #:get-plist
    #:flatten

-
+   #:unique-slot-values
+   

    ;; seq.lisp
    #:nsubseq
    
    ;; seq.lisp
    #:nsubseq
    

diff --git a/tests.lisp b/tests.lisp
index 86e86bdbb19ac6f8067f6b0e8ada0b3f0e88c264..b555555c170c45c182922c8a46decfd23e700238 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -379,6 +379,25 @@
     (make-url "pg" :anchor "then" :vars '(("a" . "5") ("b" . "pi")))
   "pg?a=5&b=pi#then")
 
     (make-url "pg" :anchor "then" :vars '(("a" . "5") ("b" . "pi")))
   "pg?a=5&b=pi#then")
 

+(defclass test-unique ()
+  ((a :initarg :a)
+   (b :initarg :b)))
+     
+
+(deftest :unique.1
+    (let ((list (list (make-instance 'test-unique :a 1 :b 1)
+                     (make-instance 'test-unique :a 2 :b 2)
+                     (make-instance 'test-unique :a 3 :b 2))))
+      (values
+       (unique-slot-values list 'a)
+       (unique-slot-values list 'b)))
+  (1 2 3) (1 2))
+
+(deftest :unique.2
+    (unique-slot-values nil 'a)
+  nil)
+     
+          

  ;;; MOP Testing
 
 ;; Disable attrib class until understand changes in sbcl/cmucl
  ;;; MOP Testing
 
 ;; Disable attrib class until understand changes in sbcl/cmucl