Write a program that is to reason about stacking blocks on a table. We might have a situation like:




Each block that records its properties will be represented by "defstruct" as follows:
(defstruct block
(name nil)
(color nil)
(ison 'table)
(isunder nil))
1. We keep a list of all the block records in the global variable *BLOCKS*. The function "start-world" (10 pts) initializes the global variable *BLOCKS*.
2. The function "new-block" (10 pts) sets up a block record, adds it to the block’s world model, and makes sure that it starts out sitting on the table.
3. The function "clear-top?" (20 pts) is used to check whether a block has nothing on top of it.
4. The function "lift-off" (20 pts) picks up a block which has nothing on top of it and puts it on the table.
5. The function "(put-on 'A 'B)" checks whether the block already exists in the *BLOCKS* (10 pts) and, if they exist, put block A on block B (10 pts).
6. Further, the functions "put-on" and "lift-off" are to return error messages if they are made to refer to a block with something on top of it, or to one that cannot be moved (10 pts).
7. The function "print-world" (20 pts) is to display the state of our block’s world. With these functions, we can set up a model of our block’s world.

(defparameter *blocks* nil)

(defstruct *block*
  (name nil)
  (color nil)
  (ison 'table)
  (isunder nil))


(defun start-world ()
  (cond ((null *blocks*)
       *blocks*)
     (t
      (setq *blocks* nil))))


(defun new-block (name color)
  (let ((*new-block*
(make-*block* :name name :color color)))
   (setf *blocks* (append *blocks* (list *new-block*)))))


(defun find-block (blocks-list name)
    (cond ((null blocks-list)    
   nil
   )
  ((equal (*block*-name (car blocks-list)) name)
   (car blocks-list))
  (t
   (find-block (cdr blocks-list) name))))


(defun clear-top? (name)
 (let ((finded-block (find-block *blocks* name)))
   (null (*block*-isunder finded-block))))


(defun helper-block (name new-name check ison isunder)
  (let ((found-block (find-block *blocks* name))
(new-found-block (find-block *blocks* new-name)))
    (cond ((null found-block)
  (format nil "Unkown block named: ~s" name))
 ((null new-found-block)
  (format nil "Unkown block named: ~s" new-name))
 ((clear-top? check)
  (setf (*block*-ison found-block) ison)
  (setf (*block*-isunder new-found-block) isunder)
  t )
 (t
  (format nil "Block ~s supports something." check)))))


(defun put-on (name new-name)
  (helper-block name new-name new-name new-name name))


(defun lift-off (name)
  (if (eq (*block*-ison (find-block *blocks* name)) 'table)
      (format nil "Block ~s supports something." name)
      (helper-block name (*block*-ison (find-block *blocks* name)) name  'table nil)))


(defun print-world ()
  (labels ((list-helper (blocks-list)     
    (cond ((null blocks-list)
   nil)
  (t
   (let* ((current-block (car blocks-list))
  (name (*block*-name current-block))
  (color (*block*-color current-block))
  (ison (*block*-ison current-block))
  (isunder (*block*-isunder current-block))
  )
     (format t "Block ~S (~S) is on ~S and supports ~S" name color (ison-helper ison) (null-helper isunder))
     (list-helper (cdr blocks-list))))))
  (null-helper (isunder)
    (if (null isunder)
'nothing
isunder))
  (ison-helper (ison)
    (if (eq ison 'table)
"the table"
ison)))

    (list-helper *blocks*)))

谁帮我解释下。标注一下。我有点不明白。