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)