diff --git a/assemble.rkt b/assemble.rkt index b2d9f3b..2031534 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -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)) diff --git a/browser-evaluate.rkt b/browser-evaluate.rkt index 13cf368..b7e6856 100644 --- a/browser-evaluate.rkt +++ b/browser-evaluate.rkt @@ -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; diff --git a/test-assemble.rkt b/test-assemble.rkt index 918f767..b5b0c1d 100644 --- a/test-assemble.rkt +++ b/test-assemble.rkt @@ -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") \ No newline at end of file + "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")