about to translate branches into real if statements

js-assembler/assemble.rkt

@@ -1,4 +1,9 @@
 #lang typed/racket/base
+
+
+;; Assembles the statement stream into JavaScript.
+
+
 (require "assemble-structs.rkt"
          "assemble-helpers.rkt"
          "assemble-expression.rkt"
@@ -20,6 +25,9 @@
 (define current-emit-debug-trace? (make-parameter #f))
 
 
+;; Represents a hashtable from symbols to basic blocks
+(define-type Blockht (HashTable Symbol BasicBlock))
+
 
 
 (: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
@@ -34,7 +42,7 @@
   (define-values (basic-blocks entry-points) (fracture stmts))
   (define optimized-basic-blocks (optimize-basic-blocks basic-blocks))
   
-  (write-blocks optimized-basic-blocks op)
+  (write-blocks optimized-basic-blocks entry-points op)
   
   (write-linked-label-attributes stmts op)
   
@@ -53,12 +61,18 @@ EOF
 
 
 
-(: write-blocks ((Listof BasicBlock) Output-Port -> Void))
+(: write-blocks ((Listof BasicBlock) (Listof Symbol) Output-Port -> Void))
 ;; Write out all the basic blocks.
-(define (write-blocks blocks op)
+(define (write-blocks blocks entry-points op)  
+  (: blockht : Blockht)
+  (define blockht (make-hash))
+  
+  (for ([b blocks])
+    (hash-set! blockht (BasicBlock-name b) b))
+  
   (for ([b blocks])
     (log-debug (format "Emitting code for basic block ~s" (BasicBlock-name b)))
-    (displayln (assemble-basic-block b) op)
+    (displayln (assemble-basic-block b blockht) op)
     (newline op)))
 
 
@@ -118,8 +132,8 @@ EOF
 
 
 ;; assemble-basic-block: basic-block -> string
-(: assemble-basic-block (BasicBlock -> String))
-(define (assemble-basic-block a-basic-block)
+(: assemble-basic-block (BasicBlock Blockht -> String))
+(define (assemble-basic-block a-basic-block blockht)
   (format "var ~a = function(MACHINE){
     if(--MACHINE.callsBeforeTrampoline < 0) {
         throw ~a;
@@ -128,10 +142,99 @@ EOF
 };"
           (assemble-label (make-Label (BasicBlock-name a-basic-block)))
           (assemble-label (make-Label (BasicBlock-name a-basic-block)))
-          (string-join (map assemble-statement (BasicBlock-stmts a-basic-block))
+          (string-join (assemble-block-statements (BasicBlock-stmts a-basic-block)
+                                                  blockht)
                        "\n")))
 
 
+(: assemble-block-statements ((Listof UnlabeledStatement) Blockht -> (Listof String)))
+(define (assemble-block-statements stmts blockht)
+  
+  (: default (UnlabeledStatement -> (Listof String)))
+  (define (default stmt)
+    (cons (assemble-statement stmt)
+          (assemble-block-statements (rest stmts) blockht)))
+
+  (cond [(empty? stmts)
+         empty]
+        [else
+         (define stmt (first stmts))
+         (cond
+           [(DebugPrint? stmt)
+            (default stmt)]
+
+           [(AssignImmediateStatement? stmt)
+            (default stmt)]
+           
+           [(AssignPrimOpStatement? stmt)
+            (default stmt)]
+           
+           [(PerformStatement? stmt)
+            (default stmt)]
+           
+           [(TestAndJumpStatement? stmt)
+            (default stmt)
+            #;(let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)]
+                    [jump : String (assemble-jump 
+                                    (make-Label (TestAndJumpStatement-label stmt)))])
+              ;; to help localize type checks, we add a type annotation here.
+              (ann (cond
+                     [(TestFalse? test)
+                      (format "if (~a === false) { ~a }"
+                              (assemble-oparg (TestFalse-operand test))
+                              jump)]
+                     [(TestTrue? test)
+                      (format "if (~a !== false) { ~a }"
+                              (assemble-oparg (TestTrue-operand test))
+                              jump)]
+                     [(TestOne? test)
+                      (format "if (~a === 1) { ~a }"
+                              (assemble-oparg (TestOne-operand test))
+                              jump)]
+                     [(TestZero? test)
+                      (format "if (~a === 0) { ~a }"
+                              (assemble-oparg (TestZero-operand test))
+                              jump)]
+                     [(TestPrimitiveProcedure? test)
+                      (format "if (typeof(~a) === 'function') { ~a }"
+                              (assemble-oparg (TestPrimitiveProcedure-operand test))
+                              jump)]
+                     [(TestClosureArityMismatch? test)
+                      (format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a)) { ~a }"
+                              (assemble-oparg (TestClosureArityMismatch-closure test))
+                              (assemble-oparg (TestClosureArityMismatch-n test))
+                              jump)])
+                   String))]
+           
+           [(GotoStatement? stmt)
+            (default stmt)]
+     
+           [(PushControlFrame/Generic? stmt)
+            (default stmt)]
+     
+           [(PushControlFrame/Call? stmt)
+            (default stmt)]
+     
+           [(PushControlFrame/Prompt? stmt)
+            (default stmt)]
+     
+           [(PopControlFrame? stmt)
+            (default stmt)]
+     
+           [(PushEnvironment? stmt)
+            (default stmt)]
+
+           [(PopEnvironment? stmt)
+            (default stmt)]
+     
+           [(PushImmediateOntoEnvironment? stmt)
+            (default stmt)]
+           [(Comment? stmt)
+            (default stmt)])]))
+
+           
+
+
 
 (: assemble-statement (UnlabeledStatement -> String))
 ;; Generates the code to assemble a statement.