(module xref racket
(define (get-lines file)
(call-with-input-file file
(lambda (in)
(let loop ([str (read-line in)])
(if (eof-object? str)
empty
(cons str (loop (read-line in))))))))
(define (parse stx)
(syntax-case stx ()
[id (identifier? #'id) (cons #'id empty)]
[(e1 e2 ...) (apply append (map parse (syntax->list #'(e1 e2 ...))))]
[else empty]))
(define (pos->line lines pos)
(define (check-lines lines current-pos)
(cond
[(empty? lines) (error 'oops)]
[(<= pos (+ current-pos (string-length (first lines)))) 1]
[else (+ 1 (check-lines (rest lines) (+ current-pos 1 (string-length (first lines)))))]))
(check-lines lines 0))
(define (get-refs file)
(define lines (get-lines file))
(call-with-input-file file
(lambda (in)
(let ([ids (parse (read-syntax file in))])
(let ([hash (make-hash)])
(for-each
(lambda (id)
(with-syntax ([idc id])
(let ([sym (syntax->datum #''idc)]
[line (pos->line lines (syntax-position id))])
(hash-set! hash sym (cons line (hash-ref hash sym empty))))))
ids)
(hash-map hash cons))))))
(get-refs "xref.rkt")
)
;;sample run :
;'(('pos 23 19)
; ('hash-ref 41)
; ('<= 23)
; ('empty? 22)
; ('parse 34 16 12)
; ('current-pos 24 23 20)
; ('id 40 38 37 15 15 15)
; ('get-lines 30 3)
; ('with-syntax 38)
; ('e2 16 16)
; ('syntax->list 16)
; ('let 39 35 34 6)
; ('first 24 23)
; ('syntax 39 16 15 15)
; ('sym 41 41 39)
; ('quote 39 22)
; ('cond 21)
; ('lambda 37 33 5)
; ('read-line 9 6)
; ('in 34 33 9 6 5)
; ('e1 16 16)
; ('for-each 36)
; ('stx 14 12)
; ('... 16 16)
; ('define 30 28 20 19 12 3)
; ('read-syntax 34)
; ('append 16)
; ('idc 39 38)
; ('if 7)
; ('rest 24)
; ('+ 24 24 23)
; ('map 16)
; ('file 34 32 30 28 4 3)
; ('identifier? 15)
; ('hash-set! 41)
; ('pos->line 40 19)
; ('syntax-case 14)
; ('string-length 24 23)
; ('hash-map 43)
; ('module 1)
; ('str 9 7 6)
; ('lines 40 30 25 24 24 23 22 20 19)
; ('line 41 40)
; ('make-hash 35)
; ('syntax-position 40)
; ('racket 1)
; ('hash 43 41 41 35)
; ('get-refs 45 28)
; ('oops 22)
; ('eof-object? 7)
; ('apply 16)
; ('call-with-input-file 32 4)
; ('loop 9 6)
; ('else 24 17)
; ('syntax->datum 39)
; ('cons 43 41 15 9)
; ('empty 41 17 15 8)
; ('error 22)
; ('xref 1)
; ('check-lines 25 24 20)
; ('ids 42 34))