Функциональное программирование

       

что может идти за ключом)


;================================================== ; ; свертка/развертка системы текстов ; текст представлен списком ;((Имя Вариант ...)...) ; первое имя в свертке - обозначение системы текстов ; (Элемент ...) ; (Имя Лексема (Варианты)) ; ((пример (ма (ш н) ; (ш а) ) ; ( ш н ) ) ; ((н ина)) ) ;================================================== ; реализация свертки: unic, ass-all, swin, gram, bnf
(defun unic (vac) (remove-duplicates (mapcar ’car vac) )) ;; список уникальных начал
(defun ass-all (Key Vac) ;; список всех вариантов продолжения ( что может идти за ключом) (cond ((Null Vac) Nil) ((eq (caar Vac) Key) (cons (cdar Vac) (ass-all Key (cdr Vac)) )) (T (ass-all Key (cdr Vac)) ) ) )
(defun swin (key varl) (cond ;; очередной шаг свертки или снять скобки при отсутствии вариантов ((null (cdr varl))(cons key (car varl))) (T (list key (gram varl)) ) ))
(defun gram (ltext) ;; левая свертка, если нашлись общие начала ( (lambda (lt) (cond ((eq (length lt)(length ltext)) ltext) (T (mapcar #’(lambda (k) (swin k (ass-all k ltext ) )) lt ) ) ) ) (unic ltext) ) )
(defun bnf (main ltext binds) (cons (cons main (gram ltext)) binds)) ;; приведение к виду БНФ
;=================================================== ; реализация развертки: names, words, lexs, d-lex, d-names, ; h-all, all-t, pred, sb-nm, chain, level1, lang
(defun names (vac) (mapcar ’car vac)) ;; определяемые символы
(defun words (vac) (cond ;; используемые символы ((null vac) NIL) ((atom vac) (cons vac NIL )) (T (union (words(car vac)) (words (cdr vac)))) ))
(defun lexs (vac) (set-difference (words vac) (names vac))) ;; неопределяемые лексемы
(defun d-lex ( llex) ;; самоопределение терминалов (mapcar #’(lambda (x) (set x x) ) llex) ) (defun ( llex)
;; определение нетерминалов (mapcar #’(lambda (x) (set (car x )(cdr x )) ) llex) )
(defun h-all (h lt) ;; подстановка голов (mapcar #’(lambda (a) (cond ((atom h) (cons h a)) (T (append h a)) ) ) lt) )
(defun all-t (lt tl) ;; подстановка хвостов (mapcar #’(lambda (d) (cond ((atom d) (cons d tl)) (T(append d tl)) ) ) lt) )
(defun pred (bnf tl) ;; присоединение предшественников (level1 (mapcar #’(lambda (z) (chain z tl )) bnf) ))
(defun sb-nm (elm tl) ;; постановка определений имен (cond ((atom (eval elm)) (h-all (eval elm) tl)) (T (chain (eval elm) tl)) ) )
(defun chain (chl tl) ;; сборка цепочек (cond ((null chl) tl) ((atom chl) (sb-nm chl tl))
((atom (car chl)) (sb-nm (car chl) (chain (cdr chl) tl) ))
(T (pred (all-t (car chl) (cdr chl)) tl)) ))
(defun level1 (ll) ;; выравнивание (cond ((null ll)NIL) (T (append (car ll) (level1 (cdr ll)) )) ))
(defun lang ( frm ) ;; вывод заданной системы текстов (d-lex (lexs frm)) (d-names frm) (pred (eval (caar frm)) ’(()) ) )
Листинг 8.4.1. Автомат для нахождения всех вхождений некоторой системы слов во входной поток
Закрыть окно



Содержание раздела