(defun lcs (a b)
  (let ((l (make-array `(,(1+ (length a)) ,(1+ (length b))) 
                       :element-type '(integer 0)
                       :initial-element 0)))
    (loop for i from (1- (length a)) downto 0
      do
        (loop for j from (1- (length b)) downto 0
          do
            (setf (aref l i j)
              (if (equal (elt a i) (elt b j))
                  (1+ (aref l (1+ i) (1+ j)))
                  (max (aref l (1+ i) j)
                       (aref l i (1+ j)))))))
    l))
          
(defun diff (a b)
  (let ((l (lcs a b))
        (diff '()))
    (do ((i 0) (j 0) (hunk '()))
        ((and (= i (length a)) (= j (length b))) 
         (nreverse (if hunk (cons (nreverse hunk) diff) diff)))
      (cond
        ((= i (length a))
          (push `(t ,j ,(aref b j)) hunk)
          (incf j))
        ((= j (length b))
          (push `(nil ,i ,(aref a i)) hunk)
          (incf i))
        ((equal (elt a i) (elt b j))
          (when hunk
            (push (nreverse hunk) diff)
            (setf hunk '()))
          (incf i)
          (incf j))
        ((= (aref l i j) (1+ (aref l (1+ i) j)))
          (push `(t ,j ,(aref b j)) hunk)
          (incf j))
        (t
          (push `(nil ,i ,(aref a i)) hunk)
          (incf i))))))

(defun patch (a diff)
  (let ((b (make-array (length a) :adjustable t :fill-pointer 0))
        (pos 0)
        (offset 0))
    (dolist (hunk diff)
      (loop for (insertion index value) in hunk
        if insertion
          do
            (loop for i from pos to (1- (+ index offset))
                  for value = (elt a i)
              do
                (vector-push-extend value b))
            (vector-push-extend value b)
            (setf pos (+ index offset))
            (decf offset)
        else
          do
            (loop until (= pos index)
              do
                (vector-push-extend (elt a pos) b)
                (incf pos))
            (incf pos)
            (incf offset)))
    b))

(setf x "foobarbaz")
(setf y "quuxbardog")
(setf d (diff x y))
(setf z (patch x d))