trying to add a hook into the maker to deal with js-implemented modules.

js-assembler/package.rkt

@@ -48,12 +48,12 @@
      should-follow?
 
      ;; on
-     (lambda (ast stmts)
+     (lambda (src ast stmts)
        (assemble/write-invoke stmts op)
        (fprintf op "(MACHINE, function() { "))
 
      ;; after
-     (lambda (ast stmts)
+     (lambda (src ast stmts)
        (fprintf op " }, FAIL, PARAMS);"))
 
      ;; last
@@ -96,7 +96,7 @@ EOF
 (define (get-code source-code)
   (let ([buffer (open-output-string)])
     (package source-code
-             #:should-follow? (lambda (p) #t)
+             #:should-follow? (lambda (src p) #t)
              #:output-port buffer)
     (get-output-string buffer)))
 

make-structs.rkt

@@ -34,11 +34,13 @@
 
 
 (define-struct: Configuration
-  ([should-follow? : (Path -> Boolean)]
-   [on-module-statements : ((U Expression #f)
+  ([should-follow? : (Source Path -> Boolean)]
+   [on-module-statements : (Source
+                            (U Expression #f)
                             (Listof Statement)
                             -> Void)]
-   [after-module-statements : ((U Expression #f)
+   [after-module-statements : (Source
+                               (U Expression #f)
                                (Listof Statement)
                                -> Void)]
    [after-last : (-> Void)])
@@ -46,12 +48,12 @@
 
 (define debug-configuration
   (make-Configuration
-   (lambda (p) #t)
-   (lambda (ast stmt)
+   (lambda (src p) #t)
+   (lambda (src ast stmt)
      (when (and ast (expression-module-path ast))
        (printf "debug build configuration: visiting ~s\n"
                (expression-module-path ast))))
-   (lambda (ast stmt)
+   (lambda (src ast stmt)
      (void))
    (lambda ()
      (void))))

make.rkt

@@ -22,9 +22,18 @@
 
 
 (provide make
+         current-module-source-compiling-hook
          get-ast-and-statements)
 
 
+(: current-module-source-compiling-hook
+   (Parameterof (Source -> Source)))
+(define current-module-source-compiling-hook
+  (make-parameter (lambda: ([s : Source]) s)))
+
+
+
+
 
 (: get-ast-and-statements (Source -> (values (U False Expression)
                                              (Listof Statement))))
@@ -100,11 +109,11 @@
          (define visited ((inst make-hash Any Boolean)))
 
          (: collect-new-dependencies
-            ((U False Expression) (Listof Source) -> (Listof Source)))
-         (define (collect-new-dependencies ast sources)
+            (Source (U False Expression) -> (Listof Source)))
+         (define (collect-new-dependencies this-source ast)
            (cond
             [(eq? ast #f)
-             sources]
+             empty]
             [else
              (let* ([dependent-module-names (get-dependencies ast)]
                     [paths
@@ -116,14 +125,14 @@
                                                mp)
                                               acc]
                                              [(and (path? rp)
-                                                   (should-follow? rp)
+                                                   (should-follow? this-source rp)
                                                    (cons (make-ModuleSource rp)
                                                          acc))]
                                              [else
                                               acc])))
                             '()
                             dependent-module-names)])
-               (append paths sources))]))
+               paths)]))
          
          (let: loop : Void ([sources : (Listof Source) sources])
            (cond
@@ -133,11 +142,15 @@
              (loop (rest sources))]
             [else
              (hash-set! visited (first sources) #t)
-             (let-values ([(ast stmts)
-                           (get-ast-and-statements (first sources))])
-               (on-module-statements ast stmts)
-               (loop (collect-new-dependencies ast (rest sources)))
-               (after-module-statements ast stmts))])))
+             (let*-values ([(this-source)
+                             ((current-module-source-compiling-hook)
+                              (first sources))]
+                           [(ast stmts)
+                            (get-ast-and-statements this-source)])
+               (on-module-statements this-source ast stmts)
+               (loop (append (collect-new-dependencies this-source ast)
+                             (rest sources)))
+               (after-module-statements this-source ast stmts))])))
 
        (follow-dependencies sources)])))
 

parameters.rkt

@@ -48,6 +48,9 @@
 
 
 
+
+
+
 ;;; Do not touch the following parameters: they're used internally by package
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;