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

ctak is running as well

Browse Source
This commit is contained in:
Danny Yoo 2011-03-13 16:57:48 -04:00
parent 5aeeb62037
commit 8cd2085f86
4 changed files with 88 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
runtime.js
View File

@ -129,6 +129,11 @@ var Primitives = (function() {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return firstArg[1];
},
'not': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return (!firstArg);
},
'null' : NULL,
@ -150,7 +155,11 @@ var Primitives = (function() {
'call/cc': new Closure(callCCEntry,
1,
[],
"call/cc")
"call/cc"),
'call-with-current-continuation': new Closure(callCCEntry,
1,
[],
"call-with-current-continuation")
};
})();

5
simulator-primitives.rkt
View File

@ -33,9 +33,12 @@
(make-closure call/cc-label
1
'()))
(define call-with-current-continuation call/cc)
(define e (exp 1))
(define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= cons list car cdr
sub1
display newline displayln
@ -52,4 +55,4 @@
display
displayln
newline)
#:constants (null pi e call/cc)))
#:constants (null pi e call/cc call-with-current-continuation)))

32
test-browser-evaluate.rkt
View File

@ -93,3 +93,35 @@
)
"32")
(test '(begin
(define (ctak x y z)
(call-with-current-continuation
(lambda (k)
(ctak-aux k x y z))))
(define (ctak-aux k x y z)
(cond ((not (< y x)) ;xy
(k z))
(else (call-with-current-continuation
(ctak-aux
k
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- x 1)
y
z)))
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- y 1)
z
x)))
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- z 1)
x
y))))))))
(displayln (ctak 18 12 6)))
"7\n")

42
test-compiler.rkt
View File

@ -561,5 +561,47 @@
(error "puzzle failed: ~s" (get-output-string op)))))
;; ctak
(test (begin
(define (ctak x y z)
(call-with-current-continuation
(lambda (k)
(ctak-aux k x y z))))
(define (ctak-aux k x y z)
(cond ((not (< y x)) ;xy
(k z))
(else (call-with-current-continuation
(ctak-aux
k
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- x 1)
y
z)))
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- y 1)
z
x)))
(call-with-current-continuation
(lambda (k)
(ctak-aux k
(- z 1)
x
y))))))))
(ctak 18 12 6))
7)
;(simulate (compile (parse '42) 'val 'next))
;(compile (parse '(+ 3 4)) 'val 'next)