Ханойские башни Common Lisp

;;; Создание колышка
(define (peg token count)
 ;; Список p - это "внутренняя структура" колышка
 (let ((p (reverse (generaten count))))
 
 (define (display-peg)
(display token)
 (display ": ")
 (display p)
 (newline))
 
 (define (push-ring! ring)
 (set! p (cons ring p))
 (display-peg))
 
 (define (pop-ring!)
 (let ((ring (car p)))
 (set! p (cdr p))
 (display-peg)
 ring))
 
 (define (peg-token)
 token)
 
 (define (height)
 (length p))
 (lambda (mes)
 (cond ((eq? mes 'display)
(display-peg))
 ((eq? mes 'push-ring)
push-ring!)
 ((eq? mes 'pop-ring)
(pop-ring!))
 ((eq? mes 'token)
(peg-token))
 ((eq? mes 'height)
(height))
(else
error "peg -- неизвестное сообщение" mes)))))
 
;;; Печать колышка
(define (display-peg peg)
 (peg 'display))
 
;;; Поместить кольцо на колышек
(define (push-ring! peg ring)
 ((peg 'push-ring) ring))
 
;;; Изъять кольцо с колышка
(define (pop-ring! peg)
 (peg 'pop-ring))
 
;;; Метка данного колышка
(define (peg-token peg)
 (peg 'token))
 
;;; Высота (число колец) колышка
;;; (для решения задачи так и не понадобилась)
(define (peg-height peg)
 (peg 'height))
 
;;; Вспомогательная функция
;;; создает список из убывающих чисел от number до 1 (включительно)
(define (generaten number)
 (if (= 0 number)
 '()
 (cons number (generaten (- number 1)))))
;;; Функция переноса кольца с колышка peg-from на колышек peg-to
(define (move peg-from peg-to peg)
 (display "Перенос кольца с колышка '")
 (display (peg-token peg-from))
 (display "' на колышек '")
 (display (peg-token peg-to))
 (display "':")
 (newline)
 (push-ring! peg-to (pop-ring! peg-from))
* (display-peg peg))
 
(define (hanoi-tower height)
 (let ((a (peg 'a height))
(b (peg 'b 0))
 (c (peg 'c 0)))
 (display "Состояние колышков до переноса:")
 (newline)
 (display-peg a)
 (display-peg b)
 (display-peg c)
 
 ;;; Вся полезная работа происходит тут
 (let hanoi ((peg-a a)
 (peg-b b)
 (peg-c c)
 (n height))
 (cond ((not (= n 0))
(hanoi peg-a peg-c peg-b (- n 1))
(move peg-a peg-c peg-b)
(hanoi peg-b peg-a peg-c (- n 1))))))
'конец)
 
вывод
> (hanoi-tower 4)
Состояние колышков до переноса:
a: (1 2 3 4)
b: ()
c: ()
Перенос кольца с колышка 'a' на колышек 'b':
a: (2 3 4)
b: (1)
c: ()
Перенос кольца с колышка 'a' на колышек 'c':
a: (3 4)
c: (2)
b: (1)
Перенос кольца с колышка 'b' на колышек 'c':
b: ()
c: (1 2)
a: (3 4)
Перенос кольца с колышка 'a' на колышек 'b':
a: (4)
b: (3)
c: (1 2)
Перенос кольца с колышка 'c' на колышек 'a':
c: (2)
a: (1 4)
b: (3)
Перенос кольца с колышка 'c' на колышек 'b':
c: ()
b: (2 3)
a: (1 4)
Перенос кольца с колышка 'a' на колышек 'b':
a: (4)
b: (1 2 3)
c: ()
Перенос кольца с колышка 'a' на колышек 'c':
a: ()
c: (4)
b: (1 2 3)
Перенос кольца с колышка 'b' на колышек 'c':
b: (2 3)
c: (1 4)
a: ()
Перенос кольца с колышка 'b' на колышек 'a':
b: (3)
a: (2)
c: (1 4)
Перенос кольца с колышка 'c' на колышек 'a':
c: (4)
a: (1 2)
b: (3)
Перенос кольца с колышка 'b' на колышек 'c':
b: ()
c: (3 4)
a: (1 2)
Перенос кольца с колышка 'a' на колышек 'b':
a: (2)
b: (1)
c: (3 4)
Перенос кольца с колышка 'a' на колышек 'c':
a: ()
c: (2 3 4)
b: (1)
Перенос кольца с колышка 'b' на колышек 'c':
b: ()
c: (1 2 3 4)
a: ()
конец