home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume1 / 8707 / 49 / ctak.cl < prev    next >
Lisp/Scheme  |  1990-07-13  |  889b  |  38 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; File:         ctak.cl
  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. ; Language:     Common Lisp
  8. ; Package:      User
  9. ; Status:       Public Domain
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;;; CTAK -- A version of the TAK function that uses the CATCH/THROW facility.
  13.  
  14. (defun ctak (x y z)
  15.   (catch 'ctak (ctak-aux x y z)))
  16.  
  17. (defun ctak-aux (x y z)
  18.   (declare (fixnum x y z))
  19.   (cond ((not (< y x))    ;xy
  20.      (throw 'ctak z))
  21.     (t (ctak-aux
  22.          (catch 'ctak
  23.            (ctak-aux (1- x)
  24.              y
  25.              z))
  26.          (catch 'ctak
  27.            (ctak-aux (1- y)
  28.              z
  29.              x))
  30.          (catch 'ctak
  31.            (ctak-aux (1- z)
  32.              x
  33.              y))))))
  34.  
  35. ;;; call: (ctak 18 12 6)
  36.  
  37. (run-benchmark "CTAK" '(ctak 18 12 6))
  38.