; double double words

(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 (string-split sep str)
  (define (f cs xs) (cons (list->string (reverse cs)) xs))
  (let loop ((ss (string->list str)) (cs '()) (xs '()))
    (cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
          ((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
          (else (loop (cdr ss) (cons (car ss) cs) xs)))))

(define line #f)
(define number #f)

(define (cleanup str)
  (let loop ((cs (string->list str)) (zs (list)))
    (cond ((null? cs) (list->string (reverse zs)))
          ((char-alphabetic? (car cs))
            (loop (cdr cs) (cons (car cs) zs)))
          ((char-whitespace? (car cs))
            (loop (cdr cs) (cons #\space zs)))
          (else (loop (cdr cs) zs)))))

(define (read-word)
  (if (pair? line)
      (let ((word (car line)))
        (set! line (cdr line))
        word)
      (let ((input (read-line)))
        (if (eof-object? input)
            input
            (begin
              (set! line (string-split #\space (cleanup input)))
              (set! number (+ number 1))
              (read-word))))))

(define (double)
  (set! line "") (set! number 0)
  (let loop ((prev "") (word (read-word)))
    (when (not (eof-object? word))
      (when (string-ci=? prev word)
        (display number) (display " ")
        (display word) (newline))
      (loop word (read-word)))))

(double)