changed TestAndJump to emit else statements

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

View File

@ -173,39 +173,40 @@ EOF
(default stmt)] (default stmt)]
[(TestAndJumpStatement? stmt) [(TestAndJumpStatement? stmt)
(default stmt) (define test (TestAndJumpStatement-op stmt))
#;(let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)]
[jump : String (assemble-jump (: test-code String)
(make-Label (TestAndJumpStatement-label stmt)))]) (define test-code (cond
;; to help localize type checks, we add a type annotation here. [(TestFalse? test)
(ann (cond (format "if (~a === false)"
[(TestFalse? test) (assemble-oparg (TestFalse-operand test)))]
(format "if (~a === false) { ~a }" [(TestTrue? test)
(assemble-oparg (TestFalse-operand test)) (format "if (~a !== false)"
jump)] (assemble-oparg (TestTrue-operand test)))]
[(TestTrue? test) [(TestOne? test)
(format "if (~a !== false) { ~a }" (format "if (~a === 1)"
(assemble-oparg (TestTrue-operand test)) (assemble-oparg (TestOne-operand test)))]
jump)] [(TestZero? test)
[(TestOne? test) (format "if (~a === 0)"
(format "if (~a === 1) { ~a }" (assemble-oparg (TestZero-operand test)))]
(assemble-oparg (TestOne-operand test))
jump)] [(TestPrimitiveProcedure? test)
[(TestZero? test) (format "if (typeof(~a) === 'function')"
(format "if (~a === 0) { ~a }" (assemble-oparg (TestPrimitiveProcedure-operand test)))]
(assemble-oparg (TestZero-operand test))
jump)] [(TestClosureArityMismatch? test)
[(TestPrimitiveProcedure? test) (format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a))"
(format "if (typeof(~a) === 'function') { ~a }" (assemble-oparg (TestClosureArityMismatch-closure test))
(assemble-oparg (TestPrimitiveProcedure-operand test)) (assemble-oparg (TestClosureArityMismatch-n test)))]))
jump)] `(,test-code
[(TestClosureArityMismatch? test) "{"
(format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a)) { ~a }" ,@(assemble-block-statements (BasicBlock-stmts
(assemble-oparg (TestClosureArityMismatch-closure test)) (hash-ref blockht (TestAndJumpStatement-label stmt)))
(assemble-oparg (TestClosureArityMismatch-n test)) blockht)
jump)]) "} else {"
String))] ,@(assemble-block-statements (rest stmts) blockht)
"}")]
[(GotoStatement? stmt) [(GotoStatement? stmt)
(default stmt)] (default stmt)]

View File

@ -369,8 +369,8 @@
;; Variable reference ;; Variable reference
(check-equal? (run-my-parse #'(#%variable-reference x)) (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)))) (make-VariableReference (make-ToplevelRef 0 0 #f #t))))
;; todo: see what it would take to run a typed/racket/base language. ;; todo: see what it would take to run a typed/racket/base language.
(void (void