From 65467b72b4e66299b880ca60fde35dfa5ec98d4d Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Sun, 26 Jul 2015 00:33:34 -0400 Subject: [PATCH] debug-meta-lang: make (require sugar/debug) unnecessary and make it hygienic --- sugar/debug/reader.rkt | 28 ++++++++++++++++++++-------- sugar/test/debug-meta-lang.rkt | 13 +++++++++---- 2 files changed, 29 insertions(+), 12 deletions(-) diff --git a/sugar/debug/reader.rkt b/sugar/debug/reader.rkt index 4e0f70e..5675652 100644 --- a/sugar/debug/reader.rkt +++ b/sugar/debug/reader.rkt @@ -9,22 +9,34 @@ #\^ 'dispatch-macro report-proc )) -(define/with-syntax report (datum->syntax #f 'report)) -(define/with-syntax report/line (datum->syntax #f 'report/line)) +(define current-syntax-introducer + (make-parameter (λ (x) x))) (define (report-proc c in src ln col pos) (define c2 (peek-char in)) + (define intro (current-syntax-introducer)) (cond [(char=? c2 #\^) (read-char in) - (define stx (read-syntax/recursive src in)) - #`(report/line #,stx)] + (define/with-syntax stx (intro (read-syntax/recursive src in))) + (intro + #'(let () + (local-require (only-in sugar/debug [report/line report/line])) + (report/line stx)))] [else - (define stx (read-syntax/recursive src in)) - #`(report #,stx)])) + (define/with-syntax stx (intro (read-syntax/recursive src in))) + (intro + #'(let () + (local-require (only-in sugar/debug [report report])) + (report stx)))])) (define (wrap-reader reader) (define (rd . args) - (parameterize ([current-readtable (make-debug-readtable (current-readtable))]) - (apply reader args))) + (define intro (make-syntax-introducer)) + (parameterize ([current-readtable (make-debug-readtable (current-readtable))] + [current-syntax-introducer intro]) + (define stx (apply reader args)) + (if (syntax? stx) + (intro stx) + stx))) rd) diff --git a/sugar/test/debug-meta-lang.rkt b/sugar/test/debug-meta-lang.rkt index 833039f..30bdf1c 100644 --- a/sugar/test/debug-meta-lang.rkt +++ b/sugar/test/debug-meta-lang.rkt @@ -1,10 +1,15 @@ #lang sugar/debug/lang racket -(require sugar/debug rackunit) -(let ([out (open-output-string)]) +(require rackunit) +(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]) #^5) (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]) #^^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")) -- 2.25.1