[isidorus-cvs] r754 - trunk/src/model

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Thu Aug 18 10:19:50 2011
New Revision: 754

Log:
trunk: src: datamodel: fixed a bug in the function list-instanceOf => currently duplicates are remove from the result

Modified:
   trunk/src/model/datamodel.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	Thu Aug 18 01:40:40 2011	(r753)
+++ trunk/src/model/datamodel.lisp	Thu Aug 18 10:19:50 2011	(r754)
@@ -2343,27 +2343,28 @@
  (:method ((topic TopicC) &key (tm nil) (revision *TM-REVISION*))
    (declare (type (or null TopicMapC) tm)
 	    (integer revision))
-   (delete-if 
-    #'null
-    (map 'list
-	 #'(lambda(x)
-	     (when (and (parent x :revision revision)
-			(instance-of x :revision revision)
-			(loop for psi in (psis (instance-of x :revision revision)
-					       :revision revision)
-			   when (string= (uri psi) constants:*instance-psi*)
-			   return t))
-	       (loop for role in (roles (parent x :revision revision)
-					:revision revision)
-		  when (not (eq role x))
-		  return (player role :revision revision))))
-	 (if tm
-	     (delete-if-not 
-	      (lambda (role)
-		(in-topicmap tm (parent role :revision revision)
-			     :revision revision))
-	      (player-in-roles topic :revision revision))
-	     (player-in-roles topic :revision revision))))))
+   (delete-duplicates
+    (delete-if 
+     #'null
+     (map 'list
+	  #'(lambda(x)
+	      (when (and (parent x :revision revision)
+			 (instance-of x :revision revision)
+			 (loop for psi in (psis (instance-of x :revision revision)
+						:revision revision)
+			    when (string= (uri psi) constants:*instance-psi*)
+			    return t))
+		(loop for role in (roles (parent x :revision revision)
+					 :revision revision)
+		   when (not (eq role x))
+		   return (player role :revision revision))))
+	  (if tm
+	      (delete-if-not 
+	       (lambda (role)
+		 (in-topicmap tm (parent role :revision revision)
+			      :revision revision))
+	       (player-in-roles topic :revision revision))
+	      (player-in-roles topic :revision revision)))))))
  
 
 (defgeneric list-super-types (topic &key tm revision)
@@ -2372,26 +2373,27 @@
  (:method ((topic TopicC)  &key (tm nil) (revision *TM-REVISION*))
    (declare (type (or null TopicMapC) tm)
 	    (integer revision))
-   (delete-if 
-    #'null
-    (map 'list
-	 #'(lambda(x)
-	     (when (loop for psi in (psis (instance-of x :revision revision)
-					  :revision revision)
-		      when (string= (uri psi) *subtype-psi*)
-		      return t)
-	       (loop for role in (roles (parent x :revision revision)
-					:revision revision)
-		  when (not (eq role x))
-		  return (player role :revision revision))))
-	 (if tm
-	     (delete-if-not 
-	      (lambda (role)
-		(in-topicmap tm (parent role :revision revision)
-			     :revision revision))
-	      (player-in-roles topic :revision revision))
-	     (player-in-roles topic :revision revision))))))
-
+   (delete-duplicates
+    (delete-if 
+     #'null
+     (map 'list
+	  #'(lambda(x)
+	      (when (loop for psi in (psis (instance-of x :revision revision)
+					   :revision revision)
+		       when (string= (uri psi) *subtype-psi*)
+		       return t)
+		(loop for role in (roles (parent x :revision revision)
+					 :revision revision)
+		   when (not (eq role x))
+		   return (player role :revision revision))))
+	  (if tm
+	      (delete-if-not 
+	       (lambda (role)
+		 (in-topicmap tm (parent role :revision revision)
+			      :revision revision))
+	       (player-in-roles topic :revision revision))
+	      (player-in-roles topic :revision revision)))))))
+ 
 
 ;;; CharacteristicC
 (defmethod versions ((construct CharacteristicC))