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

Working on making it easy to run whalesong from the shell.

Browse Source 
whalesong.rkt now provides two additional commands:

    get-runtime: prints the runtime into standard output

    get-javascript: compiles the given program and writes to standard output
This commit is contained in:
Danny Yoo 2011-05-30 16:10:42 -04:00
parent ad04fd4425
commit 5a04541fe3
8 changed files with 114 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/il-structs.rkt
View File

@ -425,10 +425,9 @@
#:transparent)
;; Give an alternative locator to the module. Assumes the module has
;; already been installed.
(define-struct: AliasModuleName! ([from : ModuleLocator]
[to : ModuleLocator])
;; Give an alternative locator to the module as a main module.
;; Assumes the module has already been installed.
(define-struct: AliasModuleAsMain! ([from : ModuleLocator])
#:transparent)
;; Given the module locator, do any finalizing operations, like
@ -463,7 +462,7 @@
InstallModuleEntry!
MarkModuleInvoked!
AliasModuleName!
AliasModuleAsMain!
FinalizeModuleInvokation!
))

9
js-assembler/assemble-perform-statement.rkt
View File

@ -21,7 +21,6 @@
(CheckToplevelBound!-pos op))]
;; FIXME: use raiseArityMismatchError
[(CheckClosureArity!? op)
(format #<<EOF
if (! (MACHINE.proc instanceof RUNTIME.Closure)) {
@ -37,7 +36,6 @@ EOF
(assemble-oparg (CheckClosureArity!-arity op)))]
;; FIXME: use raiseArityMismatchError
[(CheckPrimitiveArity!? op)
(format #<<EOF
if (! (typeof(MACHINE.proc) === 'function')) {
@ -177,10 +175,9 @@ EOF
(symbol->string (ModuleLocator-name (MarkModuleInvoked!-path op))))]
[(AliasModuleName!? op)
(format "MACHINE.modules[~s] = MACHINE.modules[~s];"
(symbol->string (ModuleLocator-name (AliasModuleName!-to op)))
(symbol->string (ModuleLocator-name (AliasModuleName!-from op))))]
[(AliasModuleAsMain!? op)
(format "MACHINE.mainModules.push(MACHINE.modules[~s]);"
(symbol->string (ModuleLocator-name (AliasModuleAsMain!-from op))))]
[(FinalizeModuleInvokation!? op)
(format "MACHINE.modules[~s].finalizeModuleInvokation();"

10
js-assembler/assemble.rkt
View File

@ -12,8 +12,7 @@
racket/string
racket/list)
(provide assemble/write-invoke-module-as-main
assemble/write-invoke
(provide assemble/write-invoke
fracture
assemble-basic-block
assemble-statement)
@ -25,13 +24,6 @@
(: assemble/write-invoke-module-as-main (Symbol Output-Port -> Void))
(define (assemble/write-invoke-module-as-main module-name op)
;; FIXME
(void))
(: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
;; Writes out the JavaScript code that represents the anonymous invocation expression.
;; What's emitted is a function expression that, when invoked, runs the

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

@ -65,6 +65,7 @@
this.control = []; // Arrayof (U Frame CallFrame PromptFrame)
this.running = false;
this.modules = {}; // String -> ModuleRecord
this.mainModules = []; // Arrayof String
this.params = {
// currentDisplayer: DomNode -> Void
@ -139,6 +140,10 @@
// External invokation of a module.
ModuleRecord.prototype.invoke = function(MACHINE, succ, fail) {
MACHINE = MACHINE || plt.runtime.currentMachine;
succ = succ || function(){};
fail = fail || function(){};
var oldErrorHandler = MACHINE.params['currentErrorHandler'];
var afterGoodInvoke = function(MACHINE) {
MACHINE.params['currentErrorHandler'] = oldErrorHandler;
@ -1305,6 +1310,9 @@
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
(function(scope) {
scope.ready = function(f) {
if (runtimeIsReady) {
@ -1328,14 +1336,44 @@
setTimeout(w, 0);
};
})(this);
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
// Executes all programs that have been labeled as a main module
var invokeMains = function(machine, succ, fail) {
plt.runtime.ready(function() {
machine = machine || plt.runtime.currentMachine;
succ = succ || function() {};
fail = fail || function() {};
var mainModules = machine.mainModules.slice();
var loop = function() {
if (mainModules.length > 0) {
var nextModule = mainModules.shift();
nextModule.invoke(machine, loop, fail);
} else {
succ();
}
};
setTimeout(loop, 0);
});
};
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
// Exports
exports['Primitives'] = Primitives;
exports['currentMachine'] = new Machine();
exports['invokeMains'] = invokeMains;
exports['Primitives'] = Primitives;
exports['ready'] = ready;
// Private: the runtime library will set this flag to true when
// the library has finished loading.

87
js-assembler/package.rkt
View File

@ -12,11 +12,14 @@
(provide package
package-anonymous
package-standalone-xhtml
get-code
get-runtime)
get-standalone-code
write-standalone-code
get-runtime
write-runtime)
;; Packager: produce single .js files to be included to execute a
;; program. Follows module dependencies.
;; program.
@ -84,34 +87,41 @@
;; get-runtime: -> string
(define (get-runtime)
(let* ([buffer (open-output-string)]
[packaging-configuration
(make-Configuration
;; should-follow?
(lambda (p) #t)
;; on
(lambda (ast stmts)
(assemble/write-invoke stmts buffer)
(fprintf buffer "(MACHINE, function() { "))
;; after
(lambda (ast stmts)
(fprintf buffer " }, FAIL, PARAMS);"))
;; last
(lambda ()
(fprintf buffer "SUCCESS();")))])
(display (runtime:get-runtime) buffer)
(newline buffer)
(fprintf buffer "(function(MACHINE, SUCCESS, FAIL, PARAMS) {")
(make (list only-bootstrapped-code) packaging-configuration)
(fprintf buffer "})(new plt.runtime.Machine(),\nfunction(){ plt.runtime.setReadyTrue(); },\nfunction(){},\n{});\n")
(let ([buffer (open-output-string)])
(write-runtime buffer)
(get-output-string buffer)))
;; write-runtime: output-port -> void
(define (write-runtime op)
(let ([packaging-configuration
(make-Configuration
;; should-follow?
(lambda (p) #t)
;; on
(lambda (ast stmts)
(assemble/write-invoke stmts op)
(fprintf op "(MACHINE, function() { "))
;; after
(lambda (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")))
;; *header* : string
(define *header*
#<<EOF
<!DOCTYPE html>
@ -126,6 +136,7 @@ EOF
)
;; get-code: source -> string
(define (get-code source-code)
(let ([buffer (open-output-string)])
(package source-code
@ -134,15 +145,33 @@ EOF
(get-output-string buffer)))
;; get-standalone-code: source -> string
(define (get-standalone-code source-code)
(let ([buffer (open-output-string)])
(write-standalone-code source-code buffer)
(get-output-string buffer)))
;; write-standalone-code: source output-port -> void
(define (write-standalone-code source-code op)
(package-anonymous source-code
#:should-follow? (lambda (p) #t)
#:output-port op)
(fprintf op "()(plt.runtime.currentMachine, function() {}, function() {}, {});\n"))
(define *footer*
#<<EOF
<![CDATA[
var invokeMainModule = function() {
var MACHINE = new plt.runtime.Machine();
var MACHINE = plt.runtime.currentMachine;
invoke(MACHINE,
function() {
MACHINE.modules['*main*'].invoke(
plt.runtime.invokeMains(
MACHINE,
function() {
// On main module invokation success
@ -152,7 +181,7 @@ var invokeMainModule = function() {
if (console && console.log) {
console.log(e.stack || e);
}
})},
})},
function() {
// On module loading failure
if (console && console.log) {

5
make.rkt
View File

@ -42,9 +42,8 @@
(values ast (append stmts
;; Set the main module name
(list (make-PerformStatement
(make-AliasModuleName!
maybe-module-locator
(make-ModuleLocator '*main* '*main*))))))]
(make-AliasModuleAsMain!
maybe-module-locator)))))]
[else
(values ast stmts)])))]

6
simulator/simulator.rkt
View File

@ -476,12 +476,12 @@
(ModuleLocator-name (MarkModuleInvoked!-path op)))])
(set-module-record-invoked?! module-record #t)
'ok)]
[(AliasModuleName!? op)
[(AliasModuleAsMain!? op)
(let ([module-record
(hash-ref (machine-modules m)
(ModuleLocator-name (AliasModuleName!-from op)))])
(ModuleLocator-name (AliasModuleAsMain!-from op)))])
(hash-set! (machine-modules m)
(ModuleLocator-name (AliasModuleName!-to op))
'*main*
module-record)
'ok)]
[(FinalizeModuleInvokation!? op)

4
whalesong.rkt
View File

@ -86,12 +86,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (print-the-runtime)
(display (get-runtime)))
(write-runtime (current-output-port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-javascript-code filename)
(display (get-code (make-ModuleSource (build-path filename)))))
(write-standalone-code (make-ModuleSource (build-path filename)) (current-output-port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;