adjusting the javascript-implementation module to allow for requires

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?))
+
+

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]))
+         (rename-out [#%plain-module-begin #%module-begin]
+                     [my-require require]))

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))))

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))