shift some stuff
parent
c5709286b6
commit
90baf7868d
@ -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