Решение формально-логической задачи на Lisp

;; Проверка правильности рассаживания
 
(defun check (x)
  (apply 'and (mapcar (lambda (z)
                       (let ((a (car z))
                             (b (cadr z))) 
                        (cond ((and (eq a 'masha) (not (eq b 'sofa)) (not (eq b 'chair))) t)
                              ((eq a 'masha) nil)
                              ((and (eq a 'grisha) (not (eq b 'sofa))) t)
                              ((eq a 'grisha) nil)
                              (t t)))) x)))
 
;; Построение всех перестановок 
 
(defun inj (s a &optional (l nil) (r s))
   (cond ((null s) (list (append l (list a))))
         (t (cons (append l (list a) r) (inj (cdr s) a (append l (list (car s))) (cdr r))))))
 
(defun perms (s)
  (cond ((null (cdr s)) (list s))
        (t (let ((ss (perms (cdr s))))
             (apply 'append (mapcar (lambda (x) (inj x (car s))) ss))))))
 
;; Решение задачи
 
(defun task nil
  (let* ((p '(masha grisha alex))
         (f '(sofa chair stool))
         (fs (perms f)))
     (iter (for b in fs)
       (let ((g (mapcar 'list p b)))
         (when (check g) (printline g))))))
 
==> TASK
 
(task)
 
((MASHA STOOL) (GRISHA CHAIR) (ALEX SOFA))