[Cl-darcs-cvs] r89 - cl-darcs/trunk

[mhenoch at common-lisp.net]

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))