[bknr-cvs] r2176 - branches/bos/bknr/src/data

[bknr at bknr.net]

Author: hhubner
Date: 2007-10-02 06:53:43 -0400 (Tue, 02 Oct 2007)
New Revision: 2176

Modified:
   branches/bos/bknr/src/data/object.lisp
Log:
Factor out partition function.  Should be moved to utils eventually.


Modified: branches/bos/bknr/src/data/object.lisp
===================================================================
--- branches/bos/bknr/src/data/object.lisp	2007-09-28 17:16:21 UTC (rev 2175)
+++ branches/bos/bknr/src/data/object.lisp	2007-10-02 10:53:43 UTC (rev 2176)
@@ -613,16 +613,23 @@
 (defmethod cascade-delete-p (object referencing-object)
   nil)
 
+(defun partition-list (list predicate)
+  "Return two list values, the first containing all elements from LIST
+that satisfy PREDICATE, the second those that don't"
+  (let (do dont)
+    (dolist (element list)
+      (if (funcall predicate element)
+	  (push element do)
+	  (push element dont)))
+    (values do dont)))
+
 (defun cascading-delete-object (object)
   "Delete the OBJECT and all objects that reference it and that are eligible to cascading deletes, as indicated by
 the result of calling CASCADE-DELETE-P.  Generate error if there are references to the objects that are not eligible
 to cascading deletes."
-  (let (cascading-delete-refs
-	remaining-refs)
-    (dolist (referencing-object (find-refs object))
-      (if (cascade-delete-p object referencing-object)
-	  (push referencing-object cascading-delete-refs)
-	  (push referencing-object remaining-refs)))
+  (multiple-value-bind (cascading-delete-refs
+			remaining-refs)
+      (partition-list (find-refs object) #'cascade-delete-p)
     (when remaining-refs
       (error "Cannot delete object ~A because there are references to this object in the system, please consult a system administrator!"
 	     object))