fixing assignment to targets.

This commit is contained in:
Danny Yoo 2011-03-09 15:07:58 -05:00
parent c8c3947e0a
commit f53c96abc5
3 changed files with 66 additions and 29 deletions

View File

@ -171,33 +171,28 @@ EOF
"\n")))
(: assemble-statement (UnlabeledStatement -> String))
;; Generates the code to assemble a statement.
(define (assemble-statement stmt)
(cond
[(AssignImmediateStatement? stmt)
(let ([v (AssignImmediateStatement-value stmt)])
(cond
[(Reg? v)
(format "MACHINE.~a=~a"
(AssignImmediateStatement-target stmt)
(assemble-reg v))]
[(Label? v)
(format "MACHINE.~a=~a;"
(AssignImmediateStatement-target stmt)
(assemble-label v))]
[(Const? v)
(format "MACHINE.~a=~a;"
(AssignImmediateStatement-target stmt)
(assemble-const v))]
[(EnvLexicalReference? v)
(format "MACHINE.~a=~a;"
(AssignImmediateStatement-target stmt)
(assemble-lexical-reference v))]
[(EnvWholePrefixReference? v)
(format "MACHINE.~a=~a;"
(AssignImmediateStatement-target stmt)
(assemble-whole-prefix-reference v))]))]
(let ([t (assemble-target (AssignImmediateStatement-target stmt))]
[v (AssignImmediateStatement-value stmt)])
(format "~a = ~a;"
t
(cond
[(Reg? v)
(assemble-reg v)]
[(Label? v)
(assemble-label v)]
[(Const? v)
(assemble-const v)]
[(EnvLexicalReference? v)
(assemble-lexical-reference v)]
[(EnvWholePrefixReference? v)
(assemble-whole-prefix-reference v)])))]
[(AssignPrimOpStatement? stmt)
(format "MACHINE.~a=~a;"
@ -227,8 +222,25 @@ EOF
"undefined"))
", "))]
[(PopEnvironment? stmt)
"fixme"]))
(format "MACHINE.env.splice(MACHINE.env.length-(~a),~a);"
(+ (PopEnvironment-skip stmt)
(PopEnvironment-n stmt))
(PopEnvironment-n stmt))]))
(: assemble-target (Target -> String))
(define (assemble-target target)
(cond
[(eq? target 'proc)
"MACHINE.proc"]
[(eq? target 'val)
"MACHINE.val"]
[(EnvLexicalReference? target)
(assemble-lexical-reference target)]))
;; fixme: use js->string
(: assemble-const (Const -> String))
@ -248,12 +260,12 @@ EOF
(: assemble-lexical-reference (EnvLexicalReference -> String))
(define (assemble-lexical-reference a-lex-ref)
(format "MACHINE.env[~a]"
(format "MACHINE.env[MACHINE.env.length - 1 - ~a]"
(EnvLexicalReference-depth a-lex-ref)))
(: assemble-whole-prefix-reference (EnvWholePrefixReference -> String))
(define (assemble-whole-prefix-reference a-prefix-ref)
(format "MACHINE.env[~a]"
(format "MACHINE.env[MACHINE.env.length - 1 - ~a]"
(EnvWholePrefixReference-depth a-prefix-ref)))
(: assemble-env-reference (EnvReference -> String))

View File

@ -210,6 +210,7 @@ function createXMLHTTPObject() {
var comet = function() {
sendRequest("/eval",
function(req) {
console.log(req.responseText);
var invoke = eval(req.responseText)();
var output = [];
var startTime, endTime;

View File

@ -59,7 +59,7 @@
(display ";" op)
(fprintf op
"return function(succ, fail, params) { console.log('here'); myInvoke(function(v) { console.log('there!');succ(String(~a));}, fail, params); }"
"return function(succ, fail, params) { myInvoke(function(v) { succ(String(~a));}, fail, params); }"
inspector)
(display "})" op))))))
(define (E-many stmts (inspector "MACHINE.val"))
@ -97,6 +97,30 @@
"MACHINE.env.length")
"20")
(test (E-many (list (make-PushEnvironment 1))
;; PopEnvironment
(test (E-many (list (make-PushEnvironment 2))
"MACHINE.env.length")
"1")
"2")
(test (E-many (list (make-PushEnvironment 2)
(make-PopEnvironment 1 0))
"MACHINE.env.length")
"1")
;; Assigning to the environment
(test (E-many (list (make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 0)
(make-Const 12345)))
"MACHINE.env[1]")
"12345")
(test (E-many (list (make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 0)
(make-Const 12345)))
"MACHINE.env[0]")
"undefined")
(test (E-many (list (make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 1)
(make-Const 12345)))
"MACHINE.env[0]")
"12345")