at-exp: make language-info compose with other languages

This commit is contained in:
AlexKnauth 2015-04-22 22:17:44 -04:00 committed by Matthew Flatt
parent 2c76954108
commit a2d06c2cd5
2 changed files with 16 additions and 5 deletions

View File

@ -2,9 +2,19 @@
(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)
'(#[at-exp/lang/runtime-config configure #f])]
[else default])))
(define config-vec '#[at-exp/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

@ -29,9 +29,10 @@
(lambda (orig-read-syntax)
(define read-syntax (wrap-reader orig-read-syntax))
(lambda args
(syntax-property (apply read-syntax args)
'module-language
'#(at-exp/lang/language-info get-language-info #f))))
(define stx (apply read-syntax args))
(define old-prop (syntax-property stx 'module-language))
(define new-prop `#(at-exp/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))