#!/usr/bin/sbcl --noinform

(defun read-el (stream &optional (eof-error-p t) (eof-value nil))
  "Like read-char or read-byte, but works on either kind of stream"
  (let ((seq (list nil)))
    (declare (dynamic-extent seq))
    (ecase (read-sequence seq stream)
      (0 (if eof-error-p (error 'end-of-file) eof-value))
      (1 (elt seq 0)))))

(defun write-el (el stream)
  "Like write-char or write-byte, but works on either kind of stream"
  (let ((seq (list el)))
    (declare (dynamic-extent seq))
    (write-sequence seq stream)))

(defun cat (in out)
  "Dump from in to out"
  (do ((el (read-el in nil) (read-el in nil)))
      ((not el))
    (write-el el out)))

(defun merge-streams (badelement in1 in2 &optional (out *standard-output*))
  "Merge two streams, preferring against badelement (usually 0).
   Good for merging recovery attempts from damaged media, etc."
  (let ((agreecount 0) (in1count 0) (in2count 0) (conflictcount 0))
    (do ((el1 (read-el in1 nil) (read-el in1 nil))
         (el2 (read-el in2 nil) (read-el in2 nil)))
	((not (and el1 el2))
         (cond (el1 (write-el el1 out) (cat in1 out))
               (el2 (write-el el2 out) (cat in2 out))))
      (cond ((eql el1 el2)        (incf agreecount)    (write-el el1 out))
            ((eql el2 badelement) (incf in1count)      (write-el el1 out))
            ((eql el1 badelement) (incf in2count)      (write-el el2 out))
            (t                    (incf conflictcount) (write-el el1 out))))
    (values agreecount in1count in2count conflictcount)))

(defun merge-files (badelement infile1 infile2 outfile)
  "Open some files and hand them to merge-streams"
  (with-open-file     (in1 infile1 :element-type 'unsigned-byte)
    (with-open-file   (in2 infile2 :element-type 'unsigned-byte)
      (with-open-file (out outfile :element-type 'unsigned-byte
;                                  :if-exists    :overwrite
                                   :direction    :output)
        (merge-streams badelement in1 in2 out)))))

(defun merge-files-verbose (badelement infile1 infile2 outfile)
  "merge-files, and print statistics"
  (multiple-value-bind (agreecount in1count in2count conflictcount)
      (merge-files badelement infile1 infile2 outfile)
    (format t "
~A bytes in agreement
~A bytes from ~A
~A bytes from ~A
~A bytes did not agree
" agreecount in1count infile1 in2count infile2 conflictcount)))

; Tests
(defun assert-merge (badelement str1 str2 expected)
  (with-input-from-string   (in1 str1)
    (with-input-from-string (in2 str2)
      (assert (string= expected (with-output-to-string (out)
                                  (merge-streams badelement in1 in2 out)))))))

(compile 'read-el)
(compile 'write-el)
(compile 'cat)
(compile 'merge-streams)

(assert-merge #\x "a"      "a"       "a")
(assert-merge #\x "a"      "x"       "a")
(assert-merge #\x "x"      "a"       "a")
(assert-merge #\x "x"      "x"       "x")
(assert-merge #\x "a"      "b"       "a")
(assert-merge #\x "ab"     "a"       "ab")
(assert-merge #\x "abc"    "a"       "abc")
(assert-merge #\x "a"      "ab"      "ab")
(assert-merge #\x "a"      "abc"     "abc")
(assert-merge #\x "abxdxf" "axczxfg" "abcdxfg")

; Main invocation
(apply #'merge-files-verbose 0 (cddr *posix-argv*))