mbutterick
/
sugar
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

correction

Browse Source
dev-refac-2020
Matthew Butterick 7 years ago
parent f79077aec9
commit cae71f0b11
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File

24
sugar/debug.rkt
Unescape Escape View File

@ -100,7 +100,15 @@
(make-meta-reader (make-meta-reader
'sugar/debug 'sugar/debug
"language path" "language path"
lang-reader-module-paths (λ (bstr) ; copy of `lang-reader-module-paths`, only available since 6.7
(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
wrap-reader wrap-reader
(λ (proc) (λ (proc)
@ -118,10 +126,10 @@
(define (report-proc trigger-char ip src ln col pos) (define (report-proc trigger-char ip src ln col pos)
(define flip-metalang-scope (current-metalang-scope-flipper)) (define flip-metalang-scope (current-metalang-scope-flipper))
(flip-metalang-scope (with-syntax ([REPORT-ID (cond (flip-metalang-scope (with-syntax ([REPORT-ID (cond
[(not (another-report-char? ip)) 'report] ; #R... [(not (another-report-char? ip)) 'report] ; #R...
[(not (another-report-char? ip)) 'report/line] ; #RR... [(not (another-report-char? ip)) 'report/line] ; #RR...
[else 'report/file])] ; #RRR... [else 'report/file])] ; #RRR...
[STX (flip-metalang-scope (read-syntax/recursive src ip))]) [STX (flip-metalang-scope (read-syntax/recursive src ip))])
#'(let () #'(let ()
(local-require (only-in sugar/debug REPORT-ID)) (local-require (only-in sugar/debug REPORT-ID))
(REPORT-ID STX)))))) (REPORT-ID STX))))))

Write Preview
Loading…
Cancel
Save