suzanne.soy/aful
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make language-info compose nicely

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
afl/lang/language-info.rkt
View File

@ -2,9 +2,20 @@
(provide get-language-info) (provide get-language-info)
(require racket/match)
(define (get-language-info data) (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) (lambda (key default)
(case key (case key
[(configure-runtime) [(configure-runtime)
'(#[afl/lang/runtime-config configure #f])] (define config-vec '#[afl/lang/runtime-config configure #f])
[else default]))) (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)])))

7
afl/lang/reader.rkt
View File

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

7
afl/lang/runtime-config.rkt
View File

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

5
afl/reader.rkt
View File

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