Библиотека функций к Script-fu

Введение

С необходимостью введения в язык Script-fu Объектно-ориентированного стиля программирования я столкнулся на поздних этапах реализации языка функциональной геометрии. Когда в коде появились «свичи/переключатели» и возможность исполнения кода в зависимости от типа входящих данных. Сам то этот «переключатель» написать не сложно, но в развивающемся проекте, постоянно возникают новые типы, изменяются, от каких то приходится отказываться, а ещё есть вариант создания модульных систем, когда в одном варианте существует один набор типов, а вдругом другой, ну а в третьем третий и т. д. И код этого «переключателя» постоянно приходится переписывать, или прибегать к различным «хакам», модифицирующим код в зависимости от того или иного варианта загрузки.

      (cond
       ((eq? (fig-type fig) 'pencil)
        ;;(print "call brush")
        ((fig-brush fig))
        ;;(print "call pencil")
        (gimp-pencil  dw (* 2  num-points) points)
        ;;(print contour)
        )
       ((eq? (fig-type fig) 'brush)
        ((fig-brush fig))
        ;;(print "call paintbrush")
        (gimp-paintbrush-default  dw (* 2  num-points) points))
       ((eq? (fig-type fig) 'shape)
        ((fig-brush fig))
        ;;(gimp-image-select-polygon  img CHANNEL-OP-REPLACE num-points points)
        (gimp-free-select  img (- (* 2  num-points) 1) points  CHANNEL-OP-REPLACE 0 0 0)
        (gimp-edit-fill dw  FOREGROUND-FILL)
        (gimp-selection-none img))
       )

Когда вы в своём проекте сталкиваетесь с подобными конструкциями это явный признак того что вам необходимы языковые конструкции поддерживающие гибкое поведение кода. В объектно‑ориентированном программировании подобное поведение функций называется полиморфным, а сам принцип позволяющий создавать такие функции полиморфизмом.

Обеспечение полиморфного поведения возможно несколькими путями. В большинстве современных языков это поведение обеспечивается через наследование, когда потомки переопределяют реализацию какой либо функции из базового класса, и каждый потомок реагируя на вызов функции исполняет свой, переопределённый код. Но это не единственный подход. В реализации примитивной ОО системы я показал, как полиморфное поведение реализуется через сообщения. В этой системе вообще нет наследования, а полиморфное поведение обеспечивается единым интерфейсом объектов, реализующих индивидуальное поведение при обработке одноимённых сигналов, передаваемых объекту‑процедуре как параметр. Но чисто «сигнальная» модель обеспечения полиморфизма, это был вынужденный хак, т. к. примитивная система ООП не обеспечивала наследования. А наследование является вторым, основополагающим «столпом» ООП. Поэтому в выборе реализации системы ОО я предочёл оперется на вполне привычную систему наследования, которая помимо обеспечания полиморфизма служит и целям экономии в написании кода и его лучшему структурированию, т. е. обеспечивает переиспользование кода базового класса потомками. Используя наследование мы можем описать общее поведение для объектов в базовом классе, а индивидуальное (для каждого класса потомка) поведение определять в классах наследниках.

В качестве образца (идеала) я выбрал CLOS — Common Lisp Object System.

Что такое CLOS.

CLOS это объектная система разработанная для различных реализаций лисп. В CLOS классы объектов определяются отдельно от функций работающих с этими объектами. Т. е фундаментальное отличие от Си++ подобных реализаций ООП состоит в том, что функции работающие с объектами отделены от классов, т.е классы объектов в CLOS не имеют функций-членов. Таким образом функции не принадлежат классам, кроме функций доступа к полям объекта (аццессоров).

;; типичное определение класса в CLOS
(defclass filter-distinct-state ()  
  ((iterator :initarg :iterator)   
   (cyclic-p :initarg :cyclic-p)   
   (fixed :initarg :fixed)   
   (next :initarg :next)   (next-is-end-p)))

;; функция играющая роль инициализирующего конструктора
(defun filter-distinct (iterator &optional (preserve-cyclic-end-p nil))
  (make-instance 'filter-distinct-state         ;;вызов конструктора объекта
                 :iterator iterator
                 :cyclic-p (not preserve-cyclic-end-p)
                 :fixed nil
                 :next nil))

А как же обеспечивается поведение объектов? С помощью ОБОБЩЁННЫХ (generic) функций! Обобщённая функция это как сигнал, как интерфейс, который мы описываем для объекта или группы объектов. Но в самой обобщённой функции мы никаких типов объектов не указываем, описание типов, т.е конкретных классов, происходит в определениях МЕТОДОВ обобщённой функции. Вот там, в определении метода мы и указываем конкретные классы, для указанного набора параметров. И когда при вызове типы объектов переданных в обобщённую функцию совпадут с типами указанным в определении метода, тогда и будет вызван код этого метода. Вот именно таким описанием и обеспеспечивается полиморфизм поведения в CLOS.

;; типичное определение методов обобщённых функций
(defmethod path-iterator-reset ((iterator filter-distinct-state))
  (with-slots ((sub iterator) next next-is-end-p) iterator
    (path-iterator-reset sub)
    (setf next nil
          next-is-end-p nil)))

(defmethod path-iterator-next ((iterator filter-distinct-state))
  (with-slots ((sub iterator) cyclic-p fixed next next-is-end-p) iterator
    (when fixed
      ;; constant result cached
      (return-from path-iterator-next (values-list fixed)))
    (labels ((get-next ()
               "Get the next knot information as a list (not as
               multiple values)."
               (multiple-value-list (path-iterator-next sub)))
   .......

Как правило определять сами обобщённые функции не требуется, это делается автоматически при определении первого метода функции.

В привёденном выше коде встречается очень интересный макрос with-slots позволяющий задать ссылочные имена полей, значительно сокращающий описание доступа к полям объектов, мы просто ссылаемся на ссылочные имена, а уже макрос подставляет функции доступа к полям конкретного объекта.

Для многих программистов, особенно выросших на Java, где владение методами является основой описания классов, это будет разрывом шаблона. Просто ребята, примите это как данность, существует и другой мир, свободный от догматов, в которых методы являются «рабами» классов. CLOS устраняет «классвое рабство методов»!

Хотя на самом деле описание методов в стиле Java даёт некоторое преимущество перед стилем описания методов в CLOS, т. е. немного сокращает количество кода (нет необходимости указывать класс и сам параметр для объекта self, неявно присутствующий в каждом объявлении метода класса), но это преимущество CLOS может легко нивелировать написав специальный макрос, создающий синтаксис при использовании которого создаётся иллюзия, что класс всё-таки владеет методом, но это только видимость, предназначенная чисто для сокращения кода.

Много лет назад, когда я только начинал программировать, я начинал с С++. И уже тогда при проектировании систем (простеньких и детских) я сталкивался с проблемой отнесения метода к одному или к другому классу. И стоял как «буриданов осёл» не зная к какому классу правильно отнести метод, потому что действие метода затрагивало объекты разных классов.

CLOS выступает за свободу функций! Данной дилемы в нем просто не существует!

Конечно, сам CLOS гораздо богаче и гибче приведённого мной примера. CLOS реализуется через MOP (метаобъектный протокол), который позволяет изменять поведение методов обобщённых функций в зависимости от метаклассов объектов, определения самих классов, слотов объектов и других важных компонентов объектной системы. Но в большинстве случаев использование MOP избыточно и нужно лишь для моделирования различных ОО систем.

И одной из самых важных черт CLOS, на мой взгляд, является гомоиконичность. CLOS не вводит новых «объектных» синтаксисов. Люди просто помешались на них, и это мешает им адекватно воспринимать код.

;;"Объектный вызов метода"
obj.method(a b c)

;;обычный функциональный вызов в си стиле.
method(obj a b c)

;;вызов в стиле ЛИСП,
(method obj a b c)

Объектный синтаксис вызова метода ничем не лучше, но он разрушает привычный споб записивызова функций, пытаясь подчеркнуть, что это «особый» способ работы с абстракцией, тогда как ВСЁ ООП это просто ещё один способ работы с абстракциями в коде, который был всегда. Абстракции ООП ничем не лучше обычных функциональных абстракций, просто они «немножко другие», но это не повод ломать синтаксис языка. И CLOS сохраняет базовый синтаксис, за это моя большая благодарность разарботчикам CLOS.

Какую ОО систему я хочу построить?

Как я уже сказал, мой идеал ОО системы это CLOS. Поэтому и для Script-fu я буду строить максимально приближенную к CLOS систему, но максимально упрощённую. Желательно что бы реализованная ОО система была максимально быстрой. Поэтому множество синтаксиса из CLOS я просто выброшу. Ну давайте разберём синтаксис определения класса в CLOS.

(defclass class-name ({superclass-name}*) ({slot-specifier}*) [[class-option]]) 

С именем класса и со списком суперклассов всё понятно, но вот спецификация слотов в CLOS очень загружена различными деталями. Помимо имени в описании слота могут присутствовать следующие спецификаторы.

:accessor
:reader
:initarg
:initform
:allocation

Вместо accessor и reader мы примем соглашение, согласно которому доступ к полю класса будут осуществлять функции начинающиеся с имени класса, далее тире и имя поля/слота. Имя функции изменяющее поле дополняется знаком восклицания. iniarg — инициализирующий аргумент можно сохранить, указывая вместо имени поля, список состоящий из имени поля и инициализирющего значения. initform — в целях упрощения синтаксиса отбросим, отдав инициализацию полей (в зависимости от необходимости) функциям инициализации. allocation это вообще дикость, указывает где располагается поле, либо в экземпляре объекта, либо в классе. Но позвольте, расположене в классе, это всего лишь ещё один вариант глобального состояния, и все переменные класса можно легко заменить обычными глобальными переменными, поэтому и необходимости в их отдельном описании никакого нет. Ну а class‑option относятся к метаобъектному протоколу и их поддержка вообще не нужна. Главное в описании класса это описание полей объекта и список наследования класса.

;;классы будем определять в виде
(defclass name-class (list-parents)
  (list-fields))
  
;;например
(defclass a1 ()
  ( fa1-1
   (fa1-2 1)))

(defclass a2 (a1)
  ((fa2-1 'a)
   (fa2-2 2)
    fa2-3))

Из примера не видно, но определение класса должно поддерживать множественное наследование. Определение обобщённых функций и методов, должно выглядеть приблизительно так же как в CLOS.

;;объявление обобщённой функции
(defgeneric test-gen1 a b c d)

;;объявление методов обобщённой функции
(defmethod (test-gen1 (a a1) (b b1) c d)
  (prn "call test-gen1 with class a1 a: " a ", b: " b ", c: " c ", d: " d))
  
(defmethod (test-gen1 (a a2) (b b1) c d)
  (prn "call test-gen1 with class a2 a: " a ", b: " b ", c: " c ", d: " d))

Обобщённая функция не указывает типы переменных, а вот в определениях методов мы указываем классы для некоторых аргументов, которые они будут принимать, либо их, либо их потомков. И это объявление будет определять шаблон вызова метода. При вызове обобщённой функции, та должна определить типы входных параметров, и в зависимости от них выбрать подходящий метод. Какое попущение я позволяю здесь себе сделать: мы не будем учитывать примитивные типы данных в составлении шаблонов вызовов методов. Т. е. если у нас в определении методов не описаны какие-либо параметры, например c и d, то в шаблоне они будут указаны как :unspec, неопределённые, и фактически данные параметры могут принимать любые типы данных и это не будет учитываться при диспетчеризации для вызова метода. И да, примитивные типы данных не могут являтся спецификаторами для диспетчеризации, только КЛАССЫ! Помимо этого шаблоны методов не допускают применение ключевых, опциональных и остаточных параметров, это бы сильно затруднило работу диспетчера с шаблонами вызова метода, что сильно сказалось бы на скорости работы диспетчера.

Объекты

Определившись с пожеланиями, или ещё можно сказать с требованиями, можно приступать к проектированию реализации, а для этого надо понять, что собой будут представлять у нас объекты, или как говорят в CLOS — ИНСТАНСЫ (INSTANCE). Вариантов несколько, ранее я уже определял структуры, очень удобная вещь на базе вектора, обеспечивает быстрый доступ к произвольному полю. Вариант со списком, можно отмести сразу, хоть все и говорят что Лисп это работа со списками, это не так, не всегда списки эффективны, особенно когда требуется доступ к произвольному полю. Ещё есть вариант предсталять объект в виде хеш‑таблицы, как это сделано во многих языках программирования, очень интересный подход, можно «пихать» в объект дополнительные поля, вне зависимости от определения класса. Но в GIMP Script‑fu есть небольшая проблема, символы являющиеся именами полей плохо (медленно) индексируются в хеш‑таблице, фактически индексация происходит по имени символа, т.е по строке, а это медленно. Можно было бы сделать быстрее, ЗНАЧИТЕЛЬНО быстрее, но для этого необходимо чтобы в ВАШЕЙ версии Script‑fu была разрешена загрузка расширений, тогда одно из моих расширений могло бы быстро предоставлять числовой идентификатор символа, что свело бы индексацию символов в хеш‑таблице к скорости индексации чисел, а это очень быстро. Ещё есть вариант передставлять объекты в качестве окружений, в tinyscheme есть несколько операций позволяющих создавать окружения и использовать их. Эти функции позволяют создавать миниобъекты, которые фактически представляют из себя хеш‑таблицы, только реализованные на Си, отлично работающие с символами, что нам и нужно! И хотя последний вариант кажется идеальным, но моим проектным решением реализации объекта будет вектор! Хорошо проверенное на структурах решение, позволяющие осуществлять произвольный доступ к слотам объекта, за постоянное время, как говорят O (1). Фактически моя реализация объектов, будет очень мало отличаться от реализации структур. Только классы объектов, это иерархии наследования, но в конечном итоге они строят точно такой же вектор содержащий все поля класса, как и описание структуры.

Реализация системы классов

Чтобы работать с иерархиями классов, надо где то хранить информацию об этих иерархиях. Чтобы создавать экземпляры класса нам важна информция о предках класса, и о полях определённых в классе.

;;функции отслеживающие иерархию классов и набора полей классов.
(define *class-hierarhy* (make-hash 32))
(define *class-fields*   (make-hash 32))

(define (class-defined? class)
  (car (hash-ref *class-hierarhy* class)))

(define class? class-defined?)

(define (type-obj o)
  (vector-ref o 0))

(define (object? obj)
   (and (vector? obj)
        (class?  (type-obj obj))))

Определим функции работы с иерархией. Мы работаем сразу с двумя иерархиями: классов и полей в классе.

(define (add-class-define class parents)
  (hash-set! *class-hierarhy* class parents))

(define (class-parents class)
  (hash-ref *class-hierarhy* class))

(define (save-class-fields class fields)
  (hash-set! *class-fields* class fields))

(define (get-class-fields class)
  (hash-ref *class-fields* class))

(define-m (get-class-parents-all class)
  (let ((rez (make-hash 6))
        (stack-class    (list class))
        (cur-class nil)
        (parents   nil))
    (repeat
     (set! cur-class (pop stack-class))
     (set! parents   (class-parents cur-class))
     (if (and (car parents) (list? (cdr parents)))
         (for-list (el (cdr parents))
                   (push stack-class el)
                   (hash-set! rez el #t)))
     ((empty? stack-class) (hash-keys rez)))))

Чтобы корректно работать с объектом класса (инстансом/экземпляром) нам надо знать ВСЕХ его предков и ВСЕ его поля, а не только те которые даны непосредственно в определении класса

(define-m (get-class-parents-all-ordered class)
  (let ((in-rez (make-hash 6))
        (rez    '())
        (stack-class    (list class))
        (cur-class nil)
        (parents   nil))
    (repeat
     (set! cur-class (pop stack-class))
     (set! parents   (class-parents cur-class))
     (if (and (car parents) (list? (cdr parents)))
         (let ((tmp-stack '()))
           (for-list (el (cdr parents))
                     (unless (car (hash-ref in-rez el))
                       (push tmp-stack   el)
                       (push rez         el)
                       (hash-set! in-rez el #t)))
           (for-list (el tmp-stack)           ;;перекладываем элементы из временного стека в стек классов,
                     (push stack-class   el)) ;;при этом меняется порядок, на нужный!
           ))
     ((empty? stack-class) (reverse rez)))))

(define-m (get-class-fields-all class)
  (let ((rez (make-hash 6))
        (classes   (cons class (get-class-parents-all class))))
    (for-list (cur-class classes)
              (let ((fields (get-class-fields cur-class)))
                (if (and (car fields) (list? (cdr fields)))
                    (for-list (el (cdr fields))
                              (if (list? el)
                                  (hash-set! rez (car el) el)
                                  (hash-set! rez el el))
                      )))
              )
    (map cdr (hash2pairs rez))))

Основное отличие классов от структур состоит в наследовании и применении обобщённых функций. А что это значит? Это значит на обработку в метод может попасть как аргумент не просто объект указанного класса, но и любой произвольный его наследник. А в связи с множественным наследованием, никак не получиться гарантировать единообразный порядок расположение полей в векторе представляющим объект. Это значит, что для любого потомка расположение поля может не совпадать с расположением поля в базовом классе. ПОЭТОМУ в методах обобщённых функци НЕЛЬЗЯ использовать статические методы для доступа к полям объекта! Нужен способ гарантирующий единообразный доступ к одноимённым полям объектов! Этот спооб я определил как виртуальные методы доступа. Это такие функции которые в зависимости от типа передаваемого в них объекта, выдают значение именованного поля, или меняют его. Чтобы их построитьи обеспечить возможность их работы надо создать ещё пару хранилищ геттеров и сеттеров для полей классов.

;введём вспомогательную структуру позволяющую хранить вместе поля класса и связанные с ними данные
(struct class-field (name index val key))

;;таблицы позволяющие создать виртуальные методы доступа к полям объектов.
(define *class-virtual-get*   (make-hash 128))
(define *class-virtual-set*   (make-hash 128))

(define (add-class-virtual-get  class key func)
  (hash-set! *class-virtual-get* (list class key)  func))

(define (class-virtual-get . class-key)
  (hash-ref *class-virtual-get* class-key))

(define (add-class-virtual-set  class key func)
  (hash-set! *class-virtual-set* (list class key)  func))

(define (class-virtual-set . class-key)
  (hash-ref *class-virtual-set* class-key))

Ну а теперь можно и определить макрос описания класса

Начало определения

((define (sym2key s)                    ;;создает по символу, символ ключ(символ с двоеточием)
   (string->symbol (string-append ":"
                                  (symbol->string s))))

(define-macro (defclass . param)

(define (make-name-complex base postfix)
   (string->symbol (string-append (symbol->string base) postfix)))

(define (make-validator name)
   (let ((f-name name)
         (obj (gensym)))
      `(define (,(make-name-complex f-name "?")   ,obj)
          (and (vector? ,obj) (eq? (vector-ref ,obj 0) ',f-name)))))

;;преобразует список полей в список где каждому полю соотвествует индекс в массиве представляющим объект,значение по умолчанию и ключевой символ
(define-m (make-list-class-fields lst-names)
   (let ((new-lst '())
         (cur-ind 1))
     (for-list (cur lst-names)
	 (if (atom? cur)
             (set! new-lst (cons (class-field! cur       cur-ind  #f         (sym2key cur))       new-lst))
             (set! new-lst (cons (class-field! (car cur) cur-ind (cadr cur)  (sym2key (car cur))) new-lst)))
         (set! cur-ind (+ cur-ind 1)))
      (reverse new-lst)))


(define (make-maker name fields)
   (let ((f-name name)
         (l-stru (length fields))
         (s (gensym)) ;;name local structure
         (t-stru  (gensym)))
     `(defun (,(string->symbol (string-append "make-" (symbol->string f-name))) &key
	      ,@(map (lambda (f) (if (class-field-val f)
				     (list (class-field-name f) (class-field-val f))
				     (class-field-name f)))
		     fields))
        (let ((,s (make-vector ,(+ 1 l-stru))))
          (vector-set! ,s 0 ',f-name)
          ,@(let ((rez '())
                  (cur     fields))
              (while (not (null? cur))
                (set! rez (cons `(vector-set! ,s
                                              ,(class-field-index (car cur))
                                              ,(class-field-name  (car cur)))
                                rez))
                (set! cur (cdr cur)))
              (reverse rez))
          ,s))))


(define (make-getters name fields)
   (let ((f-name name)
         (l-stru (length fields))
         (obj  (gensym))
	 (rez '()))
     (for-list (cur fields)
	       (let ((name-getters
		      (make-name-complex f-name
					 (string-append "-"
							(symbol->string
							 (class-field-name cur))))))
		 (push rez `(add-class-virtual-get ',f-name (class-field-key ,cur)
						   (lambda (x) (,name-getters x))))
		 (push rez `(define-macro (,name-getters
					   ,obj)
                              `(vector-ref ,,obj ,,(class-field-index cur))))))
     (reverse rez)))


(define-m (make-setters name fields)
  (let ((f-name name)
        (l-stru (length fields))
        (v (gensym))
        (obj  (gensym))
	(rez '()))
    (for-list (cur fields)
	      (let ((name-setters
		     (make-name-complex
		      f-name
		      (string-append "-"
				     (symbol->string
				      (class-field-name cur))
				     "!"))))
		(push rez `(add-class-virtual-set ',f-name (class-field-key ,cur)
						  (lambda (x v) (,name-setters x v))))
		(push rez `(define-macro (,name-setters
					  ,obj ,v)
			     `(vector-set! ,,obj ,,(class-field-index cur) ,,v)))))
    (reverse rez)))

основное тело макроса:

       (let ((name      (car  param))
           (parents   (car (cdr  param))) 
           (fields    (car (cddr  param))))
       (add-class-define  name parents)
       (save-class-fields name fields)
       (let* ((parents-all (get-class-parents-all name))
	          (fields-all  (make-list-class-fields (get-class-fields-all  name))) ;;снабдим список полей индексами положения поля в массиве объекта.
              (fields-key-new (map 
			     (lambda (f) (if (pair? f)
						       (sym2key (car f))
						       (sym2key f)))
	             fields))
	          (valid     (make-validator name))
              (maker     (make-maker     name fields-all))
              (getters   (make-getters   name fields-all))
              (setters   (make-setters   name fields-all)))
	 `(begin
	    ,valid ,@getters ,@setters ,maker)
	 )))

Как видите, макрос достаточно простой, вначале мы сохраняем в базе сведения о родителях определяемого класса и указанных в нём полях. Далее собираем информацию из базы о всех его предках и о всех его полях указанных не только в самом определении класса, но и во всех его предках. Далее для всех имён полей создаём список ключей, чтобы можно было их использовать как ключевые аргументы в функциях (и в этом нет необходимости, т. к. теже ключевые аргументы создаёт определяемый далее конструктор (maker) объектов класса. Далее создаются функции предикат проверяющий тот ли это класс, конструктор объектов, наборы геттеров и сеттеров полей объектов класса. Надо заметить что мы создаём два типа геттеров и сеттеров. Статические методы и виртуальные. Статические работают только с указанным типом класса (фактически это не функции, а макросы преобразуемые в функцию вызова vector-ref и vector-set!, а виртуальные это те функции которые мы записываем в базу данных для данного класса и поля, которые в последствии будут применять в функции виртуального геттера и сеттера

(define (vfield obj key)
  (let ((v (class-virtual-get (type-obj obj) key)))
    (if (car v)
	   ((cdr v) obj)
	   (prn "can't find virtual get metod for object: " obj ", field " key))))

(define (vfield! obj key val)
  (let ((v (class-virtual-set (type-obj obj) key)))
    (if (car v)
	   ((cdr v) obj val)
	   (prn "can't find virtual set metod for object: " obj ", field " key))))

Для своей работы они обращаются в базу где хранятся методы доступа к конкретным методам доступа.

Ещё раз что это даёт. Написав в методе базового класса:

(vfield  obj-class-A :fieldA)
(vfield! obj-class-A :fieldA value-for-A)

мы можем быть уверены, что если в метод попадёт какой либо потомок класса class-A, то наш метод базового класса будет корректно с ним работать. Статические же методы, фактически первращающиеся в вызов функции (vector-ref obj-cass-A 7) будет корректно работать только с объектами класса class-A, но никак не с его потомками. Из за возможности подобных проблем, я вообще хотел удалить нафиг, все эти статические методы, чтобы у людей не возникало даже соблазна их применения. Но СКОРОСТЬ!!! Скорость с которой они работают и возможность кардинально ускорить код для объектов, тип которых мы знаем точно, убедили меня воздержаться от поспешных решений (и не зря! в дальнейшем эти скромные статические методы доступа перевернут всю выстраиваемую мной объектную систему. но обо всём по порядку).

(define (sort-symb< lst)
  (sort-c (lambda (f s)
	  (string<? (atom->string f) (atom->string s)))
	lst))

(define (obj2str obj)
  (let* ((type   (type-obj obj))
	 (f1 (get-class-fields-all type))
	 (fields (if (not (null? f1))
		     (sort-symb< (map (lambda (x) (sym2key (if (pair? x)
							       (car x)
							       x)))
				      f1))
		     f1)))
    (let ((rez '()))
      (for-list (f fields)
		(push rez (string-append (to-str f) ": " (to-str (vfield obj f)))))
      (apply join-to-str (insert-between-elements (reverse rez) ", ")))
    ))

Все эти функции и макросы приведены в файле obj3.scm

Тестирование

(define path-home (getenv "HOME"))
(define path-lib (string-append path-home "/work/gimp/lib/"))
(define path-work (string-append path-home "/work/gimp/"))
(load (string-append path-lib "util.scm"))
(load (string-append path-lib "defun.scm"))
(load (string-append path-lib "struct2.scm"))
(load (string-append path-lib "hashtable2.scm"))
(load (string-append path-lib "sort2.scm"))
(load (string-append path-lib "obj3.scm"))

(defclass a1 ()
  (fa1-1
   (fa1-2 1)))   ;;описание поля со значением по умолчанию.
(defclass b1 ()
  ((fb1-1 1)
   (fb1-2 2)
   (fb1-3 3)))
(defclass a2 (a1)
  ((fa2-1 'a)
   (fa2-2 2)
   fa2-3))
(defclass a3 (a1 b1)
  (fa3-1))
(defclass a4 (a2 a3)
  ((fa4-1 4)
   (fa4-2 5)))
(defclass a5 (a4 b1)
  ())
(defclass b2 (b1)
  ((fb2-1 4)))
(defclass b3 (b2)
  ((fb3-1 5)))
(defclass b4 (a4 a3 b3)
  ((fb4-1 6) fb4-2 (fb4-3 7)))

;;определён ли класс?
(class-defined? 'b3) ;;#t

;;список прямых потомков класса(первым идёт коду успешности поиска предков)
(class-parents  'a5) ;;(#t a4 b1)

;;список всех потомков класса
(get-class-parents-all 'a5) ;;(a4 a3 b1 a2 a1)

;;первым идёт признак успешности поиска
(get-class-fields 'a5) ;;(#t)

;;список всех полей данного класса, со значениями по умолчанию.
(get-class-fields-all 'a5) 
;;((fa4-2 5) (fa4-1 4) (fb1-3 3) fa3-1 fa2-3 (fb1-2 2) (fa2-2 2) (fb1-1 1) (fa2-1 'a) (fa1-2 1) fa1-1)

(define a11 (make-a1 :fa1-1 123))

a11
;;#(a1 1 123)

(get-class-fields-all 'a1) ;;((fa1-2 1) fa1-1)

(a1-fa1-1 a11) ;;123

(a1-fa1-2 a11) ;;1

(vfield a11 :fa1-1) ;;123

(vfield! a11 :fa1-1 124) ;;#(a1 1 124)

(vfield a11 :fa1-1)    ;;124

(obj2str a11) ;;":fa1-1: 124, :fa1-2: 1"

((get-class-fields-all 'a4) 
;;((fa4-2 5) (fa4-1 4) (fb1-3 3) fa3-1 fa2-3 (fb1-2 2) (fa2-2 2) (fb1-1 1) (fa2-1 'a) (fa1-2 1) fa1-1)

(define a42 (make-a4 :fa1-1 1 :fa1-2 2 :fa2-1 3 :fa2-2 4 :fa2-3 5 :fa3-1 6 :fb1-1 7 :fb1-2 8 :fb1-3 9
                     :fa4-1 10 :fa4-2 11))
(obj2str a42)
":fa1-1: 1, :fa1-2: 2, :fa2-1: 3, :fa2-2: 4, :fa2-3: 5, :fa3-1: 6, :fa4-1: 10, :fa4-2: 11, :fb1-1: 7, :fb1-2: 8, :fb1-3: 9"

(a4-fa1-1 a42) ;;1

;;не стоит так делать, т.е использовать статические методы достпупа в методах обобщённых функций, в метод
;;всегда может попасть не описываемый вами в параметре класс, а его потомок, применив к которому 
;;статический метод мы получим неверный результат!!!
(a1-fa1-1 a42) ;;10

(vfield a42 :fa1-1) ;;1

(vfield! a42 :fa1-1 45) ;#(a4 11 10 9 6 5 8 4 7 3 2 45)

(vfield a42 :fa1-1)  ;;45

Заключение

Итак, в данной статье я приступил к описанию создания ОО системы в GIMP Scrip-fu. Пусть пока показанный код выглядит как усовершенствованная структура, построение которой я описывал ранее в GIMP Script-Fu Первый Дан. Точки, Контуры, Кисти и Градиенты, а точнее структура с множественным наследованием, но надеюсь в дальнешемнаше «строительство» превратиться в полноценную ОО систему, не уступающую по выразительной мощности, удобству использоания и скорости большинству ОО систем.