scheme/ctak.scm at master · boynton/scheme · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
;;; ctak.scm

(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
	       (lambda (k)		; (was missing)
		 (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)))))))) )


(do ((i 10 (- i 1))) ((zero? i)) (ctak 18 12 6))