reader.rkt (1990B)
1 #lang racket 2 3 (provide (rename-out [repltest-read read] 4 [repltest-read-syntax read-syntax] 5 [repltest-get-info get-info])) 6 7 (require (for-template repltest/private/run-interactions) 8 racket/syntax 9 repltest/private/util 10 (only-in syntax/module-reader make-meta-reader) 11 syntax/strip-context) 12 13 (define ((wrap-reader reader) chr in src line col pos) 14 (define/with-syntax orig-mod 15 (reader chr (narrow-until-prompt in) src line col pos)) 16 17 (define/with-syntax (mod nam lang (modbeg . body)) 18 (eval-syntax (syntax/loc #'orig-mod (expand #'orig-mod)) 19 (variable-reference->namespace (#%variable-reference))) 20 #;(parameterize ([current-namespace (variable-reference->namespace 21 (#%variable-reference))]) 22 (expand #'orig-mod))) 23 24 ;; quasisyntax/loc Necessary so that the generated code has the correct srcloc 25 (quasisyntax/loc #'mod 26 (mod nam lang 27 (modbeg 28 (module* test racket/base 29 (require repltest/private/run-interactions) 30 ;; TODO: set-port-next-location! for (open-input-string …) 31 (run-interactions (open-input-string #,(port->string in)) 32 (#%variable-reference))) 33 . body)))) 34 35 (define-values (repltest-read repltest-read-syntax repltest-get-info) 36 (make-meta-reader 37 'repltest 38 "language path" 39 (lambda (bstr) 40 (let* ([str (bytes->string/latin-1 bstr)] 41 [sym (string->symbol str)]) 42 (and (module-path? sym) 43 (vector 44 ;; try submod first: 45 `(submod ,sym reader) 46 ;; fall back to /lang/reader: 47 (string->symbol (string-append str "/lang/reader")))))) 48 (λ (read) read) 49 wrap-reader;wrap-read-syntax 50 (lambda (proc) 51 (lambda (key defval) 52 (define (fallback) (if proc (proc key defval) defval)) 53 (case key 54 [else (fallback)])))))