about to translate branches into real if statements
This commit is contained in:
Danny Yoo
parent
2d62faf794
commit
31d4be5b3f
|
|
@ -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)))
|
||||
|
||||
|
||||
|
|
@ -73,53 +87,53 @@ EOF
|
|||
'ok]
|
||||
[else
|
||||
(let: ([stmt : Statement (first stmts)])
|
||||
|
||||
(define (next) (write-linked-label-attributes (rest stmts) op))
|
||||
|
||||
(cond
|
||||
[(symbol? stmt)
|
||||
(next)]
|
||||
[(LinkedLabel? stmt)
|
||||
(fprintf op "~a.multipleValueReturn = ~a;\n"
|
||||
(assemble-label (make-Label (LinkedLabel-label stmt)))
|
||||
(assemble-label (make-Label (LinkedLabel-linked-to stmt))))
|
||||
(next)]
|
||||
[(DebugPrint? stmt)
|
||||
(next)]
|
||||
[(AssignImmediateStatement? stmt)
|
||||
(next)]
|
||||
[(AssignPrimOpStatement? stmt)
|
||||
(next)]
|
||||
[(PerformStatement? stmt)
|
||||
(next)]
|
||||
[(TestAndJumpStatement? stmt)
|
||||
(next)]
|
||||
[(GotoStatement? stmt)
|
||||
(next)]
|
||||
[(PushEnvironment? stmt)
|
||||
(next)]
|
||||
[(PopEnvironment? stmt)
|
||||
(next)]
|
||||
[(PushImmediateOntoEnvironment? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Generic? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Call? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Prompt? stmt)
|
||||
(next)]
|
||||
[(PopControlFrame? stmt)
|
||||
(next)]
|
||||
[(Comment? stmt)
|
||||
(next)]))]))
|
||||
|
||||
(define (next) (write-linked-label-attributes (rest stmts) op))
|
||||
|
||||
(cond
|
||||
[(symbol? stmt)
|
||||
(next)]
|
||||
[(LinkedLabel? stmt)
|
||||
(fprintf op "~a.multipleValueReturn = ~a;\n"
|
||||
(assemble-label (make-Label (LinkedLabel-label stmt)))
|
||||
(assemble-label (make-Label (LinkedLabel-linked-to stmt))))
|
||||
(next)]
|
||||
[(DebugPrint? stmt)
|
||||
(next)]
|
||||
[(AssignImmediateStatement? stmt)
|
||||
(next)]
|
||||
[(AssignPrimOpStatement? stmt)
|
||||
(next)]
|
||||
[(PerformStatement? stmt)
|
||||
(next)]
|
||||
[(TestAndJumpStatement? stmt)
|
||||
(next)]
|
||||
[(GotoStatement? stmt)
|
||||
(next)]
|
||||
[(PushEnvironment? stmt)
|
||||
(next)]
|
||||
[(PopEnvironment? stmt)
|
||||
(next)]
|
||||
[(PushImmediateOntoEnvironment? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Generic? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Call? stmt)
|
||||
(next)]
|
||||
[(PushControlFrame/Prompt? stmt)
|
||||
(next)]
|
||||
[(PopControlFrame? stmt)
|
||||
(next)]
|
||||
[(Comment? stmt)
|
||||
(next)]))]))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
|
|
@ -147,7 +250,7 @@ EOF
|
|||
[(AssignImmediateStatement? stmt)
|
||||
(let: ([t : (String -> String) (assemble-target (AssignImmediateStatement-target stmt))]
|
||||
[v : OpArg (AssignImmediateStatement-value stmt)])
|
||||
(t (assemble-oparg v)))]
|
||||
(t (assemble-oparg v)))]
|
||||
|
||||
[(AssignPrimOpStatement? stmt)
|
||||
((assemble-target (AssignPrimOpStatement-target stmt))
|
||||
|
|
@ -160,34 +263,34 @@ EOF
|
|||
(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))]
|
||||
;; 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)
|
||||
(assemble-jump (GotoStatement-target stmt))]
|
||||
|
|
@ -198,29 +301,29 @@ EOF
|
|||
[(PushControlFrame/Call? stmt)
|
||||
(format "MACHINE.control.push(new RUNTIME.CallFrame(~a, MACHINE.proc));"
|
||||
(let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Call-label stmt)])
|
||||
(cond
|
||||
[(symbol? label)
|
||||
(assemble-label (make-Label label))]
|
||||
[(LinkedLabel? label)
|
||||
(assemble-label (make-Label (LinkedLabel-label label)))])))]
|
||||
(cond
|
||||
[(symbol? label)
|
||||
(assemble-label (make-Label label))]
|
||||
[(LinkedLabel? label)
|
||||
(assemble-label (make-Label (LinkedLabel-label label)))])))]
|
||||
|
||||
[(PushControlFrame/Prompt? stmt)
|
||||
;; fixme: use a different frame structure
|
||||
(format "MACHINE.control.push(new RUNTIME.PromptFrame(~a, ~a));"
|
||||
(let: ([label : (U Symbol LinkedLabel) (PushControlFrame/Prompt-label stmt)])
|
||||
(cond
|
||||
[(symbol? label)
|
||||
(assemble-label (make-Label label))]
|
||||
[(LinkedLabel? label)
|
||||
(assemble-label (make-Label (LinkedLabel-label label)))]))
|
||||
(cond
|
||||
[(symbol? label)
|
||||
(assemble-label (make-Label label))]
|
||||
[(LinkedLabel? label)
|
||||
(assemble-label (make-Label (LinkedLabel-label label)))]))
|
||||
|
||||
(let: ([tag : (U DefaultContinuationPromptTag OpArg)
|
||||
(PushControlFrame/Prompt-tag stmt)])
|
||||
(cond
|
||||
[(DefaultContinuationPromptTag? tag)
|
||||
(assemble-default-continuation-prompt-tag)]
|
||||
[(OpArg? tag)
|
||||
(assemble-oparg tag)])))]
|
||||
(cond
|
||||
[(DefaultContinuationPromptTag? tag)
|
||||
(assemble-default-continuation-prompt-tag)]
|
||||
[(OpArg? tag)
|
||||
(assemble-oparg tag)])))]
|
||||
|
||||
[(PopControlFrame? stmt)
|
||||
"MACHINE.control.pop();"]
|
||||
|
|
@ -231,21 +334,21 @@ EOF
|
|||
(format "MACHINE.env.push(~a);" (string-join
|
||||
(build-list (PushEnvironment-n stmt)
|
||||
(lambda: ([i : Natural])
|
||||
(if (PushEnvironment-unbox? stmt)
|
||||
"[undefined]"
|
||||
"undefined")))
|
||||
(if (PushEnvironment-unbox? stmt)
|
||||
"[undefined]"
|
||||
"undefined")))
|
||||
", ")))]
|
||||
[(PopEnvironment? stmt)
|
||||
(let: ([skip : OpArg (PopEnvironment-skip stmt)])
|
||||
(cond
|
||||
[(and (Const? skip) (= (ensure-natural (Const-const skip)) 0))
|
||||
(format "MACHINE.env.length = MACHINE.env.length - ~a;"
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]
|
||||
[else
|
||||
(format "MACHINE.env.splice(MACHINE.env.length - (~a + ~a), ~a);"
|
||||
(assemble-oparg (PopEnvironment-skip stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]))]
|
||||
(cond
|
||||
[(and (Const? skip) (= (ensure-natural (Const-const skip)) 0))
|
||||
(format "MACHINE.env.length = MACHINE.env.length - ~a;"
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]
|
||||
[else
|
||||
(format "MACHINE.env.splice(MACHINE.env.length - (~a + ~a), ~a);"
|
||||
(assemble-oparg (PopEnvironment-skip stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt)))]))]
|
||||
|
||||
[(PushImmediateOntoEnvironment? stmt)
|
||||
(format "MACHINE.env.push(~a);"
|
||||
|
|
@ -254,7 +357,7 @@ EOF
|
|||
(format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)))]
|
||||
[else
|
||||
(assemble-oparg (PushImmediateOntoEnvironment-value stmt))])])
|
||||
val-string))]
|
||||
val-string))]
|
||||
[(Comment? stmt)
|
||||
;; TODO: maybe comments should be emitted as JavaScript comments.
|
||||
""])))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user