codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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-word) (add1 line) ws)) (else (loop (get-word) 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))))))
Private
[
?
]
Run code
Submit