; xref
(define (char-in-ident? c) ; scheme identifiers
(or (char-alphabetic? c) (char-numeric? c)
(member c (string->list "?!.+-*/<=>:$%^&_~@"))))
(define (get-ident)
(let loop ((c (peek-char)) (cs '()))
(cond ((eof-object? c) (if (null? cs) c (list->string (reverse cs))))
((char-in-ident? c)
(let ((x (read-char))) (loop (peek-char) (cons x cs))))
((pair? cs) (list->string (reverse cs)))
((char=? #\newline c) (read-char) "")
(else (read-char) (loop (peek-char) cs)))))
(define (xref file)
(with-input-from-file file (lambda ()
(let loop ((w (get-ident)) (line 1) (ws '()))
(cond ((eof-object? w) (xref-out ws))
((string=? "" w) (loop (get-ident) (add1 line) ws))
(else (loop (get-ident) line (cons (cons w line) ws))))))))
(define (xref-out ws)
(define (lt? a b)
(or (string<? (car a) (car b))
(and (string=? (car a) (car b))
(< (cdr a) (cdr b)))))
(let loop ((ws (sort lt? ws)) (prev-word "") (prev-line 0))
(cond ((null? ws) (newline))
((and (string=? (caar ws) prev-word) (= (cdar ws) prev-line))
(loop (cdr ws) prev-word prev-line))
((string=? (caar ws) prev-word)
(display " ") (display (cdar ws))
(loop (cdr ws) prev-word (cdar ws)))
(else (when (not (string=? prev-word "")) (newline))
(display (caar ws)) (display " ") (display (cdar ws))
(loop (cdr ws) (caar ws) (cdar ws))))))