Compare commits
1 Commits
master
...
dev-debug-
Author | SHA1 | Date |
---|---|---|
Matthew Butterick | 90baf7868d | 10 years ago |
@ -1,28 +0,0 @@
|
|||||||
(module reader racket/base
|
|
||||||
(require syntax/module-reader
|
|
||||||
(only-in "../../reader.rkt" make-debug-readtable wrap-reader))
|
|
||||||
|
|
||||||
(provide (rename-out [debug-read read]
|
|
||||||
[debug-read-syntax read-syntax]
|
|
||||||
[debug-get-info get-info]))
|
|
||||||
|
|
||||||
(define-values (debug-read debug-read-syntax debug-get-info)
|
|
||||||
(make-meta-reader
|
|
||||||
'sugar/debug/lang
|
|
||||||
"language path"
|
|
||||||
(lambda (bstr)
|
|
||||||
(let* ([str (bytes->string/latin-1 bstr)]
|
|
||||||
[sym (string->symbol str)])
|
|
||||||
(and (module-path? sym)
|
|
||||||
(vector
|
|
||||||
;; try submod first:
|
|
||||||
`(submod ,sym reader)
|
|
||||||
;; fall back to /lang/reader:
|
|
||||||
(string->symbol (string-append str "/lang/reader"))))))
|
|
||||||
wrap-reader
|
|
||||||
wrap-reader
|
|
||||||
(lambda (proc)
|
|
||||||
(lambda (key defval)
|
|
||||||
(define (fallback) (if proc (proc key defval) defval))
|
|
||||||
(case key
|
|
||||||
[else (fallback)]))))))
|
|
@ -1,30 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(provide make-debug-readtable wrap-reader)
|
|
||||||
|
|
||||||
(require racket/syntax)
|
|
||||||
|
|
||||||
(define (make-debug-readtable [rt (current-readtable)])
|
|
||||||
(make-readtable rt
|
|
||||||
#\^ 'dispatch-macro report-proc
|
|
||||||
))
|
|
||||||
|
|
||||||
(define/with-syntax report (datum->syntax #f 'report))
|
|
||||||
(define/with-syntax report/line (datum->syntax #f 'report/line))
|
|
||||||
|
|
||||||
(define (report-proc c in src ln col pos)
|
|
||||||
(define c2 (peek-char in))
|
|
||||||
(cond [(char=? c2 #\^)
|
|
||||||
(read-char in)
|
|
||||||
(define stx (read-syntax/recursive src in))
|
|
||||||
#`(report/line #,stx)]
|
|
||||||
[else
|
|
||||||
(define stx (read-syntax/recursive src in))
|
|
||||||
#`(report #,stx)]))
|
|
||||||
|
|
||||||
(define (wrap-reader reader)
|
|
||||||
(define (rd . args)
|
|
||||||
(parameterize ([current-readtable (make-debug-readtable (current-readtable))])
|
|
||||||
(apply reader args)))
|
|
||||||
rd)
|
|
||||||
|
|
Loading…
Reference in New Issue