[isidorus-cvs] r300 - branches/new-datamodel/src/model

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Jun 15 16:44:14 2010
New Revision: 300

Log:
new-datamodel: fixed a bug in merging an entire list of constructs in the function merge-all-constructs

Modified:
   branches/new-datamodel/src/model/datamodel.lisp

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Tue Jun 15 16:44:14 2010
@@ -831,12 +831,18 @@
 (defun merge-all-constructs(constructs-to-be-merged &key (revision *TM-REVISION*))
   "Merges all constructs contained in the given list."
   (declare (list constructs-to-be-merged))
-  (let ((constructs-to-be-merged (subseq constructs-to-be-merged 1))
-	(merged-construct (elt constructs-to-be-merged 0)))
-    (loop for construct-to-be-merged in constructs-to-be-merged
-       do (setf merged-construct
-		(merge-constructs merged-construct construct-to-be-merged
-				  :revision revision)))))
+  (cond ((null constructs-to-be-merged)
+	 nil)
+	((= (length constructs-to-be-merged) 1)
+	 (first constructs-to-be-merged))
+	(t
+	 (let ((constr-1 (first constructs-to-be-merged))
+	       (constr-2 (second constructs-to-be-merged))
+	       (tail (subseq constructs-to-be-merged 2)))
+	   (let ((merged-constr
+		  (merge-constructs constr-1 constr-2 :revision revision)))
+	     (merge-all-constructs (append (list merged-constr)
+					   tail)))))))
 
 
 (defgeneric internal-id (construct)