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

Введение

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

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

Чтобы определить какой метод вызвать, обобщённая функция берёт переданные ей аргументы и определяет тип каждого из них, составляя список типов вызова функции. За этот процесс отвечает функция make-shablon-call-by-args.

(def-key :unspec)
;;создание шаблона вызова на основе типов аргументов функции
(define (make-shablon-call-by-args . args)
  (let ((rez '()))
    (do ((cur args (cdr cur)))
	((null? cur) (reverse rez))
      (set! rez (cons (if (object?  (car cur))
			  (type-obj (car cur))
			  :unspec) rez)))))

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

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

(def-keys :vector :list :number :string :boolean :char :symbol :closure :macro :environment)
(define (make-shablon-call-by-args . args)
  (let ((rez '()))
    (do ((cur  args (cdr cur)))
	((null? cur) (reverse rez))
      (set! rez (cons  (cond
			((vector? (car cur))
			 (if (symbol? (vector-ref (car cur) 0))
			     (vector-ref (car cur) 0) ;;считаем что это объект или структура и возвращаем имя.
			     :vector))
			((pair? (car cur))     :list)
			((number? (car cur))   :number)
			((boolean? (car cur))  :boolean)
			((string?  (car cur))  :string)
			((char?    (car cur))  :char)
			((symbol?  (car cur))  :symbol)
			((closure? (car cur))  :closure)
			((macro?   (car cur))  :macro)
			((environment? (car cur))  :environment)
			(#t :unspec)) rez))
    )))

В данной функции мы не различаем типы integer и real, а опознаём только их общий тип number. И это пожалуй ВСЁ, что нужно для введения в Объектно-ориентированную систему, для возможности работы обобщённых функций с примитивными типами данных!!!!

Небольшое уточнение: Здесь, в целях ускорения работы функции, я отказался от работы функций type-obj и object?, что разрушает абстракцию объекта. Таким образом может получиться, что массив содержащий в нулевом поле символ будет признан либо объектом, либо структурой и вместо типа :vector вернёт этот символ, как значение типа объекта или структуры. Это небольшая жертва принесена в пользу ускорения работы функции, которая теперь не обращается в хеш таблицу зарегистрированных классов. Эта жертва по мимо ускорения работы, даёт нам возможность работать на равне с классами и со структурами, которые определяются(эмулируются в системе) аналогично классам, но нигде не регистрируются и не имеют возможности наследования.

Пробуем диспетчеризацию по примитивным типам данных.

(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 "obj5.scm"))
(load (string-append path-lib "obj/object.scm"))
(load (string-append path-lib "point.scm"))

Переопределяем функцию make-shablon-call-by-args и определяем ключи типов данных(как показано выше).

Смотрим как работает функция формирования шаблона вызова:

(make-shablon-call-by-args 1 '2 '(3 3 3 4) #(12 3) #\e) ;;(:number :number :list :vector :char)
(make-shablon-call-by-args 1 '2 '(3 3 3 4) #(point 12 3)) ;;(:number :number :list point)
(make-shablon-call-by-args 1 '2 '(3 3 3 4) (p! 12 3)) ;;(:number :number :list p)

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

Определим обобщённую функцию test, через метод с принимающий 2 аргумента, для которых не специфицированы типы:

(defmethod (test a b)
  (prn "test get a: " a ", b: " b "\n"))

(test 1 2)
(test "my str1" "my str2")

;;test get a: 1, b: 2
;;test get a: my str1, b: my str2

Специфицируем один из параметров, например необходимостью работать со структурами типа точка(у нас тип данной структуры определён в файле point.scm как p):

(defmethod (test (a p) b)
  (prn "test get point a: " a ", b: " b "\n"))

(test 1 2)
(test "my str1" "my str2")
(test (p! 1 2) (p! 2 3))
(test (p! 1 2) 23)
;; test get a: 1, b: 2
;; test get a: my str1, b: my str2
;; test get point a: #(p 1 2), b: #(p 2 3)
;; test get point a: #(p 1 2), b: 23

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

(defmethod (test (a p) (b :number))
  (prn "test get point a: " a ", and number b: " b "\n")
  (p! (+ a.x b) (+ a.y b)))

(defmethod (test (a p) (b p))
  (prn "test get point a: " a ", and point b: " b "\n")
  (p! (+ a.x b.x) (+ a.y b.y)))

(test "my str1" "my str2")
;;test get a: my str1, b: my str2

(test (p! 12 31) -4)
;;test get point a: #(p 12 31), and number b: -4
;;#(p 8 27)

(test (p! 12 31) (p! -4 -2))
;;test get point a: #(p 12 31), and point b: #(p -4 -2)
;;#(p 8 29)

Как видно из примеров,

1. поведение обобщённой функции прекрасно специфицируется примитивными типами данных и структурами, и вызовы методов распределяются в соответствии с их спецификацией.

2. Для структур работает разработанный нами ДОТ синтаксис для работы с полями объектов.

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

Более точная спецификация числовых типов.

Первоначально я определил для создания шаблона вызова предикат не различающий целочисленных и рациональных чисел. С одной стороны это как бы и не особо важно, но с другой стороны иногда пользователь ОО системы может захотеть различать данные варианты. Однако введя определение этих вариантов я потеряю возможность использовать их общий тип :number. Как быть в этом случае? На уровне создания шаблона вызова функции, эту проблему не решить! Но есть интересный хак, с введением псевдо иерархии примитивных типов через систему определения классов.

Первоначально изменим определение функции создающей шаблон вызова функции:

(def-keys :vector :pair :real :integer :number :string :boolean :char :symbol :closure :macro :environment)
(define (make-shablon-call-by-args . args)
  (map (lambda (cur)
	 (cond
	  ((vector? cur)
	   (if (symbol? (vector-ref cur 0))
	       (vector-ref cur 0) ;;считаем что это объект или структура и возвращаем имя.
	       :vector))
	  ((symbol?  cur)      :symbol)
	  ((pair?    cur)      :pair)
	  ((null?    cur)      :null)
	  ((integer? cur)      :integer)
	  ((real?    cur)      :real)
	  ((boolean? cur)      :boolean)
	  ((string?  cur)      :string)
	  ((char?    cur)      :char)
	  ((closure? cur)      :closure)
	  ((macro?   cur)      :macro)
	  ((environment? cur)  :environment)
	  (#t :unspec))) args))

Теперь на уровне создания шаблона вызова мы различаем целые числа и рациональные. А для учёта общего типа :number введём фиктивное наследование:

(defclass :real    (:number) ())
(defclass :integer (:number) ())

И это всё! Теперь примитивные типы имеют общего предка, общий тип :number.

Как это работает:

(defmethod (test (a :number))
  (prn "test get a number!: " a "\n"))

(test 21)
(test 21.23)

;; test get a number!: 21
;; test get a number!: 21,23.0

Введём точную спецификацию типов параметров методов функции test для чисел с плавающей запятой :real

(defmethod (test (a :real))
  (prn "test get a real!: " a "\n"))

(for-list (el '(1 2 3.2 4 7.1))
   (test el))
;; test get a number!: 1
;; test get a number!: 2
;; test get a real!: 3,2.0
;; test get a number!: 4
;; test get a real!: 7,1.0

Так же можно продемонстрировать вызов метода родителя, например для параметра типа :integer

(defmethod (test (a :integer))
  (prn "test get a integer!: " a "\n")
  (if (next-method-p) (call-next-method)))

(defmethod (test a)
  (prn "test get unspecified param a: " a "\n"))

(for-list (el '(1 2 3.2 4 7.1 "Привет!"))
   (test el))
;;test get a integer!: 1
;;test get a number!: 1
;;test get a integer!: 2
;;test get a number!: 2
;;test get a real!: 3,2.0
;;test get a integer!: 4
;;test get a number!: 4
;;test get a real!: 7,1.0
;;test get unspecified param a: Привет!

Классический пример как используется типизация параметров для полиморфного поведения функций:

(defmethod (Method a b)
  (+ a b))

(Method 12 4) ;;16
(Method "12" "4") ;;Error: +: argument 1 must be: number

Создание строго типизированного поведения:

(defmethod (Method a b)
  (prn "What need do with " a ", " b "\n"))

(defmethod (Method (a :number) (b :number))
  (+ a b))

(defmethod (Method (a :string) (b :string))
  (string-append  a b))

(Method 12 4) ;;16
(Method "12" "4") ;; "124"
(Method 12 "4") ;;What need do with 12, 4

Заключение

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