Author: mhenoch Date: Sat Jun 10 11:50:26 2006 New Revision: 6 Added: cl-darcs/trunk/commute.lisp Modified: cl-darcs/trunk/cl-darcs.asd Log: Start hacking commutation. Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Sat Jun 10 11:50:26 2006 @@ -37,6 +37,7 @@ (:file "apply-patch" :depends-on ("patch-core")) (:file "invert-patch" :depends-on ("patch-core")) (:file "touching" :depends-on ("patch-core")) + (:file "commute" :depends-on ("patch-core")) ;; Franz' inflate implementation #-allegro (:file "ifstar") Added: cl-darcs/trunk/commute.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/commute.lisp Sat Jun 10 11:50:26 2006 @@ -0,0 +1,58 @@ +(in-package :darcs) + +(defgeneric commute-patches (p2 p1) + (:documentation "Attempt to commute the patches P2 and P1. +Return a list, (P1-NEW P2-NEW), such that applying P2-NEW and then +P1-NEW has the same effect as applying P1 and then P2. +If commutations fails, return nil.")) + +(defmethod commute-patches :around ((p2 file-patch) (p1 file-patch)) + "If P1 and P2 change different files, commutation is trivial." + (let ((p1-file (patch-filename p1)) + (p2-file (patch-filename p2))) + (if (not (equal p1-file p2-file)) + (list p1 p2) + (call-next-method)))) + +(defmethod commute-patches ((p2 hunk-patch) (p1 hunk-patch)) + "Attempt to commute the two hunk patches P1 and P2." + (assert (equal (patch-filename p1) (patch-filename p2))) + (with-accessors ((line1 hunk-line-number) + (old1 hunk-old-lines) + (new1 hunk-new-lines)) p1 + (with-accessors ((line2 hunk-line-number) + (old2 hunk-old-lines) + (new2 hunk-new-lines)) p2 + (cond + ((< (+ line1 (length new1)) line2) + ;; The first patch changes text before the second patch. + (list p1 + (make-instance 'hunk-patch :filename (patch-filename p2) + :line-number (+ line2 (- (length new1)) (length old1)) + :old old2 :new new2))) + ((< (+ line2 (length old2) line1)) + ;; The second patch changes text before the first patch. + (list (make-instance 'hunk-patch :filename (patch-filename p1) + :line-number (+ line1 (length new2) (- (length old2))) + :old old1 :new new1) + p2)) + ((and (= (+ line1 (length new1)) line2) + (notany #'zerop + (mapcar #'length (list old1 old2 new1 new2)))) + ;; The first patch goes exactly until the beginning of the second patch. + (list p1 + (make-instance 'hunk-patch :filename (patch-filename p2) + :line-number (+ line2 (- (length new1)) (length old1)) + :old old2 :new new2))) + ((and (= (+ line2 (length old2)) line1) + (notany #'zerop + (mapcar #'length (list old1 old2 new1 new2)))) + ;; The second patch goes exactly until the beginning of the first patch. + (list (make-instance 'hunk-patch :filename (patch-filename p1) + :line-number (+ line1 (length new2) (- (length old2))) + :old old1 :new new1) + p2)) + (t + ;; In other cases, there is no failsafe way to commute the + ;; patches, so we give up. + nil)))))