make language-info compose nicely

This commit is contained in:
AlexKnauth 2015-04-22 18:46:03 -04:00
parent d0029ed1f5
commit a93f583fc4
4 changed files with 22 additions and 12 deletions

View File

@ -2,9 +2,20 @@
(provide get-language-info)
(require racket/match)
(define (get-language-info data)
(define other-get-info
(match data
[(vector mod sym data2)
((dynamic-require mod sym) data2)]
[_ (lambda (key default) default)]))
(lambda (key default)
(case key
[(configure-runtime)
'(#[afl/lang/runtime-config configure #f])]
[else default])))
(define config-vec '#[afl/lang/runtime-config configure #f])
(define other-config (other-get-info key default))
(cond [(list? other-config) (cons config-vec other-config)]
[else (list config-vec)])]
[else (other-get-info key default)])))

View File

@ -23,9 +23,10 @@
(lambda (orig-read-syntax)
(define read-syntax (wrap-reader orig-read-syntax))
(lambda args
(syntax-property (apply read-syntax args)
'module-language
'#(afl/lang/language-info get-language-info #f))))
(define stx (apply read-syntax args))
(define old-prop (syntax-property stx 'module-language))
(define new-prop `#(afl/lang/language-info get-language-info ,old-prop))
(syntax-property stx 'module-language new-prop)))
(lambda (proc)
(lambda (key defval)
(define (fallback) (if proc (proc key defval) defval))

View File

@ -5,8 +5,5 @@
(require (only-in afl/reader make-afl-readtable))
(define (configure data)
(define old-read (current-read-interaction))
(define (new-read src in)
(parameterize ([current-readtable (make-afl-readtable (current-readtable))])
(old-read src in)))
(current-read-interaction new-read))
(current-readtable (make-afl-readtable)))

View File

@ -121,9 +121,10 @@
[%1 (string->id stx* arg-str "1")]
[body stx*])
(intro
#'(lambda args
(syntax/loc stx
(lambda args
(define-syntax % (make-rename-transformer #'%1))
body)))))
body))))))
(module+ test
;; These test `parse`. See test.rkt for tests of readtable use per se.