Author: mhenoch Date: Wed Jul 12 15:06:02 2006 New Revision: 28 Modified: cl-darcs/trunk/commute.lisp Log: Add commute methods for composite patches Modified: cl-darcs/trunk/commute.lisp ============================================================================== --- cl-darcs/trunk/commute.lisp (original) +++ cl-darcs/trunk/commute.lisp Wed Jul 12 15:06:02 2006 @@ -77,3 +77,44 @@ ;; In other cases, there is no failsafe way to commute the ;; patches, so we give up. nil))))) + +(defmethod commute ((p2 composite-patch) (p1 patch)) + (cond + ;; Simple case first... + ((null (patches p2)) + (list p1 p2)) + (t + ;; Now, p1 was committed before all the patches in p2, and we + ;; want it to come after. + (let ((p2s (patches p2)) + p2s-new) + (loop for p in p2s + do (destructuring-bind (&optional p1-new p-new) + (commute p p1) + (cond + ((null p1-new) + (return-from commute (call-next-method))) + (t + (setf p1 p1-new) + (push p-new p2s-new))))) + (list p1 (make-instance 'composite-patch :patches (nreverse p2s-new))))))) +(defmethod commute ((p2 patch) (p1 composite-patch)) + (cond + ((null (patches p1)) + (list p1 p2)) + (t + ;; p2 was committed after all the patches in p1. Thus we start + ;; backwards in p1, commuting p2 with each of the patches. + (let ((p1s (reverse (patches p1))) + p1s-new) + (loop for p in p1s + do (destructuring-bind (&optional p-new p2-new) + (commute p2 p) + (cond + ((null p-new) + (return-from commute (call-next-method))) + (t + (setf p2 p2-new) + (push p-new p1s-new))))) + (list (make-instance 'composite-patch :patches p1s-new) + p2)))))