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

check-closure-arity appears to be doing something useful

Browse Source
This commit is contained in:
Danny Yoo 2011-03-09 18:09:19 -05:00
parent 10f46fd515
commit 5d691899dd
2 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
assemble.rkt
View File

@ -238,7 +238,7 @@ EOF
(format "return ~a();" (format "return ~a();"
(assemble-location (GotoStatement-target stmt)))] (assemble-location (GotoStatement-target stmt)))]
[(PushControlFrame? stmt) [(PushControlFrame? stmt)
(format "MACHINE.control.push(~a);" (PushControlFrame-label stmt))] (format "MACHINE.control.push(new Frame(~a));" (PushControlFrame-label stmt))]
[(PopControlFrame? stmt) [(PopControlFrame? stmt)
"MACHINE.control.pop();"] "MACHINE.control.pop();"]
[(PushEnvironment? stmt) [(PushEnvironment? stmt)
@ -356,8 +356,9 @@ EOF
(symbol->string (CheckToplevelBound!-name op)))] (symbol->string (CheckToplevelBound!-name op)))]
[(CheckClosureArity!? op) [(CheckClosureArity!? op)
;; fixme (format "if (! (MACHINE.proc instanceof Closure && MACHINE.proc.arity === ~a)) { if (! (MACHINE.proc instanceof Closure)) { throw new Error(\"not a closure\"); } else { throw new Error(\"arity failure\"); } }"
(error 'assemble-op-statement)] (CheckClosureArity!-arity op)
)]
[(ExtendEnvironment/Prefix!? op) [(ExtendEnvironment/Prefix!? op)
(let: ([names : (Listof Symbol) (ExtendEnvironment/Prefix!-names op)]) (let: ([names : (Listof Symbol) (ExtendEnvironment/Prefix!-names op)])

43
test-assemble.rkt
View File

@ -227,6 +227,49 @@
"function,true") "function,true")
;; check-closure-arity. This should succeed.
(void (E-many (list (make-GotoStatement (make-Label 'afterLambdaBody))
'closureStart
(make-PerformStatement (make-InstallClosureValues!))
(make-GotoStatement (make-Label 'theEnd))
'afterLambdaBody
(make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 0)
(make-Const "hello"))
(make-AssignImmediateStatement (make-EnvLexicalReference 1)
(make-Const "world"))
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5
(list (make-EnvLexicalReference 0)
(make-EnvLexicalReference 1))))
(make-PopEnvironment 2 0)
(make-PerformStatement (make-CheckClosureArity! 5)))))
;; this should fail, since the check is for 1, but the closure expects 5.
(let/ec return
(with-handlers ([void
(lambda (exn) (return))])
(E-many (list (make-GotoStatement (make-Label 'afterLambdaBody))
'closureStart
(make-PerformStatement (make-InstallClosureValues!))
(make-GotoStatement (make-Label 'theEnd))
'afterLambdaBody
(make-PushEnvironment 2)
(make-AssignImmediateStatement (make-EnvLexicalReference 0)
(make-Const "hello"))
(make-AssignImmediateStatement (make-EnvLexicalReference 1)
(make-Const "world"))
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5
(list (make-EnvLexicalReference 0)
(make-EnvLexicalReference 1))))
(make-PopEnvironment 2 0)
(make-PerformStatement (make-CheckClosureArity! 1)))))
(error 'expected-failure))