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

Введение

Итак, мы разработали практически полнофункциональную ООП систему для языка tinyscheme, так же работающую в script-fu GIMP. Но гложет меня одна мысль, реализовать поля общие для всех объектов класса. В разных языках они называются по разному, но смысл один, некие значения, которые общие для всех объектов одного класса. В принципе как я уже указывал, такие поля реализуются как глобальные переменные, но реализация их в виде подсистемы ООП облегчит управление этими полями и использование их в обобщённых функциях. Тут есть тонкий момент: обобщённая функция может работать не только с объявленными типами параметров, но и с их наследниками. Если мы используем общие поля для класса в виде какой то глобальной переменной, то с этими полями будут работать не только объекты объявленных в параметрах классов, но и их потомки. И по идее методы обобщённой функции должны работать с типами соответствующим типам входных аргументов, а не просто типам объявленных параметров. А работа с глобальной переменной не будет различать одних потомков объявленных параметров метода от других. Во всяком случае такая персонализация работы будет затруднена и должна будет выполняться в ручную.

Я долго думал(да это было долго) как описать эти поля в объявлении класса и решил что не надо заморачиваться со сложным анализом и включать их в общий список полей объекта, а потом вычленять их из общей массы. Надо сделать просто, добавить ещё один список полей, который и будет обозначать поля уровня класса.

(defclass class-a (O1 O2)  ;;список классов предков
  (a b)               ;;список переменных хранящихся в объектах(инстансах)
  (static-a           ;;список переменных общих для всех объектов класса.
   (static-b '())))

;; А можно было определять и так или даже ещё более длинно:
(defclass class-a (O1 O2)  ;;список классов предков
  (a b
   (static-a :class) (static-b '() :class))    ;;список полей хранящихся в объектах(инстансах)
  )

Но помимо вопроса об определении полей, есть ещё вопрос о семантике обращения к этим полям. Мы можем обращаться к ним как к полям класса или же мы можем обращаться к ним как к полям объекта.

;;обращение как к полям класса
(get-vield class :static-a)

;;обращение как к полям объекта.
(get-field obj1  :static-a)

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

(defmethod (test-a (x class-a))
  (prn "static-a: "  (get-field x :static-a) "\n"))

Данный код будет работать и для класса class-a и для его потомков, а если бы мы указали обращение через класс, то это было бы обращение непосредственно к полю указанного класса и всё полиморфное поведение пошло бы лесом. И для объектов потомков класса class-a они обращались бы зачем то к полям класса к которому они имеют лишь косвенное отношение. И в принципе реализация вот такого вот полиморфного поведения и является целью введения полей общих для всего класса, в противном случае можно было бы ограничится использованием глобальных переменных. Таким образом обращаться к полям уровня класса мы будем в каких то случаях через указание объекта, а в каких то через указание класса.

Реализация

Информацию о полях общих для всего класса надо где то хранить. Для этого создадим хеш-таблицу и функции работающие с ней, сохраняющие данные о полях и возвращающие эти данные.

код подготавливающий работу ОО системы со статическими полями класса

(define *class-fields-static*   (make-hash 32))

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

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

(define-m (get-class-static-fields-all class)
  (find-class-fields-all class get-class-static-fields))

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

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

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

(define (add-class-virtual-static-set  class key func)
  ;;(prn "add virt set func: " func "\n")
  (hash-set! *class-virtual-static-set* (list class key)  func))

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

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

(define-m (find-class-fields-all class getter-class-fields)
  (let ((rez (make-hash 6))
	(classes   (cons class (get-class-parents-all class))))
    (for-list (cur-class classes)
      (let ((fields (getter-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))))


(define-m (get-class-fields-all class)
  (find-class-fields-all class get-class-fields))

(define-m (get-class-static-fields-all class)
  (find-class-fields-all class get-class-static-fields))

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

В макросе создающем класс изменится(и добавиться) функция создающая списки полей и их индексов, в представлении объекта и класса(так же по указанному выше принципу обобщения кода).

;;преобразует список полей в список где каждому полю соотвествует индекс в массиве представляющим объект,значение по умолчанию и ключевой символ
(define-m (make-list-class-fields-ind lst-names start-ind)
   (let ((new-lst '())
         (cur-ind start-ind))
     (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-m (make-list-class-fields lst-names)
  (make-list-class-fields-ind lst-names 1))

(define-m (make-list-class-fields-static lst-names)
  (make-list-class-fields-ind lst-names 0))

У объекта поля начинаются с 1 индекса, т.к нулевой отвечает за указание класса объекта, а вот у хранилища класса поля можно начинать с 0 индекса.

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

функции создания и инициализации объектов класса

(define (make-maker name fields)
   (let ((f-name name)
         (l-stru (length fields))
         (s (gensym)) ;;name local structure
         (t-stru  (gensym)))
         (let ((name-maker (string->symbol (string-append "make-" (symbol->string f-name))))
               (name-creator (string->symbol (string-append "make-" (symbol->string f-name) "-create")))
               (name-initialize (string->symbol (string-append "make-" (symbol->string f-name) "-initialize"))))
     `(begin
        (define-m (,name-creator)
          (let ((,s (make-vector ,(+ 1 l-stru))))
            (vector-set! ,s 0 ',f-name)))

        (defun (,name-initialize ,s &key
	      ,@(map (lambda (f) (if (class-field-val f)
				     (list (class-field-name f) (class-field-val f))
				     (class-field-name f)))
		     fields))
          ;; в цикле мы создаем список присваивания, и вставляем его в макрос
          ,@(let ((rez '())
                  (cur     fields))
              (while (not (null? cur))
                ;;(print 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-m (,name-maker . args)
          (let ((,s (,name-creator)))
            (apply ,name-initialize  (cons ,s args))))))))

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

функции создания описаний функций доступа и записи статических полей(аццессоров).

(define-m (make-init-static-fields fields)
  (let ((name (gensym)))
    `(lambda (,name)
       ,@(map (lambda (var)
		`(vector-set! ,name ,(class-field-index var)
                                     ,(class-field-val   var))) fields))
  ))

(define-m (make-static-getters name fields)
   (let ((f-name name)
         (l-stru (length fields))
         (obj  (gensym))
	 (rez1 '())
	 (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-static-get ',f-name (class-field-key ,cur)
							  (lambda () (vector-ref ,f-name ,(class-field-index cur)))))
		 (push rez1 `(define ,name-getters #f))
		 (push rez  `(set! ,name-getters (lambda (,obj)
						  (vector-ref ,f-name ,(class-field-index cur)))))
		 ))
     (cons rez1 rez)))


(define-m (make-static-setters name fields)
  (let ((f-name name)
        (l-stru (length fields))
        (v (gensym))
        (obj  (gensym))
	(rez1 '())
	(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-static-set ',f-name (class-field-key ,cur)
						  (lambda (v) (vector-set! ,f-name ,(class-field-index cur) v))))
		(push rez1 `(define ,name-setters #f))
		(push rez  `(set! ,name-setters (lambda (,obj ,v)
						   (vector-set! ,f-name ,(class-field-index cur) ,v))))
		))
    (cons rez1 rez)))

Теперь описав все эти функции, создающие в макросе defclass описания определений функций работающих со статическими полями класса используем их в теле самого макроса производящего определение класса:

;; (define-macro (defclass . param)
     (let ((name      (car  param))
           (parents   (car (cdr  param))) 
           (fields    (car (cddr  param)))
	   (sfields  (if (not (null? (cdddr  param))) (car (cdddr param)) '()))) ;;необязательное поле статических полей класса
       (add-class-define  name parents)
       (save-class-fields name fields)
       (save-class-static-fields name sfields)
       (let* ((parents-all (get-class-parents-all name))
	      (fields-all  (make-list-class-fields (get-class-fields-all  name))) ;;снабдим список полей индексами положения поля в массиве объекта.
	      (fields-static-all  (make-list-class-fields-static (get-class-static-fields-all  name)))
	      (l-fstatic          (length fields-static-all))
              (sfields-key-new (map (lambda (f) (if (pair? f)
						   (sym2key (car f))
						   (sym2key f)))
				   sfields))
	      (valid     (make-validator name))
              (maker     (make-maker     name fields-all))
              (getters   (make-getters   name fields-all))
              (setters   (make-setters   name fields-all))
              (sgetters  (make-static-getters   name fields-static-all))
              (ssetters  (make-static-setters   name fields-static-all))
	      (init-class-static-field (make-init-static-fields fields-static-all)))
	 `(begin
	    ,@(make-def-keys sfields-key-new)
       (set! *cache-class-precedence-list* #f)      ;;сбрасываем кеш cpl
	    ;; (define ,name  (make-vector ,l-fstatic))
	    ;; (,init-class-static-field ,name)
	    ;; ,valid ,@getters ,@setters ,@sgetters ,@ssetters ,maker)
	    ;;(prn "sgetters: " sgetters "\n")
	    ,@(car sgetters) ,@(car ssetters)
	    (let ((,name  (make-vector ,l-fstatic)))
	      (,init-class-static-field ,name)
	      ,@(cdr sgetters) ,@(cdr ssetters))
	    ,valid ,@getters ,@setters ,maker)
	 )))

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

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

	   (define ,name  (make-vector ,l-fstatic))
	   (,init-class-static-field ,name)
	   ,valid ,@getters ,@setters ,@sgetters ,@ssetters ,maker)

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

	    ,@(car sgetters) ,@(car ssetters)          ;;пустые определения имён функций ацессоров
	    (let ((,name  (make-vector ,l-fstatic)))   ;;создание в локальном окружении связанной переменной хранящей вектор статичских полей класса
	      (,init-class-static-field ,name)         ;;функция инициализации статических полей значениями по умолчанию.
	      ,@(cdr sgetters) ,@(cdr ssetters))       ;;связывание определений с функциями и создание замыканий с учётом локального окружения.
	    ,valid ,@getters ,@setters ,maker)

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

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

функции для работы с геттерами и сеттерами статических полей

;;функции получения методов для работы с аццессорами объектов.
(define (get-vfield-getter obj key)
  (let ((t1 (class-virtual-get (type-obj obj) key)))
    (if (car t1)
	    (cdr t1)
	    (let ((t1 (class-virtual-static-get (type-obj obj) key))) ;;проверим может это статическое поле класса?
	        (if (car t1)
	            (cdr t1)
	            (lambda arg (prn "Undefined get accessor gets args " args "\n")))))))

(define (get-vfield-setter obj key)
  (let ((t1 (class-virtual-set (type-obj obj) key)))
    (if (car t1)
	    (cdr t1)
	    (let ((t1 (class-virtual-static-set (type-obj obj) key))) ;;проверим может это статическое поле класса?
	       (if (car t1)
	           (cdr t1)
	           (lambda arg (prn "Undefined set accessor gets args " args "\n")))))))

;;виртуальная функция доступа к статическим полям классов
(define (sfield obj-or-class key)
  (let ((v (class-virtual-static-get (if (symbol? obj-or-class)
                                         obj-or-class
                                         (type-obj obj-or-class)) key)))
    (if (car v)
	    ((cdr v))
	    (begin
	        (prn "can't find virtual get metod for object: ") 
	        (prn  obj-or-class ", field " key "\n")))))

(define (sfield! obj-or-class key val)
  (let ((v (class-virtual-static-set (if (symbol? obj-or-class)
                                         obj-or-class
                                         (type-obj obj-or-class)) key)))
    (if (car v)
	    ((cdr v) val)
	    (begin
	       (prn "can't find virtual set metod for object: ")
	       (prn  obj-or-class ", field " key "\n")))))

И это ВСЕ изменения что нужны были для внесения статических переменных класса в наш проект. Функциональность обобщённых функций была не задета. Функции get-vfield-setter, get-vfield-getter нужны для работы макроса with-slots о котором я расскажу в следующей статье.

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

подготовка.

;;(define path-home "D:")
(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 "storage.scm"))
(load (string-append path-lib "cyclic.scm"))
(load (string-append path-lib "hashtable3.scm")) ;;хеш который может работать с объектами в качестве ключей!
(load (string-append path-lib "sort2.scm"))
(load (string-append path-lib "tsort.scm"))
;;(load (string-append path-lib "cpl-sbcl.scm"))
(load (string-append path-lib "cpl-mro.scm"))
;;(load (string-append path-lib "cpl-topext.scm"))
(load (string-append path-lib "struct2ext.scm"))
(load (string-append path-lib "queue.scm"))
(load (string-append path-lib "obj4.scm"))
(load (string-append path-lib "obj/object.scm"))
(load (string-append path-lib "tests.scm"))

(load (string-append path-lib "point.scm"))
(load (string-append path-lib "tr2d.scm"))
(load (string-append path-lib "vect.scm"))

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

(defclass colored ()
  (color)
  (default-color))

(defclass centered (Object)
  (p1)
  (default-center))

(defclass line (centered colored)
  (p2))

(defclass circle (centered colored)
  (radius))

(defclass triangle (centered colored)
  (p2 p3))

(defclass square (centered colored)
  (gorizontal))

(defclass rectangle (square colored)
  (vertical))

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

(define-m (figure! . args)
  (let ((name-creator    (string->symbol (join-to-str "make-" (car args) "-create")))
        ;;(name-initialize (string->symbol (join-to-str "make-" (car args) "-initialize")));;стандартный инициализатор - здесь не нужен
		)
    (let ((obj ((eval name-creator)))) ;;создаём объект
      (initialize obj (cdr args)))))

Этот конструктор отличается от конструктора по умолчанию, тем что он вызывает обобщённую функцию initialize (инициализации). Опишем методы этой функции для различных классов.:

(define-macro (awhen tform . body)
  `(let ((it ,tform))
     (when it ,@body)))

(defmethod (:before initialize (c colored) args)
  (awhen (sfield c :default-color)  (vfield! c :color it)))

(defmethod (:before initialize (c centered) args)
  (awhen (sfield c :default-center) (vfield! c :p1  it)))

;;разбор аргументов конструктора и создания списка пар ключ.значение.
(define-m (keyargs-to-pairs args)
  (let ((rez '()))
    (do ((cur args (cddr cur)))
        ((or (null? cur) (null? (cdr cur))) (reverse rez))
      (push rez (cons (car cur) (cadr cur))))))

(defmethod (initialize (c line) args)
  (let ((ap (keyargs-to-pairs args)))
    (awhen (assq :p1 ap)    (vfield! c :p1    (cdr it)))
    (awhen (assq :p2 ap)    (vfield! c :p2    (cdr it)))
    (awhen (assq :color ap) (vfield! c :color (cdr it))))
  c)

продолжение

(defmethod (initialize (c circle) args)
  (let ((ap (keyargs-to-pairs args)))
    (awhen (assq :p1 ap)     (vfield! c :p1     (cdr it)))
    (awhen (assq :radius ap) (vfield! c :radius (cdr it)))
    (awhen (assq :color  ap) (vfield! c :color  (cdr it))))
  c)

(defmethod (initialize (c triangle) args)
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:p3 :p2 :color :p1))
      (awhen (assq el ap)  (vfield! c el (cdr it)))))
  c)


(defmethod (initialize (c square) args)
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:gorizontal :color :p1))
      (awhen (assq el ap)  (vfield! c el (cdr it)))))
  c)


(defmethod (initialize (c rectangle) args)
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:gorizontal :vertical :color :p1))
      (awhen (assq el ap)  (vfield! c el (cdr it)))))
  c)

для каждого класса написан индивидуальный инициализатор(не самого хорошего качества, я не стал писать цепочки инициализаторов использующих вызовы call-next-method, хотя можно было, но так понятней), они практически все однотипны, можно было бы даже макрос написать создающий такие инициализаторы, но инициализация значений по умолчанию происходит в функциях :before. Также представлен анафорический макрос awhen, макрос который специально захватывает оговорённую переменную, у нас это it, что позволяет удобно использовать обычные функции в функциях сравнения, и при благоприятном исходе также через эту переменную использовать результат функции. Подробнее о подобных макросах можно прочитать в книге "On Lisp" Пола Грема(перевод которой лежит на моём гитхабе).

А теперь можно потестировать.

(sfield! 'colored   :default-color  'red)
(sfield! 'centered  :default-center (p! 0 0))
(sfield! 'circle    :default-center (p! 100 100))
(sfield! 'triangle   :default-color  'cian)

(define f1 (figure! 'line :p2 (p! 25 40)))
(to-str f1) ;;f1"#(line #(p 25 40) () ())

(sfield! 'line   :default-color  'red)
(sfield! 'line   :default-center (p! 0 0))

(define f2 (figure! 'line :p2 (p! 25 40)))
(to-str f2) ;;f2"#(line #(p 25 40) red #(p 0 0))

(define f3 (figure! 'triangle :p2 (p! 25 40) :p3 (p! 75 180)))
(to-str f3) ;;f3"#(triangle #(p 75 180) #(p 25 40) cian ())

(sfield! 'triangle   :default-center (p! 0 0))

(define f3 (figure! 'triangle :p2 (p! 25 40) :p3 (p! 75 180)))
(to-str f3) f3"#(triangle #(p 75 180) #(p 25 40) cian #(p 0 0))

Или вот ещё пример, реализации синглтона:

(defclass singltone (Object)
  ()
  ((instance #f)
   (reinitialized #f)))

(define-m (singltone! . args)
  (let ((name-creator    (string->symbol (join-to-str "make-" (car args) "-create")))
        (name-initialize (string->symbol (join-to-str "make-" (car args) "-initialize"))))
    (let ((obj (sfield (car args) :instance)))
       (if obj
           (when (sfield (car args) :reinitialized)
              (initialize obj (cdr args)))
           (let ((tmp ((eval name-creator))))
              (sfield! (car args) :instance tmp)
              (set! obj tmp)
              (initialize obj (cdr args))))
       obj)))

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

классы и методы инициализации:

(defclass fabrica1  (singltone)
  (a b)
  ())

(defclass fabrica2  (singltone)
  (c (d 24))
  ())


(defclass fabrica3  (fabrica2)
  (e (f 42))
  ())

(sfield! 'fabrica2  :reinitialized #t)
(sfield! 'fabrica3  :reinitialized #t)

(defmethod (initialize (f fabrica1) args)
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:a :b))
      (awhen (assq el ap)  (vfield! f el (cdr it)))))
  f)

(defmethod (initialize (f fabrica2) args)
  (if (next-method-p) (call-next-method)) 
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:c :d))
      (awhen (assq el ap)  (vfield! f el (cdr it)))))
  f)

(defmethod (initialize (f fabrica3) args)
  (if (next-method-p)  (call-next-method)) 
  (let ((ap (keyargs-to-pairs args)))
    (for-list (el '(:e :f))
      (awhen (assq el ap)  (vfield! f el (cdr it)))))
  f)

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

Как это работает? Когда переинициализация запрещена, второй вызов конструктора, возвратит созданный первым объект.

(define f11 (singltone! 'fabrica1 :a 1 :b 2))

(to-str f11)
;;"#(fabrica1 2 1)"

(define f12 (singltone! 'fabrica1 :a 11 :b 22))

(to-str f12) 
;;"#(fabrica1 2 1)"

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

(define f21 (singltone! 'fabrica2 :c 1 :d 2)) 

(to-str f21)
;;"#(fabrica2 2 1)"

(define f22 (singltone! 'fabrica2 :c 3 :d 4))

(to-str f22)
;;"#(fabrica2 4 3)"
(to-str f21)
;;"#(fabrica2 4 3)"

и ещё один пример, с наследованием фабрик.

(define f31 (singltone! 'fabrica3 :c 1 :d 2 :e 3 :f 4))

(to-str f31)
;;"#(fabrica3 3 2 1 4)"

(define f32 (singltone! 'fabrica3  :d 12  :f 14))

(to-str f32)
;;"#(fabrica3 3 12 1 14)"
(to-str f31)
;;"#(fabrica3 3 12 1 14)"

Выводы.

Я думаю приведённый в статье код закрывает вопрос по статическим переменным класса в моей системе ООП для script-fu на 99%. Реализация заняла, где-то около двух дней и больше времени понадобилось на решение вопроса: а стоит ли это реализовывать, и так ли нужны статические переменные класса? Но как по мне, наиболее ценным из проделанного рефакторинга, это разделение конструктора по умолчанию на две функции: функцию создания объекта и функцию инициализации. Как показала практика это более часто используемая функциональность, чем статические переменные класса.

GIMP Script-Fu ООП. Статические поля класса