X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=class-support.lisp;h=dd969038bc87ee7e65396631be22e207d85c1d2c;hp=e7fe96025c47aa25126d121162bf286b68d4ea2c;hb=c88fbfe8bd947b12c89f32effaf328699ba067ab;hpb=e70c7b119ecfffb895d5536d0edb1fd373633038 diff --git a/class-support.lisp b/class-support.lisp index e7fe960..dd96903 100644 --- 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)))