что может идти за ключом)
|
;================================================== ; ; свертка/развертка системы текстов ; текст представлен списком ;((Имя Вариант ...)...) ; первое имя в свертке - обозначение системы текстов ; (Элемент ...) ; (Имя Лексема (Варианты)) ; ((пример (ма (ш н) ; (ш а) ) ; ( ш н ) ) ; ((н ина)) ) ;================================================== ; реализация свертки: 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. Автомат для нахождения всех вхождений некоторой системы слов во входной поток |
| Закрыть окно |
