debug-meta-lang: make (require sugar/debug) unnecessary #6

Merged
AlexKnauth merged 1 commits from debug-meta-lang into master 9 years ago

@ -9,22 +9,34 @@
#\^ 'dispatch-macro report-proc #\^ 'dispatch-macro report-proc
)) ))
(define/with-syntax report (datum->syntax #f 'report)) (define current-syntax-introducer
(define/with-syntax report/line (datum->syntax #f 'report/line)) (make-parameter (λ (x) x)))
(define (report-proc c in src ln col pos) (define (report-proc c in src ln col pos)
(define c2 (peek-char in)) (define c2 (peek-char in))
(define intro (current-syntax-introducer))
(cond [(char=? c2 #\^) (cond [(char=? c2 #\^)
(read-char in) (read-char in)
(define stx (read-syntax/recursive src in)) (define/with-syntax stx (intro (read-syntax/recursive src in)))
#`(report/line #,stx)] (intro
#'(let ()
(local-require (only-in sugar/debug [report/line report/line]))
(report/line stx)))]
[else [else
(define stx (read-syntax/recursive src in)) (define/with-syntax stx (intro (read-syntax/recursive src in)))
#`(report #,stx)])) (intro
#'(let ()
(local-require (only-in sugar/debug [report report]))
(report stx)))]))
(define (wrap-reader reader) (define (wrap-reader reader)
(define (rd . args) (define (rd . args)
(parameterize ([current-readtable (make-debug-readtable (current-readtable))]) (define intro (make-syntax-introducer))
(apply reader args))) (parameterize ([current-readtable (make-debug-readtable (current-readtable))]
[current-syntax-introducer intro])
(define stx (apply reader args))
(if (syntax? stx)
(intro stx)
stx)))
rd) rd)

@ -1,10 +1,15 @@
#lang sugar/debug/lang racket #lang sugar/debug/lang racket
(require sugar/debug rackunit) (require rackunit)
(let ([out (open-output-string)]) (let ([out (open-output-string)]
[let "something else"]
[local-require "something else entirely"]
[only-in "completely unexpected!"]
[report "well, not really"])
(parameterize ([current-error-port out]) (parameterize ([current-error-port out])
#^5) #^5)
(check-equal? (get-output-string out) "5 = 5\n")) (check-equal? (get-output-string out) "5 = 5\n"))
(let ([out (open-output-string)]) (let ([out (open-output-string)]
[report/line "outta the blue!"])
(parameterize ([current-error-port out]) (parameterize ([current-error-port out])
#^^5) #^^5)
(check-equal? (get-output-string out) "5 = 5 on line 9\n")) (check-equal? (get-output-string out) "5 = 5 on line 14\n"))

Loading…
Cancel
Save