О кодах, загрузке и компиляции.

Автор: Кулик Алексей aka kpblc | Дата: 9 Декабрь 2009 · 2 коммент. 

Почти худлит получится, я думаю. Но тем не менее, поделиться хочется.

Разговор будет о том, как хранить созданные коды, как их загружать и компилировать. Естественно, что все написанное – сугубо личное мнение, и работать во всех условиях не будет. Но, может быть, кому-то и пригодится. Поехали?

Как уже договаривались в части О форматировании кодов, имена функций будут достаточно уникальными. Но имена функций именами, а в файлы их тоже как-то “засовывать” надо.

Можно, конечно, сохранять коды как “tmp.lsp”, “MyCoolCode.lsp” и т.п. Только ориентироваться в них будет нереально. В свое время я принял для себя технологию, прекрасно описанную в книге “САПР на базе AutoCAD – как это делается” (замечу, что книгу можно назвать библией разработчика для AutoCAD. Именно разработчика, а не программиста – понятия все же немного разные в данном контексте). Так вот, в каждом файле хранится одна и только одна функция. Имя файла совпадает с именем функции, в нем определенной. В одном файле не может быть определено больше одной функции (хотя файлы без определения функций, или “самовыполняемые”, конечно, существовать могут). Плюсы подобного подхода расписывать я не буду – они и так достаточно очевидны. А вот про минусы хотелось бы поговорить особо…

До версии AutoCAD 2006 загрузка и компиляция организованных подобным образом lisp-кодов особых трудностей не вызывала лично у меня: если их надо загружать, то просто получить весь перечень файлов, к этому списку применить конструкцию вида

(foreach file lst
(load file)
)

и все работало замечательно. При программном создании проекта компиляции порядок следования имен функций также не имел никакого значения.

Но в 2008 ситуация изменилась. При компиляции fas-файла порядок следования функций становится критичным. Недавно, переустановив AutoCAD 2008, я столкнулся еще и с тем, что порядок загрузки некомпилированных (!) lisp-кодов тоже может вызывать ошибки.

Поясню на примере.

Допустим, есть функция

(defun fun1()
;;; File : c:\\fun1.lsp
; что-то делает
)

и

(defun fun2()
;;; File : c:\\fun2.lsp
; что-то делает
(fun1)
; опять что-то делает
)

; и теперь самовызов
(fun2)

В версиях до 2006 включительно конструкции

(load "c:\\fun1.lsp")
(load "c:\\fun2.lsp")

и

(load "c:\\fun2.lsp")
(load "c:\\fun1.lsp")

были абсолютно равнозначны. В 2008 уже сработает только первый вариант. И это только касательно загрузки! Если в компиляционный файл последовательность загрузки функций будет “не та”, то все, пиши пропало – проект работать не будет.

При всем при этом: если все (подчеркиваю – все!) используемые в проекте коды закинуть в один файл, то все замечательно загружается и компилируется.

Я не знаю – то ли руки у меня кривые, то ли “так и задумывалось”, но выкручиваться пришлось весьма серьезно.

Сначала определимся с задачей и с методикой ее решения.

  1. Необходимо получить все файлы. Поскольку ситуация, когда коды раскиданы по компьютеру и / или по всей сети, все же выходит за рамки нормальной, предполагаем, что коды лежат каком-то определенном каталоге (и, возможно, структурированы по каким-то подкаталогам. Глубина вложений заранее неизвестна. Количество файлов, кстати, тоже).
  2. Имена функций отвечают требованиям именования
  3. Имена файлов, содержащих рабочие коды, тоже опознаются по какой-то маске (в идеале, конечно, надо помнить, что “Имя файла совпадает с именем функции, в нем определенной.” Но идеал идеалом, а жизнь способна подкидывать самые разные сюрпризы). Дополнительно: имена файлов, содержащих незагружаемые функции (временные коды, отладочные коды и т.п.) также можно как-то распознать. Например, по слову debug в имени файла.
  4. Функция должна быть самодостаточна и содержать в себе все необходимые компоненты, даже если они дублируют уже написанные коды.

Приступим…

Получается, что нам необходимо передавать (мы же делаем универсальный код, который можно будет элементарно переносить с машины на машину!) или 2, или 3 параметра: путь, по которому находятся lsp-файлы; маска имени файла; маска имени функции (которая по идее должна совпадать с маской имен файлов). Оставим, пожалуй, именно 3 параметра:

  1. Имя каталога: строка, без вариантов. Концевой слеш можно указывать, можно не указывать: сделать обработку несложно, а вот запутаться при последующих вызовах – запросто).
  2. Маска имени файла: расширение lsp указывать не надо – и так понятно, что нас сейчас интересует именно lisp. А так – получается, что тоже строка, сформированная для применения в wcmatch
  3. Маска имени функции: фактически то же самое.

Итак, сначала найдем (или напишем, или модифицируем) функцию, которая просто проходит по всем подкаталогам указанного пути и возвращает список файлов по маске и сразу ее переименовываем. Функция у нас будет локальной:

(defun fun_browsefiles-in-directory-nested (path mask)
;;;    Функция возвращает список файлов указанной маски, находящихся в
;;; заданном каталоге
;;;    Параметры вызова:
;;; path  путь к корневому каталогу. nil недопустим
;;;   mask  маска имени файла. nil или список недопустим
;;;    Примеры вызова:
  ;|
(fun_browsefiles-in-directory-nested "c:\\documents" "*.dwg")
;;; На основе кода ZZZ с caduser.ru
|;
  (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 fun_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

Допустим, у нас маска имени файла имеет вид “lispru-*,_lispru-*,dwgru-*,_dwgru-*” (мы же договаривались, что расширение файла не указываем!) И много ли файлов будет отвечать именно этой маске? Мне кажется, что ни одного. Поэтому преобразуем строку в список и обрабатывать будем уже список масок (да, я знаю, что можно было начальный код fun_browsefiles-in-directory-nested сделать другим. Но так же скучно и неинтересно! А функция преобразования строки в список с указанным разделителем нам и так понадобится)

(if (not vl-conv-string-to-list)
    (defun vl-conv-string-to-list (string separator)
;;; Код написан Евгением Елпановым
      (cond
        ((or (= string "") (not string)) nil)
        ((setq i (vl-string-search separator string))
         (cons (substr string 1 i)
               (vl-conv-string-to-list
                 (substr string (+ (strlen separator) 1 i))
                 separator
                 ) ;_ end of vl-conv-string-to-list
               ) ;_ end of cons
         )
        (t (list string))
        ) ;_ end of cond
      ) ;_ end of defun
    )

Имя этой функции немного “нестандартное”. Я в свое время сознательно пошел на этот шаг: уж больно часто она используется. Параметры вызова в общем-то очевидны: обрабатываемая строка и разделитель.

Ну и “до кучи” напишем функцию обратного преобразования: списка строковых значений в одну строку.

  (if (not vl-conv-list-to-string)
    (defun vl-conv-list-to-string (lst sep)
      (if lst
        (strcat (car lst)
                (apply (function strcat)
                       (mapcar (function (lambda (x) (strcat sep x))) (cdr lst))
                       ) ;_ end of apply
                ) ;_ end of strcat
        ""
        ) ;_ end of if
      ) ;_ end of defun
    ) ;_ end of if

В результате вместо

(setq file_list (fun_browsefiles-in-directory-nested path file-mask)

получаем

(setq file_list (apply
                  (function append)
                  (mapcar
                    (function (lambda (x) (fun_browsefiles-in-directory-nested path x)))
                    (mapcar (function (lambda (x) (strcat (vl-filename-base x) ".lsp")))
                            (vl-conv-string-to-list file-mask ",")
                            ) ;_ end of mapcar
                    ) ;_ end of mapcar
                  ) ;_ end of apply
      ) ;_ end of setq

Ладно, список файлов мы получили. Но этого мало. Необходимо как минимум определить список вызываемых функций внутри каждого файла. А заодно и имя функции:

(mapcar
  (function
    (lambda (file / handle lst flag str res)
      (setq handle (open file "r"))
      (while (setq str (read-line handle))
        (if (/= (setq str (vl-string-trim " \t" str)) "")
          (cond
            ((wcmatch (strcase str)
                      (strcat "(defun *"
                              ) ;_ end of strcat
                      ) ;_ end of wcmatch
             )
            ((and (not flag) (wcmatch str "*;|*"))
             (setq flag t)
             )
            ((and flag (not (wcmatch str "*|;*"))))
            ((and flag (wcmatch str "*|;*")) (setq flag nil))
            ((and (not flag) (not (wcmatch str "*;|*,*|;*")))
             (setq
               lst (cons
                     (vl-string-trim
                       " "
                       (if (not (wcmatch str "*\";\"*"))
                         (car (vl-conv-string-to-list str ";"))
                         (car (vl-conv-string-to-list str "; "))
                         ) ;_ end of if
                       ) ;_ end of vl-string-trim
                     lst
                     ) ;_ end of cons
               ) ;_ end of setq
             )
            ) ;_ end of cond
          ) ;_ end of if
        ) ;_ end of while
      (close handle)
      (if lst
        (setq res
               (list
                 (cons "file" file)
                 (cons
                   "defun"
                   (vl-remove-if-not
                     (function
                       (lambda (x)
                         (wcmatch (strcase x t) function-mask)
                         ) ;_ end of lambda
                       ) ;_ end of function
                     (mapcar
                       (function
                         (lambda (x)
                           (cadr (vl-conv-string-to-list x " "))
                           ) ;_ end of lambda
                         ) ;_ end of function
                       (vl-remove-if-not
                         (function
                           (lambda (x)
                             (wcmatch (strcase x t) "*(defun *")
                             ) ;_ end of lambda
                           ) ;_ end of function
                         (reverse lst)
                         ) ;_ end of vl-remove-if-not
                       ) ;_ end of mapcar
                     ) ;(strcase (vl-filename-base file) t))
                   ) ;_ end of cons
                 (cons
                   "calls"
                   (apply
                     (function append)
                     (fun_list-dublicates-remove
                       (mapcar
                         (function
                           (lambda (x)
                             (mapcar
                               (function
                                 (lambda (b)
                                   (strcase
                                     (vl-string-trim " ()\"" b)
                                     t
                                     ) ;_ end of strcase
                                   ) ;_ end of lambda
                                 ) ;_ end of function
                               (vl-remove-if-not
                                 (function
                                   (lambda (a)
                                     (wcmatch (strcase a t) function-mask)
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 (vl-conv-string-to-list x " ")
                                 ) ;_ end of vl-remove-if-not
                               ) ;_ end of mapcar
                             ) ;_ end of lambda
                           ) ;_ end of function
                         (vl-remove-if
                           (function
                             (lambda (x)
                               (or (not x)
                                   (not (wcmatch
                                          (strcase x t)
                                          (mapcar
                                            (function (lambda (a)
                                                        (strcat "*[ (]" a "*")
                                                        ) ;_ end of lambda
                                                      ) ;_ end of function
                                            (vl-conv-string-to-list
                                              function-mask
                                              ","
                                              ) ;_ end of vl-conv-string-to-list
                                            ) ;_ end of mapcar
                                          ) ;_ end of wcmatch
                                        ) ;_ end of not
                                   ) ;_ end of or
                               ) ;_ end of lambda
                             ) ;_ end of function
                           (reverse lst)
                           ) ;_ end of vl-remove-if
                         ) ;_ end of mapcar
                       ) ;_ end of fun_list-dublicates-remove
                     ) ;_ end of apply
                   ) ;_ end of cons
                 ) ;_ end of list
              ) ;_ end of setq
        ) ;_ end of if
      ) ;_ end of lambda
    ) ;_ end of function
  (apply
    (function append)
    (mapcar
      (function (lambda (x) (fun_browsefiles-in-directory-nested path x)))
      (mapcar (function (lambda (x) (strcat (vl-filename-base x) ".lsp")))
              (vl-conv-string-to-list file-mask ",")
              ) ;_ end of mapcar
      ) ;_ end of mapcar
    ) ;_ end of apply
  ) ;_ end of mapcar

Теперь у нас получен список из элементов вида ((”file” . <Имя файла>) (”defun” <Список имен определяемых функций>) (”calls” . <Список вызываемых функций>)). Осталось самое интересное: определить для них приоритет. Те функции, которые не вызывают никакие другие пользовательские функции, получат приоритет, равный 0. Вызывающие 1 функцию – приоритет равен 1. А если функция вызывает функцию, которая вызывает функцию, которая… Почти “Дом, который построил Джек” :) Приоритеты вызываемых функций должны суммироваться.

Если с подготовкой все просто:

(mapcar
  (function
    (lambda (x)
      (append
        (setq x (subst
                  (cons "calls"
                        (vl-remove-if
                          (function
                            (lambda (a)
                              (member a (cdr (assoc "defun" x)))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (cdr (assoc "calls" x))
                          ) ;_ end of vl-remove-if
                        ) ;_ end of cons
                  (assoc "calls" x)
                  x
                  ) ;_ end of subst
              ) ;_ end of setq
        (list (cons "prior"
                    (if (or (not (cdr (assoc "calls" x)))
                            (not (cdr (assoc "defun" x)))
                            ) ;_ end of or
                      0
                      ) ;_ end of if
                    ) ;_ end of cons
              ) ;_ end of list
        ) ;_ end of cons
      ) ;_ end of lambda
    ) ;_ end of function
  file_list
  ) ;_ end of mapcar

то с определением приоритета голову немного поломать пришлось. Понятно, что функция должна быть рекурсивной. И это фактически единственное, что понятно сразу.

В общем, вот результат:

(defun loc:eval-prior (item / calls res _defun)
  (cond
    ((setq res (cdr (assoc "prior" item))) (1+ res))
    (t
     (setq calls     (strcase
                       (vl-conv-list-to-string (cdr (assoc "calls" item)) ",")
                       ) ;_ end of strcase
           _defun    (cdr (assoc "defun" item))
           file_list (subst
                       (subst (cons "prior"
                                    (setq res
                                           (1+
                                             (apply
                                               (function +)
                                               (mapcar
                                                 (function
                                                   loc:eval-prior
                                                   ) ;_ end of function
                                                 (vl-remove-if-not
                                                   (function
                                                     (lambda (a)
                                                       (or (not (cdr (assoc "defun" a)))
                                                           (wcmatch
                                                             (strcase
                                                               (vl-conv-list-to-string
                                                                 (cdr (assoc "defun" a))
                                                                 ","
                                                                 ) ;_ end of vl-conv-list-to-string
                                                               ) ;_ end of strcase
                                                             calls
                                                             ) ;_ end of wcmatch
                                                           ) ;_ end of or
                                                       ) ;_ end of lambda
                                                     ) ;_ end of function
                                                   file_list
                                                   ) ;_ end of vl-remove-if-not
                                                 ) ;_ end of mapcar
                                               ) ;_ end of apply
                                             ) ;_ end of 1+
                                          ) ;_ end of setq
                                    ) ;_ end of cons
                              (assoc "prior" item)
                              item
                              ) ;_ end of subst
                       (if _defun
                         (car (vl-remove-if-not
                                (function
                                  (lambda (x)
                                    (= (cdr (assoc "defun" x)) _defun)
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                file_list
                                ) ;_ end of vl-remove-if-not
                              ) ;_ end of car
                         (car (vl-remove-if-not
                                (function
                                  (lambda (x)
                                    (= (strcase (vl-conv-list-to-string
                                                  (cdr (assoc "calls" x))
                                                  ","
                                                  ) ;_ end of vl-conv-list-to-string
                                                ) ;_ end of strcase
                                       calls
                                       ) ;_ end of =
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                file_list
                                ) ;_ end of vl-remove-if-not
                              ) ;_ end of car
                         ) ;_ end of if
                       file_list
                       ) ;_ end of subst
           ) ;_ end of setq
     res
     )
    ) ;_ end of cond
  ) ;_ end of defun

Полностью законченный код выдам чуть позже, и так пост длинный получился…

Размещено в Код LISP, Новости, Функции LISP · Метки: ,



Комментарии

Есть 2 коммент. к “О кодах, загрузке и компиляции.”
  1. seaotter56 пишет:
    10 Февраль 2010 в 9:00

    вопрос немножко не по теме: нельзя ли код печатать полностью без полос прокрутки? неудобно печатать, чтобы вникнуть и прочитать. спасибо

  2. Кулик Алексей aka kpblc пишет:
    12 Февраль 2010 в 1:05

    Это обусловлено движком сайта. По-другому не получится, как ни крутись.

Поделитесь своим мнением


Я не робот.