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

fixing assembly of basic blocks

Browse Source
This commit is contained in:
Danny Yoo 2011-03-09 14:47:05 -05:00
parent d7554b2ae4
commit c8c3947e0a
2 changed files with 61 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
assemble.rkt
View File

@ -10,17 +10,16 @@
assemble-statement)
;; assemble/write-invoke: (listof statement) output-port -> void
(: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
;; Writes out the JavaScript code that represents the anonymous invocation expression.
(define (assemble/write-invoke stmts op)
(let ([basic-blocks (fracture stmts)])
(fprintf op "function(success, fail, params) {\n")
(fprintf op "(function(success, fail, params) {\n")
(fprintf op "var param;\n")
(for-each (lambda: ([basic-block : BasicBlock])
(displayln (assemble-basic-block basic-block) op)
(newline op))
basic-blocks)
(fprintf op "MACHINE.cont = function() {success(MACHINE.val)};\n")
(fprintf op "MACHINE.params.currentErrorHandler = function(e) { fail(e); };\n")
(fprintf op #<<EOF
for (param in params) {
@ -30,7 +29,7 @@ for (param in params) {
}
EOF
)
(fprintf op "trampoline(~a, function() {}, function(e) { MACHINE.params.currentErrorHandler(e)}); }"
(fprintf op "trampoline(~a, function() {success(MACHINE.val)}, fail); })"
(BasicBlock-name (first basic-blocks)))))
@ -219,11 +218,14 @@ EOF
(format "return ~a();"
(assemble-location (GotoStatement-target stmt)))]
[(PushControlFrame? stmt)
"fixme"]
(format "MACHINE.control.push(~a);" (PushControlFrame-label stmt))]
[(PopControlFrame? stmt)
"fixme"]
"MACHINE.control.pop();"]
[(PushEnvironment? stmt)
"fixme"]
(format "MACHINE.env.push(~a);" (string-join
(build-list (PushEnvironment-n stmt) (lambda: ([i : Natural])
"undefined"))
", "))]
[(PopEnvironment? stmt)
"fixme"]))

65
test-assemble.rkt
View File

@ -5,6 +5,7 @@
"parse.rkt"
"il-structs.rkt"
racket/port
racket/promise
racket/runtime-path)
(define-runtime-path runtime.js "runtime.js")
@ -18,7 +19,7 @@
(with-syntax ([stx stx])
(syntax/loc #'stx
(begin
(printf "Running ~s ...\n" 'exp)
(printf "Running ~s ...\n" (syntax->datum #'expr))
(let ([actual expr])
(unless (equal? actual expected)
(raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
@ -26,38 +27,76 @@
(printf "ok.\n\n")))))]))
(define -E (make-evaluate
;; evaluating single expression
(define -E (delay (make-evaluate
(lambda (a-statement+inspector op)
(let* ([a-statement (car a-statement+inspector)]
[inspector (cdr a-statement+inspector)]
[snippet (assemble-statement a-statement)]
[code
(string-append
"(function() { "
runtime
"return function(success, fail, params){" (assemble-statement a-statement)
"return function(success, fail, params){" snippet
(format "success(String(~a)); };" inspector)
"});")])
(display code op)))))
(displayln snippet)
(display code op))))))
(define (E-single a-statement (inspector "MACHINE.val"))
(evaluated-value ((force -E) (cons a-statement inspector))))
;; evaluating many expressions[.
(define -E-many (delay (make-evaluate
(lambda (a-statement+inspector op)
(let* ([a-statement (car a-statement+inspector)]
[inspector (cdr a-statement+inspector)])
(display "(function() { " op)
(display runtime op)
(display "var myInvoke = " op)
(assemble/write-invoke a-statement op)
(display ";" op)
(fprintf op
"return function(succ, fail, params) { console.log('here'); myInvoke(function(v) { console.log('there!');succ(String(~a));}, fail, params); }"
inspector)
(display "})" op))))))
(define (E-many stmts (inspector "MACHINE.val"))
(evaluated-value ((force -E-many) (cons stmts inspector))))
(define (E a-statement (inspector "MACHINE.val"))
(evaluated-value (-E (cons a-statement inspector))))
;; Assigning a number
(test (E (make-AssignImmediateStatement 'val (make-Const 42)))
(test (E-single (make-AssignImmediateStatement 'val (make-Const 42)))
"42")
;; Assigning a string
(test (E (make-AssignImmediateStatement 'val (make-Const "Danny")))
(test (E-single (make-AssignImmediateStatement 'val (make-Const "Danny")))
"Danny")
;; Assigning a cons
(test (E (make-AssignImmediateStatement 'val (make-Const (cons 1 2))))
(test (E-single (make-AssignImmediateStatement 'val (make-Const (cons 1 2))))
"1,2")
;; Assigning to proc means val should still be uninitialized.
(test (E (make-AssignImmediateStatement 'proc (make-Const "Danny")))
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny")))
"undefined")
;; But we should see the assignment if we inspect MACHINE.proc.
(test (E (make-AssignImmediateStatement 'proc (make-Const "Danny"))
(test (E-single (make-AssignImmediateStatement 'proc (make-Const "Danny"))
"MACHINE.proc")
"Danny")
"Danny")
(test (E-single (make-PushEnvironment 1)
"MACHINE.env.length")
"1")
(test (E-single (make-PushEnvironment 20)
"MACHINE.env.length")
"20")
(test (E-many (list (make-PushEnvironment 1))
"MACHINE.env.length")
"1")