at-exp: make language-info compose with other languages
This commit is contained in:
parent
2c76954108
commit
a2d06c2cd5
|
@ -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)])))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user