diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt index a75598f..03ac792 100644 --- a/js-assembler/package.rkt +++ b/js-assembler/package.rkt @@ -38,6 +38,9 @@ +(define (wrap-source src) + src) + ;; package: Source (path -> boolean) output-port -> void @@ -55,7 +58,8 @@ #:output-port op) (define packaging-configuration (make-Configuration - + wrap-source + should-follow? ;; on @@ -95,8 +99,11 @@ (define (write-runtime op) (let ([packaging-configuration (make-Configuration + + wrap-source + ;; should-follow-children? - (lambda (src p) #t) + (lambda (src) #t) ;; on (lambda (src ast stmts) (assemble/write-invoke stmts op) @@ -160,7 +167,7 @@ EOF (define (get-code source-code) (let ([buffer (open-output-string)]) (package source-code - #:should-follow-children? (lambda (src p) #t) + #:should-follow-children? (lambda (src) #t) #:output-port buffer) (compress (get-output-string buffer)))) @@ -178,7 +185,7 @@ EOF ;; write-standalone-code: source output-port -> void (define (write-standalone-code source-code op) (package-anonymous source-code - #:should-follow-children? (lambda (src p) #t) + #:should-follow-children? (lambda (src) #t) #:output-port op) (fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n")) diff --git a/make/make-structs.rkt b/make/make-structs.rkt index 5ee23f3..f4b6c98 100644 --- a/make/make-structs.rkt +++ b/make/make-structs.rkt @@ -13,7 +13,8 @@ (define-type Source (U StatementsSource MainModuleSource ModuleSource - SexpSource)) + SexpSource + UninterpretedSource)) (define-struct: StatementsSource ([stmts : (Listof Statement)]) #:transparent) @@ -23,10 +24,14 @@ #:transparent) (define-struct: SexpSource ([sexp : Any]) #:transparent) +(define-struct: UninterpretedSource ([datum : Any]) + #:transparent) + (define-struct: Configuration - ([should-follow-children? : (Source Path -> Boolean)] + ([wrap-source : (Source -> Source)] + [should-follow-children? : (Source -> Boolean)] [on-module-statements : (Source (U Expression #f) (Listof Statement) @@ -40,7 +45,8 @@ (define debug-configuration (make-Configuration - (lambda (src p) #t) + (lambda (src) src) + (lambda (src) #t) (lambda (src ast stmt) (when (and ast (expression-module-path ast)) (printf "debug build configuration: visiting ~s\n" diff --git a/make/make.rkt b/make/make.rkt index 178d4ea..400f47a 100644 --- a/make/make.rkt +++ b/make/make.rkt @@ -41,6 +41,9 @@ [(StatementsSource? a-source) (values #f (StatementsSource-stmts a-source))] + [(UninterpretedSource? a-source) + (values #f '())] + [(MainModuleSource? a-source) (let-values ([(ast stmts) (get-ast-and-statements (MainModuleSource-source a-source))]) @@ -96,7 +99,8 @@ ((inst new-seteq Symbol))]) (match config - [(struct Configuration (should-follow-children? + [(struct Configuration (wrap-source + should-follow-children? on-module-statements after-module-statements after-last)) @@ -112,6 +116,8 @@ (cond [(eq? ast #f) empty] + #;[(not (should-follow-children? this-source)) + empty] [else ;; FIXME: the logic here is wrong. ;; Needs to check should-follow-children before continuing here. @@ -120,14 +126,11 @@ (foldl (lambda: ([mp : ModuleLocator] [acc : (Listof Source)]) (let ([rp [ModuleLocator-real-path mp]]) - (cond [((current-kernel-module-locator?) mp) acc] - [(and (path? rp) - (should-follow-children? this-source rp) - (cons (make-ModuleSource rp) - acc))] + [(path? rp) + (cons (make-ModuleSource rp) acc)] [else acc]))) '() @@ -148,9 +151,9 @@ [(ast stmts) (get-ast-and-statements this-source)]) (on-module-statements this-source ast stmts) - (loop (append (collect-new-dependencies this-source ast) + (loop (append (map wrap-source (collect-new-dependencies this-source ast)) (rest sources))) (after-module-statements this-source ast stmts))]))) - (follow-dependencies sources)]))) + (follow-dependencies (map wrap-source sources))])))