Как найти функции, определенные в fas/vlx/arx…

Автор: | Дата: 23 Октябрь 2011 · Прокомментировать 

Тут возникла задачка - надо определить функции, определенные в загружаемом компилированном файле...

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

То есть если будет функция, например, такая:

1
2
3
4
5
6
(defun test (/ a b c)
  (setq a (atoms-family 1)
        b 1
        c (atoms-family 1)
        ) ;_ end of setq
  ) ;_ end of defun

То, проанализировав во время выполнения значения a и c, можно будет найти, что в а присутствует определение функции TEST, а в с, помимо этого, еще и определение переменной А.

Следовательно, можно написать функцию, которая сначала получит список имеющихся фунций и переменных, потом загрузит файл, снова получит список функций и переменных, сравнит начальный и конечный списки и выдаст разницу. Естественно, что надо исключить локальные переменные, и имя функции. Ну, в качестве первой прикидки:

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 lispru-defuns (file / err start res)
                     ;|
*    Определение имен функций и переменных, загруженных fas- или vlx-файлом
*    Параметры вызова:
  file    полный путь к загружаемому файлу, с указанием расширения.
|;
  (if (and (findfile file)
           (not (vl-file-directory-p file))
           ) ;_ end of and
    (progn
      (setq start (mapcar (function strcase) (atoms-family 1)))
      (if (not (vl-catch-all-error-p
                 (setq err (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (cond
                                   ((member (strcase (vl-filename-extension file) t)
                                            '(".lsp" ".fas" ".vlx")
                                            ) ;_ end of member
                                    (load file)
                                    )
                                   ((= (strcase (vl-filename-extension file) t) ".arx")
                                    (arxload file)
                                    )
                                   ((= (strcase (vl-filename-extension file) t) ".dll")
                                    (command "_.netload" file)
                                    )
                                   ) ;_ end of cond
                                 (foreach item (mapcar (function strcase) (atoms-family 1))
                                   (if (not (member item start))
                                     (setq res (cons item res))
                                     ) ;_ end of if
                                   ) ;_ end of foreach
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
        (progn
          (if (setq res (vl-sort (vl-remove-if
                                   (function
                                     (lambda (x)
                                       (member (strcase x) '("START" "FILE" "LISPRU-DEFUNS"))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   res
                                   ) ;_ end of vl-remove-if
                                 '>
                                 ) ;_ end of vl-sort
                    ) ;_ end of setq
            (princ (apply (function strcat)
                          (cons (car res)
                                (mapcar
                                  (function
                                    (lambda (x)
                                      (strcat "\n" x)
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (cdr res)
                                  ) ;_ end of mapcar
                                ) ;_ end of cons
                          ) ;_ end of apply
                   ) ;_ end of princ
            ) ;_ end of if
          ) ;_ end of progn
        (alert (strcat "Ошибка загрузки файла "
                       file
                       ":\n"
                       (vl-catch-all-error-message err)
                       ) ;_ end of strcat
               ) ;_ end of alert
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

Исходный код

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



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


Я не робот.