Стили и методы программирования


Пример 8.4.1


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

Закрыть окно






Начало    Вперед