1  
   2  ;; simple definition of factorial:
   3  ;; this will run into trouble due to precision
   4  
   5  (define (factorial-1  num)
   6    (if (= num 0)
   7        1
   8        (* num (factorial-1 (- num 1)))))
   9  
  10  ;; factorial using imported GMP package:
  11  ;; it works better but runs into trouble with too deep call stack
  12  
  13  (load "gmp.lsp")
  14  
  15  (define (factorial-gmp num)
  16    (if (= num 0)
  17        "1"
  18        (GMP:* (string num) (factorial-gmp (- num 1)))))
  19  
  20  ;; Finally, a trampoline style recursive definition of
  21  ;; factorial which simulates tail recursive implementation
  22  ;; avoiding call stack overflow
  23  
  24  (define (factorial-acc num acc)
  25    (if (= num 0)
  26        (land (string acc))
  27        (bounce factorial-acc (- num 1) (GMP:* (string num) (string acc)))))
  28  
  29  (define (factorial-trampoline num)
  30    (trampoline factorial-acc num 1))
  31  
  32  (define (trampoline func num acc)
  33    (set 'bouncer (bounce func num acc))
  34    (catch (while 1
  35  		(set 'bouncer (bouncer))
  36  		(if (not (lambda? bouncer))
  37  		    (throw bouncer)))))
  38  
  39  (define (bounce)
  40    (letex (func (args 0) num (args 1) acc (args 2))
  41  	(lambda() (func num acc))))
  42  
  43  (define (land val)  val)
  44