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

use #lang lang-extension

Browse Source
This commit is contained in:
AlexKnauth 2016-06-30 19:09:32 -04:00
parent 0d9eec9d92
commit 69f75c0679
1 changed files with 18 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
afl/lang/reader.rkt
View File

@ -1,42 +1,18 @@
(module reader racket/base #lang lang-extension
(require syntax/module-reader #:lang-extension afl make-afl-lang-reader
#:lang-reader afl-lang
(require lang-reader/lang-reader
(only-in "../reader.rkt" wrap-reader)) (only-in "../reader.rkt" wrap-reader))
(provide (rename-out [afl-read read] (define (make-afl-lang-reader lang-reader)
[afl-read-syntax read-syntax] (define/lang-reader [-read -read-syntax -get-info] lang-reader)
[afl-get-info get-info])) (make-lang-reader
(wrap-reader -read)
(define-values (afl-read afl-read-syntax afl-get-info) (let ([read-syntax (wrap-reader -read-syntax)])
(make-meta-reader
'afl
"language path"
(lambda (bstr)
(let* ([str (bytes->string/latin-1 bstr)]
[sym (string->symbol str)])
(and (module-path? sym)
(vector
;; try submod first:
`(submod ,sym reader)
;; fall back to /lang/reader:
(string->symbol (string-append str "/lang/reader"))))))
wrap-reader
(lambda (orig-read-syntax)
(define read-syntax (wrap-reader orig-read-syntax))
(lambda args (lambda args
(define stx (apply read-syntax args)) (define stx (apply read-syntax args))
(define old-prop (syntax-property stx 'module-language)) (define old-prop (syntax-property stx 'module-language))
(define new-prop `#(afl/lang/language-info get-language-info ,old-prop)) (define new-prop `#(afl/lang/language-info get-language-info ,old-prop))
(syntax-property stx 'module-language new-prop))) (syntax-property stx 'module-language new-prop)))
(lambda (proc) -get-info))
(lambda (key defval)
(define (fallback) (if proc (proc key defval) defval))
(define (try-dynamic-require mod export)
(or (with-handlers ([exn:fail? (λ (x) #f)])
(dynamic-require mod export))
(fallback)))
(case key
[(color-lexer)
(try-dynamic-require 'syntax-color/scribble-lexer 'scribble-lexer)]
[(definitions-text-surrogate)
'scribble/private/indentation]
[else (fallback)]))))))