diff --git a/image/private/main.rkt b/image/private/main.rkt index 5d632c3..6cd68c0 100644 --- a/image/private/main.rkt +++ b/image/private/main.rkt @@ -1,8 +1,15 @@ #lang s-exp "../../lang/js/js.rkt" +;; We need to make sure the color module has been invoked +;; before invoking this module, since the JavaScript implementation +;; depends on it. +(require "color.rkt") + (declare-implementation #:racket "racket-impl.rkt" #:javascript ("colordb.js" "kernel.js" "js-impl.js") #:provided-values (is-color?)) + + diff --git a/lang/js/js.rkt b/lang/js/js.rkt index 19905ee..34ec383 100644 --- a/lang/js/js.rkt +++ b/lang/js/js.rkt @@ -53,5 +53,27 @@ (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 ...))) + (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! this-module 'module-path) + ... + (void))) + (void)))] + [else + (raise-syntax-error #f "Expected module path" stx)])) + + + (provide declare-implementation - (rename-out [#%plain-module-begin #%module-begin])) \ No newline at end of file + (rename-out [#%plain-module-begin #%module-begin] + [my-require require])) \ No newline at end of file diff --git a/lang/js/query.rkt b/lang/js/query.rkt index f00eaa1..b3bdd48 100644 --- a/lang/js/query.rkt +++ b/lang/js/query.rkt @@ -10,7 +10,9 @@ [redirected? (path? . -> . boolean?)] [follow-redirection (path? . -> . path?)] - [collect-redirections-to (path? . -> . (listof path?))]) + [collect-redirections-to (path? . -> . (listof path?))] + + [lookup-module-requires (path? . -> . (listof module-path?))]) (define-runtime-path record.rkt "record.rkt") (define ns (make-base-empty-namespace)) @@ -59,3 +61,10 @@ (dynamic-require a-module-path (void)) ;; get the compile-time code running. ((dynamic-require-for-syntax record.rkt 'collect-redirections-to) resolved-path)))) + + +(define (lookup-module-requires a-module-path) + (let ([resolved-path (resolve-module-path a-module-path #f)]) + (parameterize ([current-namespace ns]) + (dynamic-require a-module-path (void)) ;; get the compile-time code running. + ((dynamic-require-for-syntax record.rkt 'lookup-module-requires) resolved-path)))) diff --git a/lang/js/record.rkt b/lang/js/record.rkt index 1c9ac71..55107b1 100644 --- a/lang/js/record.rkt +++ b/lang/js/record.rkt @@ -9,7 +9,11 @@ #;record-exported-name! - collect-redirections-to) + collect-redirections-to + + record-module-require! + lookup-module-requires + ) (define-struct record (path impl)) @@ -18,6 +22,12 @@ (define-struct redirection (from to)) (define redirections '()) + + +(define-struct module-require (key path)) +(define module-requires '()) + + ;; record-javascript-implementation!: path string -> void (define (record-javascript-implementation! a-path an-impl) (set! records (cons (make-record a-path an-impl) @@ -66,6 +76,27 @@ (loop (cdr redirections))]))) + +(define (record-module-require! key path) + (set! module-requires + (cons (make-module-require key path) + module-requires))) + + +(define (lookup-module-requires key) + (let loop ([requires module-requires]) + (cond + [(null? requires) + '()] + [(equal? (module-require-key (car requires)) + key) + (cons (module-require-path (car requires)) + (loop (cdr requires)))] + [else + (loop (cdr requires))]))) + + + #;(define (record-exported-name! a-path internal-name external-name) (printf "I need to remember to export ~s as ~s\n" internal-name external-name) (void))