[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/tlMUNdCS    [ raw code | fork ]

programmingpraxis - Scheme, pasted on Mar 31:
; 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))))))


Output:
No errors or program output.


Create a new paste based on this one


Comments: