From 125eed5924ed9fe78a5f9b0ad2f73ff6d396504a Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 20 May 2011 16:37:26 -0400 Subject: [PATCH] trying to figure out what pieces are left before we can make standalone packages --- NOTES | 3 +- experiments/test.xhtml | 1422 ++++++++++++++++++++++++++++++++++ js-assembler/assemble.rkt | 2 +- js-assembler/mini-runtime.js | 48 ++ package.rkt | 42 +- quote-cdata.rkt | 36 + whalesong.rkt | 47 +- 7 files changed, 1594 insertions(+), 6 deletions(-) create mode 100644 experiments/test.xhtml create mode 100644 quote-cdata.rkt diff --git a/NOTES b/NOTES index b5b1b92..19f82c8 100644 --- a/NOTES +++ b/NOTES @@ -537,7 +537,6 @@ Then I can start turning optimizations back on. May 20, 2011 I'm running my bytecode parser over the entire racket collects tree, -just to make sure the parser itself is robust. I'm hitting failures -on the following files: +just to make sure the parser itself is robust. Parsing takes milliseconds, except on Typed Racket code, which is expected. \ No newline at end of file diff --git a/experiments/test.xhtml b/experiments/test.xhtml new file mode 100644 index 0000000..8a915d0 --- /dev/null +++ b/experiments/test.xhtml @@ -0,0 +1,1422 @@ + + + + + Example + + + + + \ No newline at end of file diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt index 2dd4d5a..5df061a 100644 --- a/js-assembler/assemble.rkt +++ b/js-assembler/assemble.rkt @@ -182,7 +182,7 @@ EOF "") (cond [(DebugPrint? stmt) - (format "MACHINE.params.currentOutputPort.write(~a);" (assemble-oparg (DebugPrint-value stmt)))] + (format "MACHINE.params.currentOutputPort.write(MACHINE, ~a);" (assemble-oparg (DebugPrint-value stmt)))] [(AssignImmediateStatement? stmt) (let: ([t : String (assemble-target (AssignImmediateStatement-target stmt))] [v : OpArg (AssignImmediateStatement-value stmt)]) diff --git a/js-assembler/mini-runtime.js b/js-assembler/mini-runtime.js index ab5257d..c36a68e 100644 --- a/js-assembler/mini-runtime.js +++ b/js-assembler/mini-runtime.js @@ -101,6 +101,27 @@ }; + ModuleRecord.prototype.invoke = function(MACHINE, succ, fail) { + var oldErrorHandler = MACHINE.params['currentErrorHandler']; + var afterGoodInvoke = function(MACHINE) { + MACHINE.params['currentErrorHandler'] = oldErrorHandler; + setTimeout(succ, 0); + }; + + if (this.isInvoked) { + setTimeout(succ, 0); + } else { + MACHINE.params['currentErrorHandler'] = function(MACHINE, anError) { + MACHINE.params['currentErrorHandler'] = oldErrorHandler; + setTimeout(function() { fail(MACHINE, anError)}, 0); + }; + MACHINE.control.push(new CallFrame( + afterGoodInvoke, + null)); + trampoline(MACHINE, this.label); + } + }; + // A generic frame just holds marks. var Frame = function() { @@ -437,6 +458,33 @@ Primitives['displayln'].arity = [1, [2, NULL]]; Primitives['displayln'].displayName = 'displayln'; + + + // This should be attached to the module corresponding for print-values + Primitives['print-values'] = new Closure( + function(MACHINE) { + var outputPort = MACHINE.params.currentOutputPort; + if (MACHINE.argcount > 0) { + outputPort.write(MACHINE, MACHINE.val); + outputPort.write(MACHINE, "\n"); + + for(var i = 0; i < MACHINE.argcount - 1; i++) { + outputPort.write(MACHINE, "\n"); + outputPort.write(MACHINE, + MACHINE.env[MACHINE.env.length - 1 - i]); + } + outputPort.write(MACHINE, "\n"); + } + MACHINE.env.length = MACHINE.env.length - (MACHINE.argcount - 1); + throw MACHINE.control.pop(); + }, + new ArityAtLeast(0), + [], + "print-values" + ); + + + Primitives['pi'] = Math.PI; Primitives['e'] = Math.E; diff --git a/package.rkt b/package.rkt index db581e0..13d2108 100644 --- a/package.rkt +++ b/package.rkt @@ -2,11 +2,14 @@ (require "compiler.rkt" "compiler-structs.rkt" - "js-assembler/assemble.rkt" "parse-bytecode.rkt" "language-namespace.rkt" "il-structs.rkt" "bootstrapped-primitives.rkt" + "get-dependencies.rkt" + "js-assembler/assemble.rkt" + "js-assembler/get-runtime.rkt" + "quote-cdata.rkt" racket/runtime-path racket/port (prefix-in racket: racket/base)) @@ -53,4 +56,39 @@ (define (package-anonymous source-code op) (fprintf op "(function() {\n") (package source-code op) - (fprintf op " return invoke; })\n")) \ No newline at end of file + (fprintf op " return invoke; })\n")) + + + + + +(define (package-standalone-html a-module-path op) + ;; FIXME: write the runtime ... + ;; Next, write the function to load in each module. + (fprintf op #< + + + + Example + + + + + +EOF + )) \ No newline at end of file diff --git a/quote-cdata.rkt b/quote-cdata.rkt new file mode 100644 index 0000000..1d90039 --- /dev/null +++ b/quote-cdata.rkt @@ -0,0 +1,36 @@ +#lang typed/racket/base + +;; quoting cdata for script tags. This is used to help generate SCRIPT bodies in XHTML. +;; Note that this won't help too much in regular HTML5 documents. + +(require racket/list) +(require/typed racket/base (regexp-split (Regexp String -> (Listof String)))) + +(provide quote-as-cdata get-cdata-chunks) + + +(: quote-as-cdata (String -> String)) +(define (quote-as-cdata str) + (let ([chunks (regexp-split #rx"\\]\\]>" str)]) + (apply string-append (map wrap (process chunks))))) + + +(: get-cdata-chunks (String -> (Listof String))) +(define (get-cdata-chunks s) + (let ([chunks (regexp-split #rx"\\]\\]>" s)]) + (process chunks))) + + +(: process ((Listof String) -> (Listof String))) +(define (process lst) + (cond + [(empty? (rest lst)) + lst] + [else + (cons (string-append (first lst) "]]") + (process (cons (string-append ">" (second lst)) + (rest (rest lst)))))])) + +(: wrap (String -> String)) +(define (wrap s) + (string-append "")) \ No newline at end of file diff --git a/whalesong.rkt b/whalesong.rkt index d8304ee..793682a 100644 --- a/whalesong.rkt +++ b/whalesong.rkt @@ -1,6 +1,10 @@ #lang racket/base -(require racket/cmdline) +(require racket/list + racket/match + racket/string + "package.rkt" + "sets.rkt") ;; Usage: ;; @@ -20,3 +24,44 @@ ;; $ whalesong build main-module-name.rkt +(define commands `((build + ,(lambda (args) + (do-the-build args))))) + +;; listof string +(define command-names (map (lambda (x) (symbol->string (car x))) + commands)) + + +(define (print-expected-command) + (printf "Expected one of the following: [~a].\n" + (string-join command-names ", "))) + +(define (at-toplevel) + (define args (vector->list (current-command-line-arguments))) + (cond [(empty? args) + (print-expected-command)] + [else + (cond + [(assoc (string->symbol (first args)) + commands) + => + (lambda (p) + ((cadr p) (rest args)))] + [else + (printf "Unknown command ~s.\n" (first args)) + (print-expected-command)])])) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(define (do-the-build filenames) + (let ([seen-module-names (new-set)]) + (let loop ([queue filenames]) + (void)))) + + + + +(at-toplevel)