Author: lgiessmann Date: Tue Apr 6 15:56:27 2010 New Revision: 266 Log: new-datamodel: added "merge-constructs" --> "AssociationC" 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 Apr 6 15:56:27 2010 @@ -3607,7 +3607,34 @@ older-tm)))) - +(defmethod merge-constructs ((construct-1 AssociationC) (construct-2 AssociationC) + &key revision) + (declare (integer revision)) + (if (eql construct-1 construct-2) + construct-1 + (let ((older-assoc (find-oldest-construct construct-1 construct-2))) + (let ((newer-assoc (if (eql older-assoc construct-1) + construct-2 + construct-1))) + (unless (strictly-equivalent-constructs construct-1 construct-2 + :revision revision) + (error "From merge-constructs(): ~a and ~a are not mergable" + construct-1 construct-2)) + (move-referenced-constructs newer-assoc older-assoc) + (dolist (newer-role (roles newer-assoc :revision revision)) + (let ((equivalent-role + (find-if #'(lambda(older-role) + (strictly-equivalent-constructs + older-role newer-role :revision revision)) + (roles older-assoc :revision revision)))) + (move-referenced-constructs newer-role equivalent-role + :revision revision) + (delete-role newer-assoc newer-role :revision revision) + (add-role older-assoc equivalent-role :revision revision))) + (mark-as-deleted newer-assoc :revision revision) + (when (exist-in-revision-history-? newer-assoc) + (delete-construct newer-assoc)) + older-assoc)))) ;TODO: merge-constructs: RoleC (merge parents), AssociationC