1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2; File:         ctak.sch
3; Description:  The ctak benchmark
4; Author:       Richard Gabriel
5; Created:      5-Apr-85
6; Modified:     10-Apr-85 14:53:02 (Bob Shaw)
7;               24-Jul-87 (Will Clinger)
8; Language:     Scheme
9; Status:       Public Domain
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
12; The original version of this benchmark used a continuation mechanism that
13; is less powerful than call-with-current-continuation and also relied on
14; dynamic binding, which is not provided in standard Scheme.  Since the
15; intent of the benchmark seemed to be to test non-local exits, the dynamic
16; binding has been replaced here by lexical binding.
17
18; For Scheme the comment that follows should read:
19;;; CTAK -- A version of the TAK procedure that uses continuations.
20
21;;; CTAK -- A version of the TAK function that uses the CATCH/THROW facility.
22
23(define (ctak x y z)
24  (call-with-current-continuation
25   (lambda (k)
26     (ctak-aux k x y z))))
27
28(define (ctak-aux k x y z)
29  (cond ((not (< y x))  ;xy
30         (k z))
31        (else (call-with-current-continuation
32               (ctak-aux
33                k
34                (call-with-current-continuation
35                 (lambda (k)
36                   (ctak-aux k
37                             (- x 1)
38                             y
39                             z)))
40                (call-with-current-continuation
41                 (lambda (k)
42                   (ctak-aux k
43                             (- y 1)
44                             z
45                             x)))
46                (call-with-current-continuation
47                 (lambda (k)
48                   (ctak-aux k
49                             (- z 1)
50                             x
51                             y))))))))
52
53;;; call: (ctak 18 12 6)
54
55(let ((input (with-input-from-file "input.txt" read)))
56  (time (let loop ((n 8) (v 0))
57          (if (zero? n)
58              v
59              (loop (- n 1)
60                    (ctak 18 12 (if input 6 0)))))))
61
62