#lang racket/base (require "assemble.rkt" "quote-cdata.rkt" "../make.rkt" "../make-structs.rkt" "../parameters.rkt" (planet dyoo/closure-compile:1:1) (prefix-in runtime: "get-runtime.rkt") (prefix-in racket: racket/base)) ;; TODO: put proper contracts here (provide package package-anonymous package-standalone-xhtml get-standalone-code write-standalone-code get-runtime write-runtime) ;; Packager: produce single .js files to be included to execute a ;; program. (define (package-anonymous source-code #:should-follow? should-follow? #:output-port op) (fprintf op "(function() {\n") (package source-code #:should-follow? should-follow? #:output-port op) (fprintf op " return invoke; })\n")) ;; package: Source (path -> boolean) output-port -> void ;; Compile package for the given source program. should-follow? ;; indicates whether we should continue following module paths. ;; ;; The generated output defines a function called 'invoke' with ;; four arguments (MACHINE, SUCCESS, FAIL, PARAMS). When called, it will ;; execute the code to either run standalone expressions or ;; load in modules. (define (package source-code #:should-follow? should-follow? #:output-port op) (define packaging-configuration (make-Configuration should-follow? ;; on (lambda (src ast stmts) (assemble/write-invoke stmts op) (fprintf op "(MACHINE, function() { ")) ;; after (lambda (src ast stmts) (fprintf op " }, FAIL, PARAMS);")) ;; last (lambda () (fprintf op "SUCCESS();")))) (fprintf op "var invoke = (function(MACHINE, SUCCESS, FAIL, PARAMS) {") (fprintf op " plt.runtime.ready(function() {") (make (list (make-MainModuleSource source-code)) packaging-configuration) (fprintf op " });"); (fprintf op "});\n")) ;; package-standalone-xhtml: X output-port -> void (define (package-standalone-xhtml source-code op) (display *header* op) (display (quote-cdata (get-runtime)) op) (display (quote-cdata (get-code source-code)) op) (display *footer* op)) ;; write-runtime: output-port -> void (define (write-runtime op) (let ([packaging-configuration (make-Configuration ;; should-follow? (lambda (src p) #t) ;; on (lambda (src ast stmts) (assemble/write-invoke stmts op) (fprintf op "(MACHINE, function() { ")) ;; after (lambda (src ast stmts) (fprintf op " }, FAIL, PARAMS);")) ;; last (lambda () (fprintf op "SUCCESS();")))]) (display (runtime:get-runtime) op) (newline op) (fprintf op "(function(MACHINE, SUCCESS, FAIL, PARAMS) {") (make (list only-bootstrapped-code) packaging-configuration) (fprintf op "})(plt.runtime.currentMachine,\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n"))) (define (compress x) (if (current-compress-javascript?) (closure-compile x) x)) (define *the-runtime* (let ([buffer (open-output-string)]) (write-runtime buffer) (compress (get-output-string buffer)))) ;; get-runtime: -> string (define (get-runtime) *the-runtime*) ;; *header* : string (define *header* #< Example EOF )