; 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)