#lang scheme/base
(require (for-syntax racket/base
racket/file
racket/string
syntax/parse
syntax/modresolve
"record.rkt"))
(define-for-syntax (my-resolve-path a-module-path)
(parameterize ([current-directory (or (current-load-relative-directory)
(current-directory))])
(resolve-module-path a-module-path #f)))
(define-for-syntax (resolve-implementation-path a-module-path)
(let ([a-path (my-resolve-path a-module-path)])
(path->string a-path)))
(define-syntax (declare-implementation stx)
(syntax-parse stx
[(_ #:racket racket-module-name
#:javascript (javascript-module-name ...)
#:provided-values (provided-name ...))
(with-syntax
([resolved-racket-module-name
(my-resolve-path (syntax-e #'racket-module-name))]
[impl
(map (compose resolve-implementation-path syntax-e)
(syntax->list #'(javascript-module-name ...)))]
[(internal-name ...) (generate-temporaries #'(provided-name ...))]
[(set-internal-name! ...) (generate-temporaries #'(provided-name ...))])
(syntax/loc stx
(begin
(begin-for-syntax
(let* ([this-module
(variable-reference->resolved-module-path
(#%variable-reference))]
[key (resolved-module-path-name this-module)])
(record-redirection! (#%datum . resolved-racket-module-name)
key)
(record-javascript-implementation! key (#%datum . impl))
))
(require racket-module-name)
(begin
(define internal-name provided-name)
(define (set-internal-name! x)
(set! internal-name x)))
...
(provide (rename-out [internal-name provided-name] ...)))))]))
(define-syntax (my-require stx)
(syntax-case stx ()
[(_ module-path ...)
(andmap (lambda (p) (module-path? (syntax-e p)))
(syntax->list #'(module-path ...)))
(with-syntax ([(required-path ...)
(map (lambda (p)
(my-resolve-path (syntax-e p)))
(syntax->list #'(module-path ...)))])
(syntax/loc stx
(begin
(begin-for-syntax
(let* ([this-module
(variable-reference->resolved-module-path
(#%variable-reference))]
[key (resolved-module-path-name this-module)])
(record-module-require! key 'required-path)
...
(void)))
(void))))]
[else
(raise-syntax-error #f "Expected module path" stx)]))
(provide declare-implementation
(rename-out [#%plain-module-begin #%module-begin]
[my-require require]))