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

@ -130,6 +130,11 @@ var Primitives = (function() {
return firstArg[1]; return firstArg[1];
}, },
'not': function(arity, returnLabel) {
var firstArg = MACHINE.env[MACHINE.env.length-1];
return (!firstArg);
},
'null' : NULL, 'null' : NULL,
'null?': function(arity, returnLabel) { 'null?': function(arity, returnLabel) {
@ -150,7 +155,11 @@ var Primitives = (function() {
'call/cc': new Closure(callCCEntry, 'call/cc': new Closure(callCCEntry,
1, 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 (make-closure call/cc-label
1 1
'())) '()))
(define call-with-current-continuation call/cc)
(define e (exp 1)) (define e (exp 1))
(define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= cons list car cdr (define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= cons list car cdr
sub1 sub1
display newline displayln display newline displayln
@ -52,4 +55,4 @@
display display
displayln displayln
newline) 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") "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))))) (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)) ;(simulate (compile (parse '42) 'val 'next))
;(compile (parse '(+ 3 4)) 'val 'next) ;(compile (parse '(+ 3 4)) 'val 'next)