home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume1 / 8707 / 49 / stak.cl < prev    next >
Lisp/Scheme  |  1990-07-13  |  995b  |  43 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; File:         stak.cl
  3. ; Description:  STAK benchmark
  4. ; Author:       Richard Gabriel
  5. ; Created:      12-Apr-85
  6. ; Modified:     12-Apr-85 09:54:50 (Bob Shaw)
  7. ; Language:     Common Lisp
  8. ; Package:      User
  9. ; Status:       Public Domain
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;;; STAK -- The TAKeuchi function with special variables instead of parameter passing.
  13.  
  14. (defvar *x*)
  15. (defvar *y*)
  16. (defvar *z*)
  17.  
  18. (proclaim '(type fixnum *x* *y* *z*))
  19.  
  20. (defun stak (*x* *y* *z*)
  21.   (stak-aux))
  22.  
  23. (defun stak-aux ()
  24.   (if (not (< *y* *x*))
  25.       *z*
  26.       (let ((*x* (let ((*x* (1- *x*))
  27.              (*y* *y*)
  28.              (*z* *z*))
  29.          (stak-aux)))
  30.         (*y* (let ((*x* (1- *y*))
  31.              (*y* *z*)
  32.              (*z* *x*))
  33.          (stak-aux)))
  34.         (*z* (let ((*x* (1- *z*))
  35.              (*y* *x*)
  36.              (*z* *y*))
  37.          (stak-aux))))
  38.     (stak-aux))))
  39.  
  40. ;;; call:  (stak 18 12 6))
  41.  
  42. (run-benchmark "STAK" '(stak 18 12 6))
  43.