Author: mhenoch Date: Wed Feb 14 23:00:51 2007 New Revision: 89 Modified: cl-darcs/trunk/commute.lisp Log: More commute methods Modified: cl-darcs/trunk/commute.lisp ============================================================================== --- cl-darcs/trunk/commute.lisp (original) +++ cl-darcs/trunk/commute.lisp Wed Feb 14 23:00:51 2007 @@ -27,6 +27,68 @@ (warn "No method defined for commuting ~A and ~A." p2 p1) nil) +(defmethod commute ((p2 named-patch) (p1 patch)) + "Commute a named patch and another patch." + (destructuring-bind (&optional p1-new p2-new) + (commute (named-patch-patch p2) p1) + (if p1-new + (list p1-new + (make-instance 'named-patch + :patchinfo (named-patch-patchinfo p2) + :dependencies (named-patch-dependencies p2) + :patch p2-new)) + (call-next-method)))) + +(defmethod commute ((p2 patch) (p1 named-patch)) + "Commute a patch with a named patch." + (destructuring-bind (&optional p1-new p2-new) + (commute p2 (named-patch-patch p1)) + (if p1-new + (list (make-instance 'named-patch + :patchinfo (named-patch-patchinfo p1) + :dependencies (named-patch-dependencies p1) + :patch p1-new) + p2-new) + (call-next-method)))) + +(defmethod commute ((p2 move-patch) (p1 file-patch)) + "Commute a move patch with a file patch." + (let ((patched-file (patch-filename p1)) + (moved-from (patch-move-from p2)) + (moved-to (patch-move-to p2))) + (cond + ;; File was patched and then moved + ((equal patched-file moved-from) + (let ((p1-new (copy-patch p1))) + (setf (patch-filename p1-new) moved-to) + (list p1-new p2))) + ;; Another file moved on top of original file + ((equal patched-file moved-to) + (warn "Collision when commuting ~A and ~A." p2 p1) + nil) + ;; Patches touch different files + (t + (list p1 p2))))) + +(defmethod commute ((p2 file-patch) (p1 move-patch)) + "Commute a file patch with a move patch." + (let ((moved-from (patch-move-from p1)) + (moved-to (patch-move-to p1)) + (patched-file (patch-filename p2))) + (cond + ;; File was moved and then patched + ((equal moved-to patched-file) + (let ((p2-new (copy-patch p2))) + (setf (patch-filename p2-new) moved-from) + (list p1 p2-new))) + ;; File was moved before being patched + ((equal moved-from patched-file) + (warn "Collision when commuting ~A and ~A." p2 p1) + nil) + ;; Patches touch different files + (t + (list p1 p2))))) + (defmethod commute :around ((p2 file-patch) (p1 file-patch)) "If P1 and P2 change different files, commutation is trivial." (let ((p1-file (patch-filename p1))