О кодах, загрузке и компиляции. Часть 3
В продолжение поста "О кодах, загрузке и компиляции"
Нда, что-то я совсем перестал высказываться тут, попробую компенсировать
Продолжаем разбираться с методикой создания компилированного проекта. Сначала надо подумать, какие параметры будут передаваться в нашу супер-пупер функцию, а потом - что она должна возвращать.
Итак, в первую очередь необходимо указать каталог, внутри которого будет осуществляться поиск lsp-файлов. Скажу честно, dcl я не включаю в компиляцию принципиально, т.к. создаю диалоги программно, на лету: Диалоговые окна dcl – зло? Или все же нет?
Следом надо указать маску имени файла. Все, что не попадает под эту маску - идет лесом.
Также можно указать маску имени функции. Отлично будет работать, если внутри одного lsp-файла определена только одна функция, и при этом она именована. Если используются конструкции типа
1 | (apply '(lamdba(x) (* x 23)) '(1 2 3) |
, то третье условие "выкинет" такую функцию. Предположим, что мы, как честные программисты, таких вольностей себе не позволяем, поэтому оставим на месте этот самый третий параметр (хотя и головняка он может добавить - мама не горюй).
Получается, что определение функции будет наподобие
1 2 | (defun _lispru-get-load-proirity (directory file-mask defun-mask) ) ;_ end of defun |
Что должна возвращать функция? Казалось бы, элементарный список вида
1 2 3 4 5 | '((<ИмяФайла1> . <ПриоритетЗагрузки>) (<ИмяФайла2> . <ПриоритетЗагрузки>) <...> (<ИмяФайлаN> . <ПриоритетЗагрузки>) ) |
вполне устроит. Но вот какая закавыка... Крайне желательно еще иметь и имена функций, определенных в этих файлах. Наверняка понадобится при формировании prj-файла. Поэтому результатом должно быть
1 2 3 4 5 | '((("file" . <ИмяФайла1>) ("defun" . <ОпределеннаяФункция>) ("prior" . <ПриоритетЗагрузки>)) (("file" . <ИмяФайла2>) ("defun" . <ОпределеннаяФункция>) ("prior" . <ПриоритетЗагрузки>)) <...> (("file" . <ИмяФайлаN>) ("defun" . <ОпределеннаяФункция>) ("prior" . <ПриоритетЗагрузки>)) ) |
Почему сделан список из точечных пар? Да работать с ним проще - assoc и все дела...
Так, с началом определились, теперь начинаем использовать чужие наработки Прежде всего - получение списка имен файлов:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | (defun fun_browsefiles-in-directory-nested (path mask) ;| * Функция возвращает список файлов указанной маски, находящихся в * заданном каталоге * Параметры вызова: path путь к корневому каталогу. nil недопустим mask маска имени файла. nil или список недопустим Примеры вызова: (fun_browsefiles-in-directory-nested "c:\\documents" "*.dwg") |; (apply (function append) (cons (if (vl-directory-files path mask) (mapcar (function (lambda (x) (strcat path "\" x))) (vl-directory-files path mask) ) ;_ end of mapcar ) ;_ if (mapcar (function (lambda (x) (fun_browsefiles-in-directory-nested (strcat path "\" x) mask ) ;_ end of kpblc-browsefiles-in-directory-nested ) ;_ end of lambda ) ;_ end of function (vl-remove ".." (vl-remove "." (vl-directory-files path nil -1)) ) ;_ end of vl-remove ) ;_ mapcar ) ;_ cons ) ;_ end of apply ) ;_ end of defun |
Исходник fun_browsefiles-in-directory-nested
Тут проблема в том, что vl-directory-files "не понимает" регулярные выражения, прекрасно понимаемые wcmatch. Ну, поменять мы не можем это дело, а вот обойти - запросто. Достаточно написать функцию, преобразовывающую строку в список
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | (defun fun_conv-string-to-list (string separator / i) ;| * Функция разбора строки. Возвращает список либо точечную пару. * Параметры вызова: * string разбираемая строка * separator символ, используемый в качестве разделителя частей * Примеры вызова: (fun_conv-string-to-list "1;2;3;4;5;6" ";") ;'(1 2 3 4 5 6) (fun_conv-string-to-list "1;2" ";") ;'(1 2) * За основу взяты уроки Евгения Елпанова по рекурсиям |; (cond ((= string "") nil) ((setq i (vl-string-search separator string)) (cons (substr string 1 i) (fun_conv-string-to-list (substr string (+ (strlen separator) 1 i)) separator ) ;_ end of fun_conv-string-to-list ) ;_ end of cons ) (t (list string)) ) ;_ end of cond ) |
Исходник fun_conv-string-to-list
Ну и до кучи обратную функцию - преобразование списка в одну строку:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | (defun fun_conv-list-to-string (lst sep) ;| * Преобразование списка в строку * Параметры вызова: lst обрабатываемй список sep разделитель. nil -> " " |; (setq ;lst (mapcar (function fun_conv-value-to-string) lst) sep (if sep sep " " ) ;_ end of if ) ;_ end of setq (strcat (car lst) (apply (function strcat) (mapcar (function (lambda (x) (strcat sep x) ) ;_ end of lambda ) ;_ end of function (cdr lst) ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of strcat ) |
Исходник fun_conv-list-to-string
Тэкс, подготовка выполнена. Теперь начинаем пошагово выполняться:
1 | (setq defun-mask (strcase defun-mask t)) |
Теперь получаем из маски имен функций маску вызова функций. Фактически просто добавление впереди каждого элемента открывающей скобки и гарантированное добавление в конец *.
Предполагаем, что вызов нашей функции осуществляется именно как
1 | (lispru-function-call |
а не как
1 2 | ( lispru-function-call |
1 2 3 4 5 6 7 8 9 10 11 12 | (setq call_mask (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat "(" (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun-mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of setq |
И аналогичным образом получаем маску определений функций:
1 2 3 4 5 6 7 8 9 10 11 12 | (setq defun_mask (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat "(defun " (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun-mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of setq |
Теперь начинается самое интересное... Работа со списком файлов.
1 2 3 | ;;; Сначала получим общий список файлов. Это быстрее, чем дважды или ;;; трижды выполнять полный проход. (setq file_lst (fun_browsefiles-in-directory-nested directory "*.lsp")) |
И из этого списка удаляем те файлы, которые не попадают под маску file-mask.
1 2 3 4 5 6 7 8 9 10 11 12 | ;; Удалим ненужные файлы (setq file_lst (vl-remove-if-not (function (lambda (x) (wcmatch (strcase (vl-filename-base x)) file-mask) ) ;_ end of lambda ) ;_ end of function ;; Сначала получим общий список файлов. Это быстрее, чем ;; дважды или трижды выполнять полный проход. (fun_browsefiles-in-directory-nested directory "*.lsp") ) ;_ end of vl-remove-if-not ) ;_ end of setq |
Теперь какие задачи стоят? Правильно, прочитать файл, получить из него имена определенных и вызываемых функций. Выносить это дело в отдельную функцию как-то лениво, все равно будет использоваться mapcar:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | (setq file_lst (mapcar (function (lambda (file) ;;; Здесь чего-то делаем ) ;_ end of lambda ) ;_ end of function ;; Удалим ненужные файлы (vl-remove-if-not (function (lambda (x) (wcmatch (strcase (vl-filename-base x)) file-mask) ) ;_ end of lambda ) ;_ end of function ;; Сначала получим общий список файлов. Это быстрее, чем ;; дважды или трижды выполнять полный проход. (fun_browsefiles-in-directory-nested directory "*.lsp") ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of setq |
поэтому попробуем так (пишу только внутреннюю lambda, остальное пока оставим, как говорится, "за скобками":
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | ;; Сначала читаем файл (setq handle (open file "r")) (while (setq str (read-line handle)) (setq file_cont (cons str file_cont)) ) ;_ end of while (close handle) ;; Переводим в нижний регистр и список реверсируем (setq file_cont (mapcar (function (lambda (x) (strcase x t) ) ;_ end of lambda ) ;_ end of function (reverse file_cont) ) ;_ end of mapcar ) ;_ end of setq |
Вроде пока ничего необычного.
Теперь формируем результат:
1 2 | (list (cons "file" file) ; Ну, тут все ясно (cons "defun" ; Это определяемая функция. |
Вот здесь немного остановимся. Из содержимого файла выбрасывается все, что не попадает под defun_mask (обратите внимание - используется именно локальная переменная!):
1 2 3 4 5 6 7 8 | (vl-remove-if-not (function (lambda (x) (wcmatch x defun_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not |
Теперь из этой белиберды с каждой строки отбрасываем слово "(defun " и получаем список определенных функций (и плевать, что она как правило одна):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | (setq defuns (mapcar (function (lambda (x) (car (fun_conv-string-to-list (vl-string-left-trim "(defun \t" x) " ")) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch x defun_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of setq |
Результат вычислений не зря закинут в отдельную переменную - функция запросто может оказаться рекурсивной, и впоследствии мы получим бесконечный цикл.
Так, теперь получаем список вызовов, ориентируясь на call_mask:
1 2 3 4 5 6 7 8 | (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not |
Тут все понятно, получили списочек. Обрубаем пробелы, символы табуляции и скобки:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar |
И удаляем моменты рекурсивных вызовов:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | (vl-remove-if (function (lambda (x) (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if |
Выполняем окончательную доводку:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | (apply (function append) (mapcar (function (lambda (x) (fun_conv-string-to-list x " ") ) ;_ end of lambda ) ;_ end of function (vl-remove-if (function (lambda (x) (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if ) ;_ end of mapcar ) ;_ end of apply |
И удаляем не попадающие под defun_mask:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | (vl-remove-if-not (function (lambda (x) (wcmatch x (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun_mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of wcmatch ) ;_ end of lambda ) ;_ end of function (apply (function append) (mapcar (function (lambda (x) (fun_conv-string-to-list x " ") ) ;_ end of lambda ) ;_ end of function (vl-remove-if (function (lambda (x) (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of vl-remove-if-not |
В результирующем списке можно запросто получить несколько дублирующихся строк - ведь никто не может гарантировать, что каждая функция будет вызываться только один раз внутри любой другой функции. Посему пишем функцию удаления дубликатов:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | (defun fun_list-dublicates-remove (lst / result) ;| * Функция исключения дубликатов элементов списка * Параметры вызова: * lst обрабатываемый список * Возвращаемое значение: список без дубликатов соседних элементов * Примеры вызова: (fun_list-dublicates-remove '((0.0 0.0 0.0) (10.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0)) nil) ((0.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0)) |; (foreach x lst (if (not (member x result)) (setq result (cons x result)) ) ;_ end of if ) ;_ end of foreach (reverse result) ) ;_ end of defun |
Исходник fun_list-dublicates-remove
И применяем ее:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | (fun_list-dublicates-remove (vl-remove-if-not (function (lambda (x) (wcmatch x (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun_mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of wcmatch ) ;_ end of lambda ) ;_ end of function (apply (function append) (mapcar (function (lambda (x) (fun_conv-string-to-list x " ") ) ;_ end of lambda ) ;_ end of function (vl-remove-if (function (lambda (x) (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of vl-remove-if-not ) |
Ну и результат закидываем в результирующий список.
Суммируя все сказанное, получаем, что в mapcar надо подставлять
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | (list (cons "file" file) (cons "defun" (setq defuns (mapcar (function (lambda (x) (car (fun_conv-string-to-list (vl-string-left-trim "(defun \t" x) " " ) ;_ end of fun_conv-string-to-list ) ;_ end of car ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch x defun_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of setq ) ;_ end of cons (cons "calls" (fun_list-dublicates-remove (vl-remove-if-not (function (lambda (x) (wcmatch x (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun_mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of wcmatch ) ;_ end of lambda ) ;_ end of function (apply (function append) (mapcar (function (lambda (x) (fun_conv-string-to-list x " ") ) ;_ end of lambda ) ;_ end of function (vl-remove-if (function (lambda (x) (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask ) ;_ end of wcmatch ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of vl-remove-if-not ) ;_ end of fun_list-dublicates-remove ) ;_ end of cons ) ;_ end of list |
То есть, объединяя все вместе, получаем:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | (setq defun-mask (strcase defun-mask t) call_mask (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat "(" (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun-mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string defun_mask (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat "(defun " (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun-mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string file_lst (mapcar (function (lambda (file / handle str file_cont) (setq handle (open file "r")) (while (setq str (read-line handle)) (setq file_cont (cons str file_cont)) ) ;_ end of while (close handle) (setq file_cont (mapcar (function (lambda (x) (strcase x t))) (reverse file_cont))) (list (cons "file" file) (cons "defun" (setq defuns (mapcar (function (lambda (x) (car (fun_conv-string-to-list (vl-string-left-trim "(defun \t" x) " ")) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch x defun_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of setq ) ;_ end of cons (cons "calls" (fun_list-dublicates-remove (vl-remove-if-not (function (lambda (x) (wcmatch x (fun_conv-list-to-string (mapcar (function (lambda (x) (strcat (vl-string-right-trim "*" x) "*") ) ;_ end of lambda ) ;_ end of function (fun_conv-string-to-list defun-mask ",") ) ;_ end of mapcar "," ) ;_ end of fun_conv-list-to-string ) ;_ end of wcmatch ) ;_ end of lambda ) ;_ end of function (apply (function append) (mapcar (function (lambda (x) (fun_conv-string-to-list x " ") ) ;_ end of lambda ) ;_ end of function (vl-remove-if (function (lambda (x) ;; Удалить самовызовы (member x defuns) ) ;_ end of lambda ) ;_ end of function (mapcar (function (lambda (x) (vl-string-trim "() \t" x) ) ;_ end of lambda ) ;_ end of function (vl-remove-if-not (function (lambda (x) (wcmatch (vl-string-left-trim " \t" x) call_mask) ) ;_ end of lambda ) ;_ end of function file_cont ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of vl-remove-if ) ;_ end of mapcar ) ;_ end of apply ) ;_ end of vl-remove-if-not ) ;_ end of fun_list-dublicates-remove ) ;_ end of cons ) ;_ end of list ) ;_ end of lambda ) ;_ end of function (fun_browsefiles-in-directory-nested path "*.lsp") ) ;_ end of mapcar ) ;_ end of setq |
Теперь осталась сущая мелочь: определить приоритет функции. Определять будем числом, при этом - чем число меньше, тем приоритет выше. Эту интересность оставлю на потом.