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

Author: lgiessmann Date: Tue Apr 6 02:30:26 2010 New Revision: 261 Log: new-datamodel: optimized "merge-constructs" --> "OccurrenceC" 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 02:30:26 2010 @@ -3496,12 +3496,16 @@ (error "From merge-constructs():~a and ~a must be associated with a topic" construct-1 construct-2)) (if (and parent-1 (eql parent-1 parent-2)) - (progn - (move-identifiers construct-1 construct-2 :revision revision) - (move-referenced-constructs construct-1 construct-2 - :revision revision) - (delete-occurrence parent-1 construct-1 :revision revision) - (add-occurrence parent-1 construct-2 :revision revision)) + (let ((older-occ (find-oldest-construct construct-1 construct-2))) + (let ((newer-occ (if (eql older-occ construct-1) + construct-2 + construct-1))) + (move-identifiers newer-occ older-occ :revision revision) + (move-referenced-constructs newer-occ older-occ + :revision revision) + (delete-occurrence parent-1 construct-1 :revision revision) + (add-occurrence parent-1 construct-2 :revision revision) + older-occ)) (let ((active-topic (merge-constructs parent-1 parent-2 :revision revision))) (if (find construct-1
participants (1)
-
Lukas Giessmann