suzanne.soy/debug
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

get rid of the let + local-require noise in output

Browse Source 
fixes https://github.com/AlexKnauth/debug/issues/4
This commit is contained in:
AlexKnauth 2016-01-02 12:20:12 -05:00
parent 20c9dd460c
commit 7262d3a463
2 changed files with 71 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
debug/lang/reader.rkt
View File

@ -40,10 +40,29 @@
stx)))
rd)
;; current-syntax-introducer : (Parameterof [Syntax -> Syntax])
(define current-syntax-introducer
(make-parameter (λ (x) x)))
;; current-intro-id-syntax : (Parameterof (U #false Syntax))
;; A value of #false means that it is not nested within another debug expression
;; A syntax object means that it is nested within another debug expression,
;; where the macros are already bound, and it should use `datum->syntax` with
;; the syntax object value as the lexical context context.
(define current-intro-id-syntax
(make-parameter #false))
;; maybe-add-let
(define (maybe-add-local-require ctxt debug-expr)
(define/with-syntax expr debug-expr)
(cond [(current-intro-id-syntax)
#'expr]
[else
(define/with-syntax debug/report (datum->syntax ctxt 'debug/report))
#'(let ()
(local-require debug/report)
expr)]))
(define (report-proc c in src ln col pos)
(define c2 (peek-char in))
@ -54,50 +73,68 @@
(read-char in)
(read-char in)
(read-char in)
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report/file (datum->syntax #'ctxt 'report/file))
(define/with-syntax name (intro (read-syntax/recursive src in)))
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report/file report/file]))
(report/file stx name)))]
(maybe-add-local-require #'ctxt
#'(report/file stx name)))]
[(and (char=? c2 report-char) (char=? c3 name-char))
(read-char in)
(read-char in)
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report/line (datum->syntax #'ctxt 'report/line))
(define/with-syntax name (intro (read-syntax/recursive src in)))
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report/line report/line]))
(report/line stx name)))]
(maybe-add-local-require #'ctxt
#'(report/line stx name)))]
[(char=? c2 name-char)
(read-char in)
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report (datum->syntax #'ctxt 'report))
(define/with-syntax name (intro (read-syntax/recursive src in)))
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report report]))
(report stx name)))]
(maybe-add-local-require #'ctxt
#'(report stx name)))]
[(and (char=? c3 report-char) (char=? c2 report-char))
(read-char in)
(read-char in)
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report/file (datum->syntax #'ctxt 'report/file))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report/file report/file]))
(report/file stx)))]
(maybe-add-local-require #'ctxt
#'(report/file stx)))]
[(char=? c2 report-char)
(read-char in)
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report/line (datum->syntax #'ctxt 'report/line))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report/line report/line]))
(report/line stx)))]
(maybe-add-local-require #'ctxt
#'(report/line stx)))]
[else
(define/with-syntax stx (intro (read-syntax/recursive src in)))
(define/with-syntax ctxt (or (current-intro-id-syntax) #'here))
(define/with-syntax report (datum->syntax #'ctxt 'report))
(define/with-syntax stx
(parameterize ([current-intro-id-syntax #'ctxt])
(intro (read-syntax/recursive src in))))
(intro
#'(let ()
(local-require (only-in debug/report [report report]))
(report stx)))]))
(maybe-add-local-require #'ctxt
#'(report stx)))]))
(define-values (debug-read debug-read-syntax debug-get-info)

11
debug/test/test.rkt
View File

@ -1,6 +1,6 @@
#lang debug racket/base
;; from mbutterick/sugar, sugar/test/debug-meta-lang.rkt
;; originally from mbutterick/sugar, sugar/test/debug-meta-lang.rkt
;; https://github.com/mbutterick/sugar/blob/0ffe3173879cef51d29b4c91a336a4de6c3f8ef8/sugar/test/debug-meta-lang.rkt
(require rackunit
@ -27,10 +27,17 @@
#RRN x 5)
(check-equal? (get-output-string out) "5 = 5 on line 26\nx = 5 on line 27\n"))
(let ([out (open-output-string)])
(parameterize ([current-error-port out])
#RR (+ 1 2 #R 5
#RN x (* 1 2 3)))
(check-equal? (get-output-string out)
"5 = 5\nx = 6\n(+ 1 2 (report 5) (report (* 1 2 3) x)) = 14 on line 32\n"))
(begin-for-syntax
(begin-for-syntax
(begin-for-syntax
(let ([out (open-output-string)])
(parameterize ([current-error-port out])
#RR5)
(check-equal? (get-output-string out) "5 = 5 on line 35\n")))))
(check-equal? (get-output-string out) "5 = 5 on line 42\n")))))