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

trying to figure out what pieces are left before we can make standalone packages

Browse Source
This commit is contained in:
Danny Yoo 2011-05-20 16:37:26 -04:00
parent eb83d7f689
commit 125eed5924
7 changed files with 1594 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
NOTES
View File

@ -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.

1422
experiments/test.xhtml Normal file
View File

File diff suppressed because it is too large Load Diff

2
js-assembler/assemble.rkt
View File

@ -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)])

48
js-assembler/mini-runtime.js
View File

@ -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;

40
package.rkt
View File

@ -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))
@ -54,3 +57,38 @@
(fprintf op "(function() {\n")
(package source-code op)
(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 #<<EOF
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<meta charset="utf-8"/>
<title>Example</title>
</head>
<script>\n
EOF
)
(display (quote-as-cdata (get-runtime)) op)
(let ([buffer (open-output-string)])
(assemble/write-invoke (compile (parse-bytecode a-module-path)
'val
next-linkage/drop-multiple)
buffer)
(write-string (quote-as-cdata (get-output-string buffer))
op))
;; FIXME: Finally, invoke the main module.
(fprintf op #<<EOF
\n</script>
<body onload='invokeMainModule()'>
</body>
</html>
EOF
))

36
quote-cdata.rkt Normal file
View File

@ -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 "<![CDATA[" s "]]>"))

47
whalesong.rkt
View File

@ -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)