diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index e289a65..3699cd8 100644 --- a/js-assembler/package.rkt +++ b/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))) diff --git a/make-structs.rkt b/make-structs.rkt index 90ec2d5..fa765e1 100644 --- a/make-structs.rkt +++ b/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)))) diff --git a/make.rkt b/make.rkt index 858f71b..973a4b0 100644 --- a/make.rkt +++ b/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)]))) diff --git a/parameters.rkt b/parameters.rkt index 0ca9997..bc141d4 100644 --- a/parameters.rkt +++ b/parameters.rkt @@ -48,6 +48,9 @@ + + + ;;; Do not touch the following parameters: they're used internally by package ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;