From 75ad94421de837ab1ba248458d6008ff8917c792 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 22 Feb 2013 15:58:53 -0700 Subject: [PATCH] still working on the dynamic module loading. --- whalesong/js-assembler/package.rkt | 55 +++++++++++++++---- whalesong/js-assembler/runtime-src/runtime.js | 1 + whalesong/make/make-structs.rkt | 2 +- whalesong/whalesong-helpers.rkt | 37 +++++++++++-- 4 files changed, 77 insertions(+), 18 deletions(-) diff --git a/whalesong/js-assembler/package.rkt b/whalesong/js-assembler/package.rkt index 5d636a4..9e402bc 100644 --- a/whalesong/js-assembler/package.rkt +++ b/whalesong/js-assembler/package.rkt @@ -258,6 +258,25 @@ M.modules[~s] = (error 'get-javascript-implementation)])) + +;; source-module-name: source -> (U symbol #f) +;; Given a source, return its module name if it's a module. +;; If not, return #f. +(define (source-module-name src) + (cond + [(StatementsSource? src) + #f] + [(MainModuleSource? src) + (rewrite-path (MainModuleSource-path src))] + [(ModuleSource? src) + (rewrite-path (ModuleSource-path src))] + [(SexpSource? src) + #f] + [(UninterpretedSource? src) + #f])) + + + (define (assemble-modinvokes+body paths after) (cond [(empty? paths) @@ -273,19 +292,29 @@ M.modules[~s] = (let ([name (rewrite-path (path->string path))] [afterName (gensym 'afterName)]) (format "var ~a = function() { ~a }; - if (! M.modules[~s].isInvoked) { - M.modules[~s].internalInvoke(M, - ~a, - M.params.currentErrorHandler); - } else { - ~a(); - }" + plt.runtime.currentModuleLoader(M, + ~s, + function() { + if (! M.modules[~s].isInvoked) { + M.modules[~s].internalInvoke(M, + ~a, + M.params.currentErrorHandler); + } else { + ~a(); + } + }, + function() { + alert('Could not load ~s'); + }) + " afterName after (symbol->string name) (symbol->string name) + (symbol->string name) afterName - afterName))) + afterName + (symbol->string name)))) @@ -304,7 +333,7 @@ M.modules[~s] = (define (package source-code #:should-follow-children? should-follow? #:output-port op - #:next-file-path (next-file-path (lambda () (error 'package)))) + #:next-file-path (next-file-path (lambda (module-name) (error 'package)))) (define resources (set)) @@ -324,7 +353,9 @@ M.modules[~s] = src])) - (define (maybe-with-fresh-file thunk) + ;; maybe-with-fresh-file: source (-> any) -> any + ;; Call thunk, perhaps in the dynamic extent where op is a new file. + (define (maybe-with-fresh-file src thunk) (cond [(current-one-module-per-file?) (define old-port op) @@ -332,7 +363,8 @@ M.modules[~s] = (set! op temp-string) (thunk) (set! op old-port) - (call-with-output-file (next-file-path) + (define fresh-name (next-file-path (source-module-name src))) + (call-with-output-file fresh-name (lambda (op) (display (compress (get-output-string temp-string)) op)) #:exists 'replace)] @@ -345,6 +377,7 @@ M.modules[~s] = (set! resources (set-union resources (list->set (source-resources src)))) (maybe-with-fresh-file + src (lambda () (fprintf op "\n// ** Visiting ~a\n" (source-name src)) (define start-time (current-inexact-milliseconds)) diff --git a/whalesong/js-assembler/runtime-src/runtime.js b/whalesong/js-assembler/runtime-src/runtime.js index 4c8f28f..7d9187c 100644 --- a/whalesong/js-assembler/runtime-src/runtime.js +++ b/whalesong/js-assembler/runtime-src/runtime.js @@ -1127,6 +1127,7 @@ // Other module loader implementations may do more interesting // things here, such as loading off the disk, or from the network. var defaultModuleLoader = function(M, moduleName, success, fail) { + console.log("request to load", moduleName); if (M.modules[moduleName] instanceof ModuleRecord) { return success(); } else { diff --git a/whalesong/make/make-structs.rkt b/whalesong/make/make-structs.rkt index 9b68dc8..cf07652 100644 --- a/whalesong/make/make-structs.rkt +++ b/whalesong/make/make-structs.rkt @@ -79,4 +79,4 @@ (: only-bootstrapped-code : (MyPromise StatementsSource)) (define only-bootstrapped-code - (my-delay (make-StatementsSource (get-bootstrapping-code)))) \ No newline at end of file + (my-delay (make-StatementsSource (get-bootstrapping-code)))) diff --git a/whalesong/whalesong-helpers.rkt b/whalesong/whalesong-helpers.rkt index ee802b8..564abe4 100644 --- a/whalesong/whalesong-helpers.rkt +++ b/whalesong/whalesong-helpers.rkt @@ -7,6 +7,7 @@ racket/date racket/runtime-path racket/pretty + json "parser/parse-bytecode.rkt" "compiler/compiler.rkt" "compiler/compiler-structs.rkt" @@ -142,9 +143,11 @@ (define written-js-paths '()) (define written-resources '()) + (define module-mappings (make-hash)) + (define make-output-js-filename (let ([n 0]) - (lambda () + (lambda (module-name) (define result (build-path (current-output-dir) (string-append (regexp-replace #rx"[.](rkt|ss)$" @@ -157,6 +160,9 @@ (set! n (add1 n)) (fprintf (current-report-port) (format "Writing program ~s\n" result)) + + (when module-name + (hash-set! module-mappings module-name result)) result))) (define (on-resource r) @@ -202,13 +208,21 @@ (regexp-replace #rx"[.](rkt|ss)$" (path->string (file-name-from-path f)) "") - ".appcache"))]) + ".appcache"))] + [output-js-module-manifest-filename + (build-path + (string-append + (regexp-replace #rx"[.](rkt|ss)$" + (path->string (file-name-from-path f)) + "") + "-module-manifest.js"))]) (unless (directory-exists? (current-output-dir)) (fprintf (current-report-port) "Creating destination directory ~s\n" (current-output-dir)) (make-directory* (current-output-dir))) + ;; Write out the main module and its other module dependencies. (parameterize ([current-on-resource on-resource]) - (call-with-output-file* (make-output-js-filename) + (call-with-output-file* (make-output-js-filename #f) (lambda (op) (display (get-runtime) op) (display (get-inert-code (make-MainModuleSource @@ -225,8 +239,7 @@ (call-with-output-file* (build-path (current-output-dir) output-html-filename) (lambda (op) (display (get-html-template - (map file-name-from-path - (reverse written-js-paths)) + (map file-name-from-path (reverse written-js-paths)) #:title title #:manifest output-manifest-filename) op)) @@ -246,8 +259,20 @@ (fprintf op "\n# All other resources (e.g. sites) require the user to be online.\nNETWORK:\n*\n")) #:exists 'replace) - (define stop-time (current-inexact-milliseconds)) + ;; Write out the js module manifest: + (fprintf (current-report-port) + (format "Writing js module manifest ~s\n" (build-path (current-output-dir) output-js-module-manifest-filename))) + (call-with-output-file* (build-path (current-output-dir) output-js-module-manifest-filename) + (lambda (op) + (fprintf op "plt.runtime.currentModuleManifest=") + (write-json (for/hash ([(key path) module-mappings]) + (values key (path->string (file-name-from-path path)))) + op)) + #:exists 'replace) + + + (define stop-time (current-inexact-milliseconds)) (fprintf (current-timing-port) "Time taken: ~a milliseconds\n" (- stop-time start-time))))))