На протяжении всей работы по реализации языка функциональной геометрии Эшера Хендерсона мы немного развивали tinyscheme, различными языковыми конструкциями и ни разу у меня не возникало необходимости использовать Объектно-Ориентированный подход, но вот реализовав абстракцию Фигуры,

(define (draw-fig img fig tr)
   (let* ((contour    (if tr
                          (translate-contour (fig-contour fig) tr)
                          (fig-contour fig)))
          (num-points (length contour))
          (points     (make-contour-vector contour  num-points))
          (dw         (car (gimp-image-get-active-drawable img))))
      ;;(gimp-context-push)
      (gimp-context-set-foreground (fig-color fig))
      (cond
       ((eq? (fig-type fig) 'pencil)
        ((fig-brush fig))
        (gimp-pencil  dw (* 2  num-points) points)
       ((eq? (fig-type fig) 'brush)
        ((fig-brush fig))
        (gimp-paintbrush-default  dw (* 2  num-points) points))
       ((eq? (fig-type fig) 'shape)
        ;;(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))
       )
      ;;(gimp-context-pop)
	  ))

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

Что мы будем делать

TinySchema не предоставляет никаких возможностей для ООП. Кто то даже считает что Лисп подобные языки являются функциональными, т.е реализующими чистые функции, не имеющие внутри никаких состояний. ЭТО НЕ ТАК! Интерпретатор языка Scheme реализует модель вычисления основывающуюся на окружениях, эти окружения содержат привязки символов к значениям, т.е переменные. И каждая определяемая функция всегда является замыканием, которое хранит в себе не только ссылку на код функции но и на окружение в котором была определена эта функция. и этим фактом мы можем воспользоваться для реализации объектной системы в схеме.

Но, что же такое ООП и каким оно бывает? Большинству программистов известна модель ООП, в которой объекты формируются из классов, с помощью специальных функций-конструкторов в соответствии с определением класса. Классы могут наследоваться и образовывать иерархию классов. В этой модели класс определяет поля объектов и методы, которые принадлежат классу. Это широко известная модель ООП, но гораздо раньше была сформирована концепция, в которой не было классов, классы это лишь удобные шаблоны упрощающие работу со схемами объектов. Безклассовая модель объектов, говорит о том, что объекты это некоторые функции обладающие внутренним состоянием, в лиспе такая функция называется замыканием(Как я уже и говорил, что все функции в Лиспе являются замыканиями, просто те про которые так принято говорить явно используют свободные переменные, т.е переменные оперделённые, где то в окружении функции). Позже (в Лиспе) возникла модель в которой появились классы и наследование. Но эти классы(в отличии от Си++ подобных реализаций) включали в себя лишь определения данных, а всё сложное поведение определялось через обобщённые функции, изменяющие своё поведение в зависимости от типов передаваемых в них объектов. Обобщённые функции не принадлежат какому либо классу. Эта модель ООП реализована в Лиспе(CLOS) и различных вариантах Scheme(например в guile - GOOPS). Эта концепция мало известна большинству программистов, (поэтому я на её объяснении так подробно остановился) которые не представляют, что методы могут не принадлежать конкретным классам, а являтся частными случами обобщённых функций.

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

Простой пример, объект некоторый именованный счётчик, содержащий поля имя и значение

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

Выполним подготовительную процедуру загрузки в скрипт-фу необходимых нам определений и определим макрос.

;;(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 "struct.scm"))

Макрос определяющий ключевые слова, символы начинающиеся с двоеточия(tinyscheme не поддерживает их автоматическое создание).

(define-macro (def-keys . param-list)
   `(begin  ,@(make-def-keys param-list)))

А теперь код, позволяющий создавать объекты именованные счётчики в нашей программе:

(def-keys :set-name :get-name :get :inc :dec)

(defun (make-named-counter &key (name "") (count 0))
   ;;object method
   (define (set-name nm)
      (set! name nm))
   (define (get-name)
      name)
   (defun (inc &opt (val 1))
      (set! count (+ count val)))
   (defun (dec &opt (val 1))
      (set! count (- count val)))
   (define (get)
      count)
   ;;dispatcher message
   (define (dispath message . param-list)
      (case message
         ((:get)
          (get))
         ((:inc) (if (pair? param-list)
                     (inc (car param-list))
                     (inc)))
         ((:dec) (if (pair? param-list)
                     (dec (car param-list))
                     (dec)))
         ((:get-name)
          (get-name))
         ((:set-name) (if (pair? param-list)
                          (set-name (car param-list))))
         ))

   dispath)

С точки зрения ООП функция make-named-counter представляет собой конструктор, создающий объекты, т.е некие элементы в среде выполнения обладающие памятью и собственным поведением, как говорят - акторы, которые могут отправлять и получать некоторые сообщения. На самом же деле это функция возвращающая обычные замыкания. Данный конструктор может инициализировать два внутренних поля: name и count. Помимо этого с помощью макроса def-keys мы определили несколько символов, являющихся именами сообщений, которые обрабатывает наша функция диспетчер. И ещё раз: Наш конструктор возвращает не просто функцию dispath - диспетчер, нет, он возращает замыкание в котором определены поля нашего объекта имя и счётчик, а также функции, которые можно условно назвать методами объекта, которые также существуют в окружении функции диспетчера и имеют доступ к внутренним полям объекта.

Протестируем работу нашего конструктора и объектов созданных на его основе.

(define c1 (make-named-counter :name "c1 counter"))
;;работа с полем name
(c1 :get-name) ;;"c1 counter"
(c1 :set-name "test c1") ;;"test c1"
(c1 :get-name)           ;;"test c1"
;;работа со счётчиком.
(c1 :get) ;;0
(c1 :inc) ;;1
(c1 :inc) ;;2
(c1 :inc 8) ;;10
(c1 :dec 2) ;;8
(c1 :get) ;;8

(define c2 (make-named-counter :name "c2 counter" :count 13))
(c2 :get)     ;13
(c2 :inc 10)  ;23
(c2 :get 10)  ;23 , 10 в аргументах нигде не используется и просто отбрасывается.
(c1 :get)     ;8 , счётчик c1 по прежнему имеет значение 8.

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

ООП синтаксис

И если бы это был любой другой язык программирования, на этом наше рассуждение о внедрении объектной системы в язык и закончилось бы. НО, это лисп! Здесь нам доступны макросы позволяющие расширять синтаксис языка.

Предположим мы хотим определять класс (а фактически - строить функцию-конструктор make-name-counter) по данному шаблону

(defclass named-counter  ;; имя класса
   ((name "") (count 0)) ;;list fields - список полей объекта.
   (((inc &opt (val 1))  ;;list methods -список методов ((имя-метода переменные) тело-метода) ...
     (set! count (+ count val)))
    ((dec &opt (val 1))
     (set! count (- count val)))
    ((get)
     count)
    ((set-name nm)
     (set! name nm))
    ((get-name)
     name))
   () ;;код выполняемый если сообщение неопознанно, метод по умолчанию
   )

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

;;описывает список ключевых слов
(define-macro (def-keys . param-list)
   `(begin  ,@(make-def-keys param-list)))

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

;;функция определяет существует ли элемент в списке для которого выполняется условие condition
(define (condition-met-for-list condition lst)
   (cond
    ((null? lst) #f)
    ((condition (car lst)) (car lst))
    (else (condition-met-for-list condition (cdr lst)))))

;;определяет по списку параметров, есть ли ключевые слова, что бы использовать для определения
;;функций синтаксис defun
(define (has-key-for-defun param-list)
   (let ((lst-defun-keys '(&key &opt &rest)))
      (condition-met-for-list (lambda (x) (memq x lst-defun-keys))
                              param-list)))

;;по списку методов, выполняет предварительную работу, выделяя имя метода, имя клча, параметры,
;;и код метода
(define-m (get-property-methods methods)
   (let ((rez1 nil))
      (do ((cur methods (cdr cur)))
            ((null? cur) (reverse rez1))
         (let* ((el            (car cur))
                (name-method   (caar el))
                (params-method (cdar el))
                (body-methods  (cdr  el))
                (key-method    (sym2key name-method)))
            (set! rez1 (cons (list name-method key-method params-method body-methods)
                             rez1))
            ))))

;;небольшой хак, что бы не использовать в коде символ defun. Прямое его использование в коде
;;приводило к ошибке в define-m, фактически пытающегося раскрыть макрос defun, когда это ещё не
;;требуется
(define *symbol-defun* 'defun)

;;создает код определяющий методы объекта используя даные функции get-property-methods
(define-m (make-list-methods property-metods)
   (let ((rez1 nil))
      (do ((cur property-metods (cdr cur)))
            ((null? cur) (reverse rez1))
         (let* ((el            (car cur))
                (name-method   (car el))
                (params-method (caddr el))
                (body-methods  (cadddr  el))
                (define-style  (if (has-key-for-defun params-method)
                                   *symbol-defun*
                                   'define)))
            (set! rez1 (cons
                        `(,define-style (,name-method ,@params-method)
                            ,@body-methods)
                        rez1))
         ))))

;;создает код обработки сообщений, фактически основной код диспетчера
(define-m (make-list-case-call-methods    property-metods param-list)
   (let ((rez1 nil))
      (do ((cur property-metods (cdr cur)))
            ((null? cur) (reverse rez1))
         (let* ((el            (car cur))
                (name-method   (car  el))
                (key-method    (cadr el))
                (params-method (caddr el)))
            (set! rez1 (cons
                        `((,key-method)
                          ,(cond
                            ((null? params-method) `(,name-method))
                            ((has-key-for-defun params-method)
                             `(if (pair? ,param-list)
                                  (apply ,name-method ,param-list)
                                  (,name-method)))
                            (#t
                             `(apply ,name-method ,param-list))))
                        rez1))
         ))))

Основной макрос создающий ООП синтаксис.

;;макрос создающий функцию конструктор объектов, в котором используются все описанные выше фунции
(define-macro (defclass class-name fields methods default-body)
   (let* ((dispath   (gensym)) (message (gensym)) (param-list (gensym))
          (name-maker (string->symbol (string-append "make-"
                                                     (symbol->string class-name))))
          (property-metods      (get-property-methods methods))
          (external-keys        (map cadr property-metods))
          (list-defined-methods (make-list-methods    property-metods))
          (list-case-call-methods (make-list-case-call-methods    property-metods param-list)))
      ;;(prn "Defined methods: " list-defined-methods "\n")
      `(begin
          (def-keys ,@external-keys)
          (defun (,name-maker &key ,@fields)
             ,@list-defined-methods
             (define (,dispath ,message . ,param-list)
                (case ,message
                   ,@list-case-call-methods
                   ,(if (pair? default-body)
                        `(else ,@default-body) )
                   ))
             ,dispath))))

Проведём тестирование

Я разместил этот код в файл obj2.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 "obj2.scm"))

Определим класс, и создадим пару объектов, проверим их работу парой сообщений.

;;посмотрим как это работает
(defclass named-counter
   ((name "") (count 0)) ;;list fields
   (((inc &opt (val 1))  ;;list methods имя метода и параметры и список действий
     (set! count (+ count val)))
    ((dec &opt (val 1))
     (set! count (- count val)))
    ((get)
     count)
    ((set-name nm)
     (set! name nm))
    ((get-name)
     name))
   ( ;;код выполняемый если сообщение неопознанно, метод по умолчанию
    (prn "неизвестный сигнал!\n")
	count)
   )

(define nc1 (make-named-counter :name "test 1" :count 2))
;nc1
(nc1 :inc 12) ;;14
(define nc2 (make-named-counter :name "test 2" :count 20))
;nc2
(nc2 :inc 12) ;;32
(nc2 12) ;;неизвестный сигнал!

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

Достоинства и недостатки такого подхода

Ну очевидное достоинство, это простота реализации объектной системы. В принципе на его основе можно было бы реализовать варианты объектной системы с наследованием. Эта концепция очень близка большинству программистов, знакомых с Си++ объектными системами, когда классы владеют методами. Инкапсуляция в при таком подходе - абсолютная.

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

Для своих собственных нужд я реализовал более продвинутую объектную систему (файл obj4.scm), похожую на CLOS, но без мета объектного протокола (MOP), о которой я поведаю как-нибудь в другой раз.