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

assembled closures

Browse Source
This commit is contained in:
Danny Yoo 2011-03-09 15:30:29 -05:00
parent 13e7159ed9
commit f4b6dd8805
3 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
assemble.rkt
View File

@ -302,13 +302,15 @@ EOF
(cond
[(GetCompiledProcedureEntry? op)
"proc.label"]
[(MakeCompiledProcedure? op)
(format "new Closure(~a, ~a, ~a)"
(format "new Closure(~a, ~a, [~a], ~s)"
(MakeCompiledProcedure-label op)
(MakeCompiledProcedure-arity op)
(string-join (map assemble-env-reference
(MakeCompiledProcedure-closed-vals op))
", "))]
", ")
(symbol->string (MakeCompiledProcedure-label op)))]
[(ApplyPrimitiveProcedure? op)
(error 'assemble-op-expression)]

6
runtime.js
View File

@ -78,9 +78,11 @@ var Primitives = {
// A closure consists of its free variables as well as a label
// into its text segment.
var Closure = function(env, label) {
this.env = env;
var Closure = function(label, arity, closedVals, displayName) {
this.label = label;
this.arity = arity;
this.closedVals = closedVals;
this.displayName = displayName;
};

11
test-assemble.rkt
View File

@ -22,7 +22,7 @@
(printf "Running ~s ...\n" (syntax->datum #'expr))
(let ([actual expr])
(unless (equal? actual expected)
(raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
(raise-syntax-error #f (format "Expected ~s, got ~s" expected actual)
#'stx))
(printf "ok.\n\n")))))]))
@ -124,3 +124,12 @@
(make-Const 12345)))
"MACHINE.env[0]")
"12345")
;; A do-nothing closure
(test (E-many (list (make-GotoStatement (make-Label 'afterLambda))
'closureStart
(make-GotoStatement (make-Label 'afterLambda))
'afterLambda
(make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'afterLambda 0 '())))
"MACHINE.val.displayName")
"afterLambda")