; diff

(define-syntax curried-lambda
  (syntax-rules ()
    ((_ () body body* ...)
      (begin body body* ...))
    ((_ (arg arg* ...) body body* ...)
      (lambda (arg)
        (curried-lambda (arg* ...)
          body body* ...)))))

(define-syntax define-curried
  (syntax-rules ()
    ((_ (func arg ...) body body* ...)
      (define func
        (curried-lambda (arg ...)
          body body* ...)))))

(define (take-while pred? xs)
  (let loop ((xs xs) (ys '()))
    (if (or (null? xs) (not (pred? (car xs))))
        (reverse ys)
        (loop (cdr xs) (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (read-line . port)
  (define (eat p c)
    (if (and (not (eof-object? (peek-char p)))
             (char=? (peek-char p) c))
        (read-char p)))
  (let ((p (if (null? port) (current-input-port) (car port))))
    (let loop ((c (read-char p)) (line '()))
      (cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
            ((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
            ((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
            (else (loop (read-char p) (cons c line)))))))

(define (read-lines . port)
  (let ((p (if (null? port) (current-input-port) (car port))))
    (let loop ((l (read-line p)) (ls '()))
      (if (eof-object? l)
          (reverse ls)
          (loop (read-line p) (cons l ls))))))

(define (read-lines filename)
  (with-input-from-file filename
    (lambda ()
      (let loop ((l (read-line)) (ls '()))
        (if (eof-object? l)
            (reverse ls)
            (loop (read-line) (cons l ls)))))))

(define (make-matrix rows columns)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)
    (vector-set! m i (make-vector columns))))
(define (matrix-rows x) (vector-length x))
(define (matrix-cols x) (vector-length (vector-ref x 0)))
(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))

(define-syntax for
  (syntax-rules ()
    ((for (var first past step) body ...)
      (let ((ge? (if (< first past) >= <=)))
        (do ((var first (+ var step)))
            ((ge? var past))
          body ...)))
    ((for (var first past) body ...)
      (let* ((f first) (p past) (s (if (< first past) 1 -1)))
        (for (var f p s) body ...)))
    ((for (var past) body ...)
      (let* ((p past)) (for (var 0 p) body ...)))))

(define (lcs eql? xs ys)
  (let* ((x-len (length xs)) (y-len (length ys))
         (x1 (+ x-len 1)) (y1 (+ y-len 1))
         (xv (list->vector xs)) (yv (list->vector ys))
         (m (make-matrix x1 y1)))
    (for (x 0 x1)
      (for (y 0 y1)
        (cond ((or (zero? x) (zero? y))
                (matrix-set! m x y 0))
              ((eql? (vector-ref xv (- x 1))
                     (vector-ref yv (- y 1)))
                (matrix-set! m x y
                  (+ 1 (matrix-ref m (- x 1) (- y 1)))))
              (else (matrix-set! m x y
                      (max (matrix-ref m (- x 1) y)
                           (matrix-ref m x (- y 1))))))))
    (let loop ((x x-len) (y y-len) (zs '()))
      (cond ((or (zero? x) (zero? y)) zs)
            ((= (matrix-ref m x y) (matrix-ref m (- x 1) y))
              (loop (- x 1) y zs))
            ((= (matrix-ref m x y) (matrix-ref m x (- y 1)))
              (loop x (- y 1) zs))
            (else (loop (- x 1) (- y 1) (cons (vector-ref xv (- x 1)) zs)))))))

(define (display-header a b c d e)
  (display a) (when (not (= a b)) (display ",") (display b)) (display c)
  (display d) (when (not (= d e)) (display ",") (display e)) (newline))

(define-curried (display-line c s)
  (display c) (display " ") (display s) (newline))

(define (diff file1 file2)
  (let* ((f1 (read-lines file1))
         (f2 (read-lines file2))
         (ds (lcs string=? f1 f2)))
    (let loop ((f1 f1) (f2 f2) (ds ds) (n1 0) (n2 0))
      (cond ((null? f1)
              (when (pair? f2)
                (display-header n1 n1 "a" (+ n2 1) (+ n2 (length f2)))
                (for-each (display-line ">") f2)))
            ((null? f2)
              (when (pair? f1)
                (display-header (+ n1 1) (+ n1 (length f1)) "d" n2 n2)
                (for-each (display-line "<") f1)))
            ((and (string=? (car f1) (car ds)) (string=? (car f2) (car ds)))
              (loop (cdr f1) (cdr f2) (cdr ds) (+ n1 1) (+ n2 1)))
            ((string=? (car f1) (car ds))
              (let* ((xs (take-while (lambda (s) (not (string=? (car ds) s))) f2))
                     (len (length xs)))
                (display-header n1 n1 "a" (+ n2 1) (+ n2 len))
                (for-each (display-line ">") xs)
                (loop f1 (drop len f2) ds n1 (+ n2 len))))
            ((string=? (car f2) (car ds))
              (let* ((xs (take-while (lambda (s) (not (string=? (car ds) s))) f1))
                     (len (length xs)))
                (display-header (+ n1 1) (+ n1 len) "d" n2 n2)
                (for-each (display-line "<") xs)
                (loop (drop len f1) f2 ds (+ n1 len) n2)))
             (else (let* ((x1 (take-while (lambda (s) (not (string=? (car ds) s))) f1))
                          (x2 (take-while (lambda (s) (not (string=? (car ds) s))) f2))
                          (len1 (length x1)) (len2 (length x2)))
                     (display-header (+ n1 1) (+ n1 len1) "c" (+ n2 1) (+ n2 len2))
                     (for-each (display-line "<") x1)
                     (display "---") (newline)
                     (for-each (display-line ">") x2)
                     (loop (drop len1 f1) (drop len2 f2) ds (+ n1 len1) (+ n2 len2))))))))