fixing assembly of basic blocks

assemble.rkt

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

test-assemble.rkt

@@ -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")))))]))
 
 
-
+;; evaluating single expression
-(define -E (make-evaluate
+(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")
+
+
+(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")