(module module-reader scheme/base
(provide
(rename-out
[provide-module-reader #%module-begin]
[wrap wrap-read-all]))
(require
scheme/runtime-path
"../tools.ss"
"lexer.ss")
(define-syntax provide-module-reader
(syntax-rules ()
[(_ lib)
(#%module-begin
(#%provide (rename *read read)
(rename *read-syntax read-syntax))
(define (*read in)
(wrap 'lib in read-forth))
(define (*read-syntax src in)
(wrap 'lib in (lambda (in)
(read-forth-syntax src in)))))]))
(define-runtime-path _staapl "..")
(define staapl (path->string (simplify-path _staapl)))
(define (wrap lib port read)
(let ([lib-path
(format "~a~a" staapl lib)]
[body
(let loop ([a null])
(let ([v (read port)])
(if (eof-object? v)
(reverse a)
(loop (cons v a)))))])
(let* ([p-name (object-name port)]
[name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)])
(string->symbol (path->string (path-replace-suffix name #""))))
'page)])
`(module ,name (file ,lib-path)
. ,body)))))