r11148: fix limit / filter, improve udoc support

[umlisp.git] / class-support.lisp

diff --git a/class-support.lisp b/class-support.lisp
index e7fe96025c47aa25126d121162bf286b68d4ea2c..dd969038bc87ee7e65396631be22e207d85c1d2c 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -368,7 +368,14 @@
         (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b))))
         anc-lists)))))
 
-
+(defun uso-unique-codes (usos)
+  (let ((sab-codes (make-hash-table :test 'equal)))
+    (dolist (uso usos)
+      (setf (gethash (sab uso) sab-codes) (code uso)))
+    (loop for key being the hash-key in sab-codes
+        collect (list key (gethash key sab-codes)))))
+
+                                          
 #+scl
 (dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl))
     (let ((cl (find-class c)))