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

Автор: | Дата: 9 Декабрь 2009 · 5 коммент. 

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

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

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

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

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

1
2
3
(foreach file lst
(load file)
)

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

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

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

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

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

и

1
2
3
4
5
6
7
8
9
(defun fun2()
;;; File : c:\\fun2.lsp
; что-то делает
(fun1)
; опять что-то делает
)

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

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

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

и

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

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

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

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

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

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

Приступим...

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

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

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

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
(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 сделать другим. Но так же скучно и неинтересно! А функция преобразования строки в список с указанным разделителем нам и так понадобится)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
(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
    )

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

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

1
2
3
4
5
6
7
8
9
10
11
12
  (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

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

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

получаем

1
2
3
4
5
6
7
8
9
10
(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

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

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(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. А если функция вызывает функцию, которая вызывает функцию, которая... Почти "Дом, который построил Джек" :) Приоритеты вызываемых функций должны суммироваться.

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

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
(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

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

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

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
(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 · Метки: ,



Комментарии

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

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

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

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

  3. Василий пишет:
    22 Октябрь 2010 в 13:55

    Приветствую Алексей! ----> "Полностью законченный код выдам чуть позже, и так пост длинный получился…"
    Где же можно с ним ознакомиться?

  4. Кулик Алексей aka kpblc пишет:
    26 Октябрь 2010 в 0:48

    Я добавил пост: http://autolisp.ru/2010/10/25/load-compile-write2/
    Продолжение следует :) Правда, сейчас запарка жуткая на работе, когда снова доберусь - не знаю :(

Трэкбэки

Узнайте, что другие говорят про эту заметку...
  1. О кодах, загрузке и компиляции. Часть 3 : AutoLISP / VisualLISP пишет:
    8 Июнь 2011 в 15:08

    [...] продолжение поста “О кодах, загрузке и компиляции” Нда, что-то я совсем перестал высказываться тут, [...]



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


Я не робот.