suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

splitting modules appears to be doing something.

Browse Source
This commit is contained in:
Danny Yoo 2011-09-15 14:44:34 -04:00
parent 82a2f9e880
commit 1bdabbeadd
4 changed files with 45 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
js-assembler/package.rkt
View File

@ -254,20 +254,37 @@ M.modules[~s] =
src]))
(define (maybe-with-fresh-file thunk)
(cond
[(current-one-module-per-file?)
(define old-port op)
(define temp-string (open-output-string))
(set! op temp-string)
(thunk)
(set! op old-port)
(call-with-output-file (next-file-path)
(lambda (op)
(display (compress (get-output-string temp-string)) op))
#:exists 'replace)]
[else
(thunk)]))
(define (on-visit-src src ast stmts)
;; Record the use of resources on source module visitation...
(set! resources (set-union resources (list->set (source-resources src))))
(fprintf op "\n// ** Visiting ~a\n" (source-name src))
(define start-time (current-inexact-milliseconds))
(cond
[(UninterpretedSource? src)
(fprintf op "(function(M) { ~a }(plt.runtime.currentMachine));" (UninterpretedSource-datum src))]
[else
(fprintf op "(")
(assemble/write-invoke stmts op)
(fprintf op ")(plt.runtime.currentMachine,
(maybe-with-fresh-file
(lambda ()
(fprintf op "\n// ** Visiting ~a\n" (source-name src))
(define start-time (current-inexact-milliseconds))
(cond
[(UninterpretedSource? src)
(fprintf op "(function(M) { ~a }(plt.runtime.currentMachine));" (UninterpretedSource-datum src))]
[else
(fprintf op "(")
(assemble/write-invoke stmts op)
(fprintf op ")(plt.runtime.currentMachine,
function() {
if (window.console && window.console.log) {
window.console.log('loaded ' + ~s);
@ -279,11 +296,11 @@ M.modules[~s] =
}
},
{});"
(format "~a" (source-name src))
(format "~a" (source-name src)))
(define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) " assembly: ~s milliseconds\n" (- stop-time start-time))
(void)]))
(format "~a" (source-name src))
(format "~a" (source-name src)))
(define stop-time (current-inexact-milliseconds))
(fprintf (current-timing-port) " assembly: ~s milliseconds\n" (- stop-time start-time))
(void)]))))
(define (after-visit-src src)

2
parameters.rkt
View File

@ -16,8 +16,10 @@
current-root-path
current-warn-unimplemented-kernel-primitive
current-seen-unimplemented-kernel-primitives
current-kernel-module-locator?
current-compress-javascript?
current-one-module-per-file?
current-report-port
current-timing-port

13
whalesong-helpers.rkt
View File

@ -98,12 +98,13 @@
(format "_~a.js" n)))))
(set! written-js-paths (cons result written-js-paths))
(set! n (add1 n))
(fprintf (current-report-port)
(format "Writing program ~s\n" result))
result)))
(define start-time (current-inexact-milliseconds))
(let ([output-js-filename (make-output-js-filename)]
[output-html-filename
(let ([output-html-filename
(build-path
(regexp-replace #rx"[.](rkt|ss)$"
(path->string (file-name-from-path f))
@ -136,9 +137,7 @@
(copy-file (resource-path r)
(build-path (current-output-dir)
(resource-key r)))]))])
(fprintf (current-report-port)
(format "Writing program ~s\n" output-js-filename))
(call-with-output-file* output-js-filename
(call-with-output-file* (make-output-js-filename)
(lambda (op)
(display (get-runtime) op)
(display (get-inert-code (make-ModuleSource (build-path f))
@ -150,7 +149,9 @@
(format "Writing html ~s\n" (build-path (current-output-dir) output-html-filename)))
(call-with-output-file* (build-path (current-output-dir) output-html-filename)
(lambda (op)
(display (get-html-template (map file-name-from-path written-js-paths))
(display (get-html-template
(map file-name-from-path
(reverse written-js-paths)))
op))
#:exists 'replace)
(define stop-time (current-inexact-milliseconds))

3
whalesong.rkt
View File

@ -69,6 +69,9 @@
[("--compress-javascript")
("Compress JavaScript with Google Closure (requires Java)")
(current-compress-javascript? #t)]
[("--split-modules")
("Write one file per module")
(current-one-module-per-file? #t)]
[("--dest-dir")
dest-dir
("Set destination directory (default: current-directory)")