suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changed TestAndJump to emit else statements

Browse Source
This commit is contained in:
Danny Yoo 2011-08-05 15:32:18 -04:00
parent 31d4be5b3f
commit 63cfe79d76
2 changed files with 36 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
js-assembler/assemble.rkt
View File

@ -173,38 +173,39 @@ EOF
(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
(define test (TestAndJumpStatement-op stmt))
(: test-code String)
(define test-code (cond
[(TestFalse? test)
(format "if (~a === false) { ~a }"
(assemble-oparg (TestFalse-operand test))
jump)]
(format "if (~a === false)"
(assemble-oparg (TestFalse-operand test)))]
[(TestTrue? test)
(format "if (~a !== false) { ~a }"
(assemble-oparg (TestTrue-operand test))
jump)]
(format "if (~a !== false)"
(assemble-oparg (TestTrue-operand test)))]
[(TestOne? test)
(format "if (~a === 1) { ~a }"
(assemble-oparg (TestOne-operand test))
jump)]
(format "if (~a === 1)"
(assemble-oparg (TestOne-operand test)))]
[(TestZero? test)
(format "if (~a === 0) { ~a }"
(assemble-oparg (TestZero-operand test))
jump)]
(format "if (~a === 0)"
(assemble-oparg (TestZero-operand test)))]
[(TestPrimitiveProcedure? test)
(format "if (typeof(~a) === 'function') { ~a }"
(assemble-oparg (TestPrimitiveProcedure-operand test))
jump)]
(format "if (typeof(~a) === 'function')"
(assemble-oparg (TestPrimitiveProcedure-operand test)))]
[(TestClosureArityMismatch? test)
(format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a)) { ~a }"
(format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a))"
(assemble-oparg (TestClosureArityMismatch-closure test))
(assemble-oparg (TestClosureArityMismatch-n test))
jump)])
String))]
(assemble-oparg (TestClosureArityMismatch-n test)))]))
`(,test-code
"{"
,@(assemble-block-statements (BasicBlock-stmts
(hash-ref blockht (TestAndJumpStatement-label stmt)))
blockht)
"} else {"
,@(assemble-block-statements (rest stmts) blockht)
"}")]
[(GotoStatement? stmt)
(default stmt)]

2
tests/test-parse-bytecode.rkt
View File

@ -369,7 +369,7 @@
;; Variable reference
(check-equal? (run-my-parse #'(#%variable-reference x))
(make-Top (make-Prefix (list (make-GlobalBucket 'x)))
(make-Top (make-Prefix (list #f (make-GlobalBucket 'x)))
(make-VariableReference (make-ToplevelRef 0 0 #f #t))))
;; todo: see what it would take to run a typed/racket/base language.