Table of Contents

UPDATED 11.12.2011. Теперь сброс слотов системы происходит с помощью ф-ии reset-system и класса proto-system. Упростился код ф-ии do-defsystem.

(сказаное ниже относится к версии 2.019.2)

Определение системы начинается с выполнения формы (defsystem …). Этот тот самый DEFSYSTEM, который используется в *.asd файлах. Макрос DEFSYSTEM всего лишь "переходник", он генерирует код вызывающий обычную ф-ию DO-DEFSYSTEM:

<source> (defmacro defsystem (name &body options) `(apply 'do-defsystem ',name ',options)) </source>

… почему так? Просто выяснилось что макрос для определения системы не нужен. Но не заставлять же всех переписывать asd файлы:) Макросы вообще не стоит использовать без особой необходимости.

DO-DEFSYSTEM.

<source> (defun* do-defsystem (name &rest options &key (pathname nil pathname-arg-p) (class 'system) defsystem-depends-on &allow-other-keys) …) </source>

Ф-ия выполнит кое-какие настройки и вызовет в самом конце, ф-ию PARSE-COMPONENT-FORM для анализа переданных опций и создания на их основе иерархии объектов, используемой остальными подсистемами. Работа ф-ии состоит из следующих этапов:

  1. Всё обёртывается кодом вводящим динамический контекст, в котором переменная systems-being-defined гарантировано содержит хэш-таблицу. В этой хэш-таблице будут регистрироваться системы, определяющиеся в данный момент (используется это подсистемой поиска):

<source> (with-system-definitions () …) </source>

  1. Определяется локальный контекст со следующими переменными:

    2.1 name - получает строковое (каноническое) имя системы: (coerce-name name)

    2.2 registered - получает объект системы, если она уже зарегистрирована:

<source> (system-registered-p name) </source>

2.2.1 system-registered-p ищет систему в хэш-таблице defined-systems, используя её имя как ключ:

<source> (gethash (coerce-name name) defined-systems) </source>

2.2.2 В итоге registered получает значение как пару вида (если система всё-таки зарегистрирована):

<source> (3525158896 . #<SYSTEM "some-system">) </source>

… в которой первый элемент является временной меткой (когда система была зарегистрирована), а второй экземпляром класса SYSTEM или его наследника.

2.3 registered! - получает объект системы в любом случае.

2.3.1 Если система была зарегистрирована обновляется временная метка регистрации и переменная получает ту же точечную пару что содержится в registered:

<source> (let (… (registered! (if registered (rplaca registered (get-universal-time)) …)))) </source>

2.3.2 Если система не была зарегистрирована, то создаётся новый объект системы и регистрируется:

<source> (let (… (registered! (if registered (…) (register-system (make-instance 'system :name name)))) </source>

… register-system выводит сообщение о регистрации системы и сохраняет точечную пару из метки времени и новой системы в хэше defined-systems с ключом name.

2.4 system - получает объект системы слотами name и source-file (который представляет собой собственно путь к загружаемому в данный момент файлу), остальные слоты сбрасываются с помощью reset-system:

<source> (let (… (system (reset-system (cdr registered!)

:name name :source-file (load-pathname))) …)) </source>

… load-pathname в том числе обрабатывает символические ссылки, с помощью ф-ии resolve-symlinks* (будут ли разрешаться символические ссылки, определяется специальной переменной resolve-symlinks, которая по умолчанию установлена в T). Ф-ия reset-system сбрасывает слоты следующим образом: сначала класс системы заменяется на некий прототип класса системы, содержащий слоты который сбрасывать не нужно, а затем изменяется на класс system:

<source> (defun* reset-system (system &rest keys &key &allow-other-keys) (change-class (change-class system 'proto-system) 'system) (apply 'reinitialize-instance system keys)) </source>

… класс proto-system на данный момент содержит лишь один слот - name.

2.5 component-options - получает все опции системы, кроме :class (remove-keys '(:class) options). Это происходит из-за того, что обработка этой опции будет происходить здесь же, в ф-ии do-defsystem.

  1. В хэш-таблицу, в упомянутой выше динамической переменной systems-being-defined (которая определена в дин. контексте, вводимого макросом with-system-definitions), записывается полученный объект системы:

<source> (setf (gethash name systems-being-defined) system </source>

  1. Подгузка систем указанных ключом defsystem-depends-on, то есть тех систем, которые необходимы не просто для работы определяемой системы, а для её непосредственного определения и регистрирования:

<source> (apply 'load-systems defsystem-depends-on) </source>

… в этих системах следует размещать код, расширяющий функциональность ASDF. Например, классы-наследники от классов с предком component и от классов с предком operation. А также свои методы для обобщённых ф-ий (например для perform) специализирующихся на своих классах и/или добавляющих функциональность с помощью стандартных комбинаторов :before, :after и :around.

  1. Изменяется класс системы, если в опциях системы указан ключ :class со значением отличным от 'system :

<source> (let ((class (class-for-type nil class))) (unless (eq (type-of system) class) (change-class system class))) </source>

  1. Теперь самое главное, обработка указанных опций-ключей. Осуществляется она функцией parse-component-form, которая вызывается с аргументом NIL в качестве parent (ведь определяемая система является корневым элементом создаваемой иерархии, для других компонентов parent будет устанавливаться в соответствии с глубиной вложенности) и списком необходимых опций. Этот список формируется с помощью component-options (помните определяли локальную переменную, выкидывая ключ :class ?), опции: ":module name" и вычисляемого пути к компоненту, который мог быть указан ключом :pathname (если он не был указан, путь вычисляется как директория в которой находится .asd файл). В простом случае сформированный список опций будет выглядеть подобно следующему:

<source> (:module "exp-system"

:depends-on nil

:components ((:module "src"

:pathname ""

:components ((:file "file1") (:static-file "static.txt") (:file "file2" :depends-on ("file1")) (:file "file3" :depends-on ("file1")))))) </source>