Разработать программу для игры "Ним"

(defpackage Nim
  (:use :cl)
  (:export play))
 
(in-package Nim)
 
(defvar *tree* (make-array 10 :adjustable t))
 
(defun play () 
  (declare (special *tree*))
  (format t "~&Давайте сыграем в Ним.~%Тот кто берет последним, проигрывает.~%")
  (loop (let* ((max (read-int "Максимальное взятие за один раз?"))
               (n (read-int "Со скольки мы начинаем?"))
               (*tree* (check-length max *tree*)))
          (catch 'gameover
            (play-a-game max n (if (aref *tree* max)
                                   (check-length n (aref *tree* max))
                                   (newtree max n))))
          (unless (yes-or-no-p "~&Хотите начать новую игру? ")
            (return))))
    (format t "~&Это было весело! Приходите еще.~%~%")
    (values))
 
(defun play-a-game (max n state)
  (declare (special max n state))
  (if (y-or-n-p "~&Вы хотите ходить первым? ")
      (loop (opp-play) (I-play))
      (loop (I-play) (opp-play))))
 
(defun I-play ()
  (declare  (special n max))
  (let ((mymax (min n max)))
    (cond
     ((zerop n)
      (format t "~&Я победил!~%~%")
      (throw 'gameover nil))
     ((or (winning-state n) (losing-state n))
      (Iplay (play-of-state n)))
     (t (or (non-losing-play n mymax) (losing-play n max))))))
 
(defun non-losing-play (n max)
  (loop for x from max downto 1 do
        (when (unknown-state (- n x))
          (Iplay x)
          (return T))))
 
(defun losing-play (n max)
  (record-state n 'lose 1)
  (loop for x from 1 to max do
        (record-state (+ n x) 'win x))
  (Iplay 1))
 
(defun Iplay (x)
  (declare (special n))
  (format t "~&Я беру ~A, осталось ~A~%"
            x (decf n x)))
 
(defun opp-play ()
  (declare (special n max))
  (cond
    ((zerop n)
     (format t "~&Вы выиграли!~%~%")
     (throw 'gameover nil))
    (t (format t "~&Тогда остается ~A.~%"
               (setf n
                     (- n
                        (read-int "Сколько вы берете?" (min n max))))))))
 
(defun newtree (max n)
  (declare (special *tree*))
  (let ((state (make-array (1+ n) :adjustable t)))
    (declare (special state))
    (setf (aref *tree* max) state)
    (record-state 0 'win 0)
    state))
 
(defun check-length (n array)
  (if (< n (array-dimension array 0))
      array
      (adjust-array array (1+ n))))
 
(defun winning-state (x)
  (declare (special state))
  (eql (car (aref state x)) 'WIN))
 
(defun losing-state (x)
  (declare (special state))
  (eql (car (aref state x)) 'LOSE))
 
(defun unknown-state (x)
  (declare (special state))
  (null (aref state x)))
 
(defun play-of-state (x)
  (declare (special state))
  (cdr (aref state x)))
 
(defun record-state (x status play)
  (declare (special state))
  (setf state (check-length x state)
        (aref state x) (cons status play)))
 
(defun read-int (prompt &optional max)
  (format t "~&~A " prompt)
    (loop (let ((x (read)))
            (when (and (integerp x)
                       (plusp x)
                       (or (null max) (<= x max)))
              (return-from read-int x))
            (format t "~&Должно быть целое положительное число")
            (when max (format t " не больше, чем ~A" max))
            (format t ".~%Попробуйте еще: "))))