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