Библиотека функций к Script-fu
Введение
После написания объектной системы для Script‑fu я задумался над примерами, на которых хорошо бы было проверить эту систему. Я прошерстил уйму литературы, но хороших примеров использующих все возможности ООП в литературе встречается крайне мало. Ну что толку реализовывать класс List в Лиспе? А класс Stack? Примерами подобных классов пестрят книжки по Си++. Всё было не интересно, но вот я встретил книжку «Теория вычислений для программистов» Тома Стюарта, и вот примеры из неё, написанные на Ruby, показались мне интересными. Да в Ruby нет множественного наследования, но есть возможность создавать миксины, что несколько сглаживает этот недостаток. И вот делая примеры из этой, безусловно замечательной(с точки зрения теории вычислений) книжки я заметил, что мой код получается более длинный, чем код Ruby. И это происходит не только из за наличия операторов в Руби. Сами определения классов и методов в Руби получаются компактнее, и требуют меньше кода.
Различия в синтаксисе, дающие преимущества Руби(и не только ему) перед Лисп
Операторный синтаксис
;;Ruby
a + b
;;lisp и другой фунциональный подход +(a b)
(+ a b)мелочь, две скобки, но такие мелочи могут накапливаться. Но функциональный подход в данном случае я считаю всё же преимуществом, тем более что на повороте он может и обойти Руби(и др.)
(+ a b c d) ;;и чем круче такой "поворот" тем больше синтаксический выигрышь лиспа.
Точечный доступ к атрибутам(полям) объектов. Dot-синтаксис.
;;Руби
obj.field
;;мой способ доступа к слотам объекта
(vfield obj :field)
;; CLOS
(slot-value obj 'slot)
да длинновато, это точка боли, но кое-что я смогу вам предложить.
Определения методов и классов
;;Руби
class Variable < Struct.new(:name)
def to_s
name.to_s
end
def inspect
"<#{self}>"
end
def reducible?
true
end
end
;;моя ооп, да и CLOS тоже.
(defclass Variable (Object)
(name))
(defmethod (inspect (o Variable) cycle)
(to-str (vfield o :name)))
(defmethod (reducible? (o Variable))
#t)
;;за скобками сравнения
(defclass Object () ())
(defmethod (to-s (o Object))
(inspect o nil))
Даже для такого простого, я бы даже сказал пустого, случая и не смотря на то что у меня метод to-s наследуется получается как то многословно. И это мы ещё не описываем обобщённую функцию с помощью defgeneric. Мы постоянно описываем первый параметр метода, тогда как в Ruby этого нет, это всё делается по умолчанию. Там заранее известно что метод работает с объектом класса. Так зачем это второй раз описывать?(как например это делается зачем‑то в Питоне). А не сможем ли мы создать такой синтаксис, который представил бы наши методы, не методами обобщённых функций, а методами принадлежащими классу, и тогда не надо будет постоянно описывать этот первый объект и его тип? Да сможем! СМОЖЕМ! Давайте приступим:
Реализация "ЧАСТНОГО СЛУЧАЯ"
Это один из самых ПРОСТЫХ макросов, который можно написать, он создаёт анафору(захватывает переменную в описываемом коде и позволяет на неё ссылаться в этом коде) с переменной self, обозначающую объект указанного класса и являющийся первым параметром метода.
;;Хочу создать синтаксис позволяющий описывать методы, как будто эти методы принадлежат определённому классу
(defmethods Class
(Method1 ((p1 TypeParam) (p2 TypeParam) p3 p4 ...)
..... self - ссылка на объект типа Class передаваемый в метод первым, по мимо параметров p1 ...pn
)
(Method2 (p1 (p2 TypeParam2))
(with-slots (((f1 field1) field2) self
((f2 field3) field4) p2)
.......))
)
;; записи превращаются в
;; (defmethod (Method1 (self Class) (p1 TypeParam) (p2 TypeParam) p3 p4 ...) body)
;; (defmethod (Method2 (self Class) p1 (p2 TypeParam2)) body)
(define-macro (defmethods class . methods)
(let* ((methods-list '()))
(for-list (el methods)
(let ((name-method (car el))
(params (cons (list 'self class) (cadr el)))
(body (cddr el)))
(push methods-list
`(defmethod (,name-method ,@params) ,@body))))
`(begin
,@(reverse methods-list))))
Замечание, данная реализация макроса не позволяет объявлять квалификаторы для методов(но всё исправлено в obj5.scm).
Как теперь будет выглядеть наш код, при использовании этого макроса?
(defclass Variable (Object)
(name))
;; определяем сразу два метода
(defmethods Variable
(inspect (cycle)
(to-str (vfield self :name)))
(reducible? () #t))
)Внимательный читатель заметит, что код в лиспе делает что-то немного отличное от кода на Руби, но это всё благодаря классу Object, который я наследую. Именно там определена обобщённая функция и метод to-s, переводящая объект в строку, используя наиболее конкретный(подходящий) текущему типу объекта метод inspect. Хотя на самом деле можно было бы не описывать метод inspect, базовый метод для класса Object всё равно бы обработал любой тип объекта и распечатал значения всех его полей, обработав и взаимно-рекурсивные объекты. Но не в этом суть, суть в том что синтаксис определений методов стал значительно короче и это на смешном примере, представьте как сократиться синтаксис определения 5 или даже 10 методов.
Таким образом программист освоивший две синтаксических конструкции defclass и defmethods не смог бы найти отличия между синтаксисом CLOS и Руби, или например Питоном. Ну абстрагировавшись от незначительных мелочей. Ну в Руби объявление класса, фактически объявляет только методы, а определения полей стоят где то там сбоку, в специальном классе Struct. Но в семантике полученного синтаксиса разницы нет. Вот поля класса(объекта), а в питоне их вообще не объявляют, статические поля класса(из предыдущей статьи) и определения методов, которые наследуются и перегружаются. Ну всё тоже самое.
Но вывод что я могу сделать совершенно неожиданный. Поскольку реализовав подобный синтаксис, я произвёл сужение функциональности обобщённых функций( я как бы отнёс их методы к определённому классу), значит выразительность объектных систем реализующих концепции CLOS гораздо(ну ладно уж - НЕМНОГО) ШИРЕ, преобладающих сейчас на рынке популярных ОО систем. Теперь и у нас "всё как у людей".
Удобный доступ к полям(слотам) объекта
Длинный доступ к полям никому не нравится. В CLOS придумали макрос with-slots позволяющий связать некоторый алиас со слотом поля некоторого объекта. Я разработал аналогичный макрос и для своей системы. В моём случае этот макрос нужен не только для упрощения синтаксиса, но и для ускорения работы методов.
И всё по очень простой причине:
Не смотря на то, объект представляет собой вектор и доступ к полям это быстрая операция, для обобщённого метода мы заранее не знаем, какой объект у нас будет принят в качестве аргумента: объявленного типа параметра, или же какой то из его потомков. А значит надо по актуальному типу и имени поля находить в хеш-таблице метод, для доступа к полю. А хеш-таблица работает с символами крайне медленно и всё "благодаря" неким умникам из команды GIMP, которые закрыли возможность динамической загрузки расширений в Script-fu(можно пересобрать скрипт-фу с этой возможностью, но вряд ли кто будет это делать). А без этих расширений расчёт хеш-кода символа, превращается в расчёт хеш-кода строки, а мог бы вычисляться в мгновенье ока через сишную-функцию, ориентирующуюся на адрес памяти размещения символа. Поэтому я стараюсь избегать чрезмерного злоупотребления хеш-таблицами с ключами символами. Поэтому в нашем макросе мы загрузим для имеющихся типов объектов и их полей, функции доступа и будем использовать их, и тем самым мы сможем минимизировать обращение к хеш-таблице, только одним доступом для каждого поля.
Итак наш синтаксис with-slots
;;Использование vfield приводит к многословности описания методов, можно ли это упростить? сократив код
;;возможный выход в макросе with-slots, определим его как:
(with-slots ((slot11 slot12 ..) obj1
(slot21 slot22 ..) obj2
...)
body)
;;slot это имя_слота или список (имя_для_обращения_к_слоту имя_слота)
;;имя_для_обращения_к_слоту (превращается в)-> (vfield obj :имя_слота)
;;запись в слот описывается списком: (set! имя_для_обращения_к_слоту значение) -> (vfield! obj имя_слота значение)
(define-macro (with-slots slot-objs . body)
(let* ((slots (parse-slot-objs slot-objs))
(lets-and-body (build-body-methods-with-slots slots body)))
`(let (,@(car lets-and-body))
,@(cdr lets-and-body))))
Вот этот макрос и создаёт синтаксис упрощающий доступ к полям. шучу, тут есть ещё небольшая функциональная обвязка.
структуры и функции помогающие работать with-slots
;;структура описывающая определение алиаса, здесь он указан как name
(struct slot-def
(name slot obj key name-get name-set))
;;разбор объявления полей или алиасов объектов
(define-m (parse-slot-objs slot-objs)
(let ((rez '()))
(do ((cur slot-objs (cddr cur)))
((or (null? cur)
(null? (cdr cur))))
(let ((obj (cadr cur)))
(for-list (el (car cur))
(let ((name (if (pair? el)
(car el)
el))
(slot (if (pair? el)
(cadr el)
el)))
(let* ((key (make-symbol ":" slot)))
(push rez (slot-def! name slot obj key (gensym) (gensym))))))))
rez))
;;вспомогательные функции для работы с лямбда
;; move to util.scm
(define (tagged-list? exp tag)
(and (pair? exp) (eq? (car exp) tag))) ;;(list? exp)
(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters lambda-exp) (cadr lambda-exp))
(define (lambda-body lambda-exp) (cddr lambda-exp))
(define (make-lambda params body)
(let ((tmp-rez1 (cons 'lambda (cons params body))))
tmp-rez1))
;;проодит по дереву выражения и выполняет замену имён переменных на геттеры и сеттеры полей слотов объектов.
(define-m (tree-expr-replace-get-set expr var build-get build-set)
(let ((use-get #f)
(use-set #f)
(tree-expr-replace-get-set-rec #f))
(set! tree-expr-replace-get-set-rec
(lambda (expr)
(cond ((null? expr)
(begin
'()))
((lambda? expr) ;;возможно в лямбде есть что заменить, например в замыкании, свободную переменную
(let ((params (lambda-parameters expr)))
(if (cdr (find (lambda (elem) (eq? var elem)) params))
expr ;;одна из переменных лямбды затеняет нашу переменную var, дальше замену не делаем
(make-lambda params ;;коллизий нет, захвата переменной не будет. выполняем
(tree-expr-replace-get-set-rec (lambda-body expr))))
))
((eq? expr var)
(unless use-get (set! use-get #t))
(build-get))
((and (pair? expr) ;;(list? expr)
(= (length expr) 3)
(eq? 'set! (car expr))
(eq? (cadr expr) var))
(unless use-set (set! use-set #t))
(build-set (tree-expr-replace-get-set-rec (caddr expr))))
((pair? expr) ;;(list? expr)
(cons (tree-expr-replace-get-set-rec (car expr))
(tree-expr-replace-get-set-rec (cdr expr))))
(#t
expr))))
(let ((rez (tree-expr-replace-get-set-rec expr)))
(cons (list use-get use-set) rez))
))
;;преобразует тело, выполняя подстановку вместо имён ставит вызовы геттеров и сеттеров,
;;возвращает набор для лет оператора, используемых геттеров и сеттеров и преобразованное тело.
(define-m (build-body-methods-with-slots slots body)
(let ((let-list '())
(rez-body body)
(tmp-rez '()))
(for-list (el slots)
(set! tmp-rez (tree-expr-replace-get-set
rez-body
(slot-def-name el)
(lambda () `(,(slot-def-name-get el) ,(slot-def-obj el)))
(lambda (v) `(,(slot-def-name-set el) ,(slot-def-obj el) ,v))))
(set! rez-body (cdr tmp-rez))
(when (caar tmp-rez)
(push let-list `(,(slot-def-name-get el)
(get-vfield-getter ,(slot-def-obj el) ,(slot-def-key el)))))
(when (cadar tmp-rez)
(push let-list `(,(slot-def-name-set el)
(get-vfield-setter ,(slot-def-obj el) ,(slot-def-key el)))))
)
(cons let-list rez-body)))
А теперь пример получившегося синтаксиса.
;;класс правил
(defclass FARule (Object)
(state character next-state))
(defmethods FARule
(applies-to? (st chr)
(with-slots ((state character) self)
(and (equal? state st) (char=? character chr))))
(follow ()
(with-slots ((next-state) self)
next-state))
(inspect (cycle)
(with-slots ((state character next-state) self)
(join-to-str "# #{" next-state "}>")))
)
;или вот с примером установки слота
(defclass DFA (Object)
(start current-state accept-states rulebook))
(defmethods DFA
(inspect (cycle)
(with-slots ((current-state accept-states rulebook) self)
(join-to-str "DFA: " current-state "/"
(avl-tree-get-ordered-values (set*-base accept-states)) "/"
(inspect rulebook cycle))))
(accepting? ()
(with-slots ((current-state accept-states) self)
(set-has? accept-states current-state)))
(reset ()
(with-slots ((start current-state) self)
(set! current-state start))) ;;это установка слота объекта self
)Синтаксис чтения значения слота объекта и установки значения, получился аналогичный установке и значения любой другой переменной схемы.
Что можно ещё добавить? Разве что совет: Выбирайте имена алиасов полей как имя переменной тире имя поля. Либо если объект у вас один, просто оставляйте имена полей. Иначе алиасы вместо помощи будут вас путать.
Dot синтаксис.
Синтаксис обращения к полям через точку я реализовал для структур, в виде макроса with-stru, когда писал алгоритм работы с AVL-деревьями. Функции работы с бинарными деревьями очень много обращаются к полям узлов, которые в свою очередь являются аналогичными полями узлов и функциональный тип записи имеет большую вложенность вызовов аццессоров. Простой пример подсчёт высоты узла:
(define (avl-node-calculate-height node)
(begin
(avl-node-height! node (+ 1 (max (if (null? (avl-node-left node))
0 (avl-node-height (avl-node-left node)))
(if (null? (avl-node-right node))
0 (avl-node-height (avl-node-right node))))))))
Вызов в одном месте нескольких аццессоров немного затрудняет чтение, хотелось бы получить такой синтаксис который удобно предоставлял доступ к полям структуры, как это делается в других языках программирования.
;;например
node.right
;; (with-stru
;; (stru-var1 type-stru-var1 ;;описание переменных и типов структур
;; stru-var2 type-stru-var2
;; stru-var3 type-stru-var3
;; ........)
;; (set! stru-var1.fields11 value11) ;;пример кода установки поля структуры
;; (prn stru-var1.fields12)
;; ....
;; body)
Для реализации возможности подобного синтаксиса создан макрос.
(define-macro (with-stru var-stru . body)
(let* ((vars (parse-var-stru var-stru body))
(new-body (tree-expr-replace-vars-dot-fields body vars))) ;;
`(begin ,@new-body)))
В принципе всё просто, разбираем определение связывающее символы и типы структур, и опираясь на полученную структуру, производим анализ кода, определяя есть ли в коде символы с точками, и если такие есть и они содержатся в нашем определении производим их замену. Символ имеющий точку заменяется очень просто: вместо имеющегося символа вставляется вызов аццессора к полю для связанного с символом типа.
функции поддерживающие работу макроса.
;;находит в строке символ, начиная с конца строки
(define-m (string-at-end str ch)
(let ((len (- (string-length str) 1)))
(do ((i len (- i 1)))
((or (< i 0)
(char=? (string-ref str i) ch))
(if (< i 0) #f i)))))
;;разбивает символ на два символа если в его имени есть точка, разбиение происходит с точек находящихся ближе к концу.
(define (split-dot-symbol symb)
(let* ((str (symbol->string symb))
(len (string-length str)))
(if (> len 2)
(let ((pos (string-at-end str #\.)))
(if (and pos (> pos 0) (< pos (- len 1)))
(cons (string->symbol (substring str 0 pos))
(string->symbol (substring str (+ pos 1))))
#f))
#f)))
(struct var-stru-def
(var type))
;;добавили возможность определять для несколькоих переменных одну структуру, задвая список а не конкретныую
;;переменную
(define-m (parse-var-stru var-stru)
(let ((rez '()))
(do ((cur var-stru (cddr cur)))
((or (null? cur)
(null? (cdr cur))))
(let ((var (car cur))
(type-stru (cadr cur)))
(if (pair? var)
(for-list (el (reverse var))
(push rez (var-stru-def! el type-stru)))
(push rez (var-stru-def! var type-stru)))))
rez))
(struct field-def
(name field var name-get name-set))
(define-m (tree-expr-replace-vars-dot-fields expr var-list)
(let ((aliases (make-hash 16))
(tree-expr-replace-get-set-rec #f)
(is-alias-fields #f)
(fd #f) ;;переменная определения поля
(in-var-list (lambda (var var-list) (find (lambda (x) (eq? ( var-stru-def-var x ) var)) var-list)))
(exclude-params (lambda (var-list params)
(remove-if (lambda (var)
(cdr (find (lambda (elem) (eq? (var-stru-def-var var) elem)) params))) var-list))))
(set! is-alias-fields
(lambda (expr var-list)
(if (symbol? expr)
(let ((rez (hash-ref aliases expr))) ;;проверяем хеш.
(if (car rez)
(cdr rez) ;;вернём результат, он пригодиться функциям построения get и set
(let ((var-field (split-dot-symbol expr))) ;;попробуем "разбить" символ.
(if var-field
(let ((in-var (in-var-list (car var-field) var-list)))
(if (cdr in-var)
(let* ((getter-name (make-symbol
(var-stru-def-type (car in-var))
"-" (cdr var-field)))
(setter-name (make-symbol
(var-stru-def-type (car in-var))
"-" (cdr var-field) "!"))
(fd (field-def! expr (cdr var-field) (car var-field)
getter-name
setter-name)))
(hash-set! aliases expr fd)
fd);;вернём полученное описание поля
#f)) ;;это не наша пара!!! мы такой переменной не задавали!
#f))));;не смогли разбить на пару переменная-поле
#f))) ;;это даже не символ!
(set! tree-expr-replace-get-set-rec
(lambda (expr var-list)
(cond ((null? expr) '())
((lambda? expr) ;;возможно в лямбде есть что заменить, например в замыкании, свободную переменную
(let* ((params (lambda-parameters expr))
(local-var-list (exclude-params var-list params)))
(if (null? local-var-list)
expr ;;нет свободных переменных из var-list, дальше замену не делаем
(make-lambda params ;;возможно какие то переменные будут свободными, попробуем их заменить
(tree-expr-replace-get-set-rec (lambda-body expr) local-var-list)))
))
((begin
(set! fd (is-alias-fields expr var-list))
fd)
(list (field-def-name-get fd) (tree-expr-replace-get-set-rec (field-def-var fd) var-list)))
((and (pair? expr) ;;(list? expr)
(= (length expr) 3)
(eq? 'set! (car expr))
(begin
(set! fd (is-alias-fields (cadr expr) var-list))
fd))
(list (field-def-name-set fd)
;;(field-def-var fd)
(tree-expr-replace-get-set-rec (field-def-var fd) var-list)
(tree-expr-replace-get-set-rec (caddr expr) var-list)))
((pair? expr) ;;(list? expr)
(cons (tree-expr-replace-get-set-rec (car expr) var-list)
(tree-expr-replace-get-set-rec (cdr expr) var-list)))
(#t
expr))))
(let ((rez (tree-expr-replace-get-set-rec expr var-list)))
rez)
))
таким образом функция подсчёта высоты узла бинарного дерева, с учётом нового синтаксиса, будет выглядеть так:
(define-m (avl-node-calculate-height node)
(with-stru (node avl-node
node.left avl-node
node.right avl-node)
(set! node.height (+ 1 (max (if (null? node.left) 0 node.left.height)
(if (null? node.right) 0 node.right.height))))))
Нужно БОЛЬШЕ сахара!
Этот пример я делал в лиспе, когда нужно было "украсить" код одного алгоритма, решета эратосфена. В нём я ввёл синтаксис сокращённого доступа к элементам массива.
;;обычный лисп:
(aref a 2)
;;украшеный синтаксис:
a[2]
Как достичь такого синтаксиса? Также как и раньше, с помощью макросов!
(defmacro with-arr (&body body)
(let ((new-body (tree-expr-replace-aref body)))
`(progn ,@new-body)
))вспомогательные функции
(defun tree-expr-replace-aref (expr)
(let ((fd '()))
(cond ((null expr) '())
((and
(symbolp expr)
(progn
(setf fd (split-arrayindex-symbol expr))
;;(prn "fd: " fd "\n")
fd))
;;(list (field-def-name-get fd) (field-def-var fd)))
(list 'aref (tree-expr-replace-aref (car fd)) (cdr fd)))
((listp expr)
;;(prn "TR-REPL: find set!: " fd "\n")
(cons (tree-expr-replace-aref (car expr))
(tree-expr-replace-aref (cdr expr))))
(t
expr))))
(defun split-arrayindex-symbol (symb)
(let* ((str (symbol-name symb))
(len (length str))
(last (1- len)))
(if (and (> len 3)
(char= (char str last) #\]))
(let ((pos (string-at-end str #\[)))
(format nil "pos: ~A~%" pos)
(if (and pos (> pos 0) (< pos last))
(cons (read-from-string str nil nil :start 0 :end pos)
(read-from-string str nil nil :start (+ pos 1) :end last))
nil))
nil)))
(defun string-at-end (str ch)
(let ((last-ind (- (length str) 1)))
(do ((i last-ind (- i 1)))
((or (< i 0)
(char= (char str i) ch))
(if (< i 0) nil i)))))
;улучшить код алгоритма решета, если изменить макрос for, так чтобы он принимал шаг цикла, например так:
(defmacro for ((var start stop . step) &body body)
(let ((gstop (gensym))
(step (if (null step) 1 (car step))))
`(do ((,var ,start (+ ,var ,step))
(,gstop ,stop))
((> ,var ,gstop))
,@body)))
И тогда код решета эратосфена на Лиспе будет выглядеть так:
(defun eratosfen2 (n)
(let ((a (make-array (1+ n))))
(with-arr
(setf a[0] nil)
(setf a[1] nil)
(for (i 2 n)
(setf a[i] i))
(for (i 2 (floor (sqrt n)))
(when a[i]
(for (j (* i i) n i)
(setf a[j] nil))))
(remove nil a))))
Выводы
На самом деле все авторы языков программирования изобретают новые синтаксисы улучшая выразительность языков. В компилируемых языках это происходит почти бесплатно, для конечного результата, а в интерпретируемых, бывает код раскрытия нового синтаксиса нагружает интерпретатор, поэтому в таких языках синтаксические излишества замедляют выполнение. Разработчики Scheme(а вместе с ней и Script-fu) предпочли ограничиться минимальным синтаксическим набором для интерпретатора, но вместе с тем дали мощный инструмент развития синтаксиса в руки программиста, который может по своей прихоти и конечно же по необходимости вводить в язык новые языковые конструкции. При этом если раскрытие макроса происходит заблаговременно(как это делает макрос define-m, а на самом деле можно формировать уже "раскрытые" файлы программ), то такие языковые расширения проходят бесплатно и для процесса интерпретации программы.