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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Jul 12 11:30:01 2006
New Revision: 26

Added:
   cl-darcs/trunk/merge.lisp
Modified:
   cl-darcs/trunk/cl-darcs.asd
Log:
Add merge.lisp


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Wed Jul 12 11:30:01 2006
@@ -39,6 +39,7 @@
    (:file "invert-patch" :depends-on ("patch-core"))
    (:file "touching" :depends-on ("patch-core"))
    (:file "commute" :depends-on ("patch-core"))
+   (:file "merge" :depends-on ("patch-core"))
    (:file "unwind" :depends-on ("patch-core"))
    (:file "equal" :depends-on ("patch-core"))
 

Added: cl-darcs/trunk/merge.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/merge.lisp	Wed Jul 12 11:30:01 2006
@@ -0,0 +1,38 @@
+;;; Copyright (C) 2006 Magnus Henoch
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+(in-package :darcs)
+
+(defun merge-patches (p1 p2)
+  "Create variant of P1 that can be applied after P2.
+P1 and P2 are parallel patches, i.e. they apply to the same tree.
+We now want to apply P2 and then P1 to that tree.  This function
+returns a version of P1 that satisfies that constraint."
+  (or (elegant-merge p1 p2)
+      (error "Couldn't merge ~A and ~A." p1 p2)))
+
+(defun elegant-merge (p1 p2)
+  ;; A piece of patch algebra.  See PatchCommute.lhs for the
+  ;; explanation.
+  (destructuring-bind (&optional p2-new p1-new)
+      (commute p1 (invert-patch p2))
+    (declare (ignore p2-new))
+    (when p1-new
+      (destructuring-bind (&optional p2-old p1-old)
+	  (commute p1-new p2)
+	(declare (ignore p2-old))
+	(when (equal-patch p1 p1-old t)
+	  p1-new)))))