Отображения и функционалы

(DEFUN f-all (Pred Set ) . . . )

(DEFUN f-ex (Pred Set ) . . . )

(( имя_понятия объяснение ) ... ) - 
	двухуровневый список, в котором
   имя_понятия - атом, обозначающий 
	определяемое понятие,
   объяснение - последовательность строк и/или атомов, 
   строки не требуют определения, 
	а атомы должны получить 
   определения в процессе разработки, но, возможно, 
   еще не все слова удалось объяснить.

Словарь правилен
или
Есть неправильные цепочки
имя_понятия1 ... имя_понятияN
   |___________________|______ 
   начала неправильных цепочек
и/или
Есть неопределенные понятия
имя_понятия1 ... имя понятияN
   |___________________|_______ 
   имена неопределенных понятий
(слова перечисляются в порядке включения в словарь.)

(( автокод язык_программирования 
	<используется для создания>
   операционная_система <и> транслятор) 
( язык_программирования <задается множеством правил 
	для написания> программ)
( операционная_система <комплекс> программа
   <управляющих решением задач на 
	имеющемся оборудовании>)
( транслятор <компилирующая> программа)
( программа <описание> алгоритм 
	<решения задачи на соответствующем языке>)
( алгоритм <точно определенное правило действий>)
)

(( а-к яп <используется для создания> ос <и> сп)
( яп <задается множеством правил для написания> пр)
( ос <комплекс> пр <управляющих решением 
	задач на имеющемся оборудовании>)
( сп <компилирующая> пр)
( пр <описание> алг <решения задачи на 
	соответствующем языке>)
( алг <точно определенное правило действий>)
)

;;=== Лексикон****) - проверка корректности ==
;; Предполагается, что из теста уже 
;; отфильтрованы строки,
;; т.к. они не влияют на логику анализа корректности 

(DEFUN NAMES (VAC) (MAPCAR 'CAR VAC))
;; определяемые имена - список левых частей

(DEFUN WORDS (VAC) (COND
;; используемые имена - список правых частей
   ((NULL VAC) NIL)
  (T (UNION (CDAR VAC) (WORDS (CDR VAC))))
))
(DEFUN UNDEF (VAC) (SET-DIFFERENCE (WORDS VAC)
   (NAMES VAC)))
;; неопределенные имена - список висячих ссылок
(DEFUN CIRCLE (V)
;; проверка термина на явный цикл
   (COND ((NULL (CDR V)) NIL)

      ((MEMBER (CAR V) (CDR V)) (CAR V))
      (T NIL)
   ))

(DEFUN CIRC-V (VAC) (MAPCAR 'CIRCLE VAC))
;; список явных циклов с NIL-ами на нециклах

(DEFUN MASKA (ARG XXX) (COND (XXX NIL) (T ARG)))
;; ВЫБОР, ЕСЛИ NIL

(DEFUN DEL-CIR (AL XL) (DELETE NIL
   (MAPCAR 'MASKA AL XL)))
;; стирание непомеченных определений, т.е. циклов

(DEFUN SKOBKI (LL) (COND((NULL LL)NIL)
      ((NULL (CAR LL)) (SKOBKI (CDR LL)) )
      ((ATOM (CAR LL))(CONS(CAR LL)
         (SKOBKI(CDR LL))) )
     (T (UNION (CAR LL) (SKOBKI (CDR LL)) ))
   ))
;; раскрыть скобки на один уровень

(DEFUN ONESTP (VC)(SETQ VAC VC)
;; однократная постановка всего словаря

   (MAPCAR '(LAMBDA (X) (CONS (CAR X)
         (SKOBKI (SUBLIS VAC (CDR X)))
      )) VC ))

  (DEFUN CLEAN-S (LINE XL)
(COND ((NULL XL) LINE)
   (T (CLEAN-S (DELETE (CAR XL) LINE)(CDR XL) ))
))

(DEFUN CLEAN-U (VC XL) (SETQ WL XL)

;; стирание заданного списка слов => висячих ссылок

(MAPCAR '(LAMBDA (XX) (SETQ X XX)
         (CONS (CAR X)
            (CLEAN-S (CDR X) WL)
   )) VC ))

  (DEFUN CVR (VAC)(DELETE NIL (CVR-D
         (DEL-CIR VAC (CIRC-V VAC))
   (DELETE NIL(UNION (CIRC-V VAC) NIL)))))
;; список всех циклов полного словаря - без
;; висячих ссылок

(DEFUN CVR-D (VC CCL)
   (PROG (VAC CL CV DCV CLEANV)
(SETQ VAC (CLEAN-U VC CCL))
(SETQ CL CCL)

;; пополнение списка циклов со второго шага
LAB (COND ((WORDS VAC)
   (SETQ CV (CIRC-V VAC))
   (SETQ DCV (DELETE NIL CV))
   (SETQ CLEANV (CLEAN-U (DEL-CIR VAC CV) DCV))
     (SETQ VAC (ONESTP CLEANV))
     (SETQ CL (APPEND DCV CL))
(GO LAB)
   ))
(RETURN CL)
))

(DEFUN VAC-OK (VAC) (PROG (VC UL CL)
;; ПРОВЕРКА СЛОВАРЯ НА КОРРЕКТНОСТЬ
   (SETQ VC VAC)
   (SETQ UL (UNDEF VC))
   (SETQ CL (CVR (CLEAN-U VAC UL)))

(COND ((EQ UL CL) (RETURN(PRINT 'OK)) )
      ; = лишь если пусты <> корректность словаря
   ( CL (PRINT (LIST 'CIRCLES CL))) )

(COND (UL (RETURN (PRINT (LIST 'UNDEFINED UL))) )
   (T (RETURN (LIST 'CIRCLE CL))) )
))

(DEFUN map-el (fn xl)
   (COND
      (xl (CONS  (fn (CAR xl) )
         ; применяем первый аргумент как функцию
         ; к первому элементу второго аргумента
      (map-el fn (CDR xl) )
) ) ) )