GIMP Script-Fu Первый Дан. Удобная передача параметров в функцию

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

Script-fu(Тинисхема) передает параметры в функцию в виде списка и позволяет передавать значения в обязательные именованные параметры, функции с одним параметром принимающим неограниченное количество значений , или функции смешанного типа, с обязательными именованными параметрами и параметром остатком в виде списка.

(define  (f1 a b c)    (prn "a: " a ", b: " b ", c: " c "\n"))  (f1 12 'akk "temp1") ;;a: 12, b: akk, c: temp1  (define  (f2 . rest)    (prn "rest: " rest "\n"))  (f2 12 'akk "temp1") ;;rest: (12 akk temp1)  (define  (f3 a b c . rest)    (prn "a: " a ", b: " b ", c: " c ", rest: " rest "\n"))  (f3 12 'akk "temp1") ;;a: 12, b: akk, c: temp1, rest: () (f3 12 'akk "temp1" 1 2 3 'a 'b 'c) ;;a: 12, b: akk, c: temp1, rest: (1 2 3 a b c) 

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

Что необходимо реализовать.

Мне хотелось бы иметь возможность работать с именованными параметрами, задавая их передачу при вызыове функции так:

(f a b c :k1 23 :k2 "test k2" 1 2 3) ;; k1 k2  это имена для некоторых параметров 

Функцию будем определять как

(defun (func a b c .. &opt o1 o2 (o3 def-o3) .. &key k1 k2 (k3 def-k3) ... &rest r)    ....)

;; Первоначально: функцию будем определять как (defun (func a b c .. &opt o1 o2 o3 .. &key :k1 :k2 (:k3 def-k3) ... &rest r)    ....)

И вот чтобы такое простенькое определение работало, я написал вот в такой (сложнейший)длиннейший макрос:

(define-macro (defun param-list . body)    (let* ((name (car param-list))           (params (split-params (cdr param-list)))           (param-base (reverse (car params)) )           (rest-in-fun (gensym))           (args (gensym)) (arg-opt (gensym)) (arg-key (gensym)) (arg-rest (gensym))           (vars-opt (gensym))           (param-opt  (reverse (cadr params)))           (param-key  (reverse (caddr params)))           (names-key  (make-key-names param-key))           (param-rest (cadddr params))           (has-rest (or (not (null? param-opt))                         (not (null? param-key))                         (not (null? param-rest)))))       `(begin           ,@(make-def-keys names-key) ;;генерация определений ключевых параметров функции           (define-m (,name                      ,@(if (not (null? param-base))                            param-base)  ;;функция принимает - базовые параметры(если есть)                      . ,(if has-rest    ;; и остаток(его будем разбирать во время работы функции)                             rest-in-fun                             nil))              (let* (,@(if (not (null?  param-opt)) ;; генерация определений опциональных параметров                           (make-opt-vars param-opt))                     ,@(if (not (null?  param-key)) ;; генерация определений ключевых параметров                           (make-key-vars param-key))                     ,@(if (not (null?  param-rest));;генерация определения остаточного параметра                           (make-rest-vars param-rest))                     (,args (split-args ,(if has-rest ;;промежуточная переменная принмающая остаток                                             rest-in-fun ;;разобраный на различные виды параметров.                                             '())                                        ',param-opt ',names-key ',param-rest))                     (,arg-opt (car ,args))           ;;значения опциональных аргументов                     (,arg-key (cadr ,args))          ;;значения ключевых аргументов                     (,arg-rest (caddr ,args)))       ;;значения остаточного аргумента                 ,@(if (not (null?  param-opt)) ;;присвоение опциональным параметрам значений опц.                       (make-opt-sets (make-opt-names param-opt) arg-opt)                       '())                 ,@(if (not (null?  param-key)) ;;присвоение ключевым параметрам значений ключ. арг.                       (make-key-sets names-key arg-key)                       '())                 ,@(if (not (null?  param-rest));;присвоение остаточных значений остаточному арг..                       (make-rest-sets param-rest arg-rest)                       '())                 ,@body)))))                    ;;ИСХОДНОЕ ТЕЛО ФУНКЦИИ!!! 

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

;; макрос определяющий ключевые слова. Желательно вида :a (define-macro (def-key a)   `(define ,a ',a)) ;; определение ключевых слов для использования в определениях функций. (def-key &opt) (def-key &key) (def-key &rest)  ;;чтобы ключи были доступны в программе их надо объявить вне функции ;;эта функция подготавливает определения для объявления. (define-m (make-def-keys keys)   (fold (lambda (all cur)           (let ((key (cond                       ((atom? cur) cur)                       ((pair? cur) (car cur)))))             (cons `(define ,key ',key) all)))         '()         keys)) ;;тест (make-def-keys '(:k1 :k2 (:k4 3) :k5 (:k6 23))) ;;((define :k6 ':k6) (define :k5 ':k5) (define :k4 ':k4) (define :k2 ':k2) (define :k1 ':k1)) 

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

;;выделим из макроса функционал рабирающий параметры. (define-m (split-params params)    (let ((param-base '())          (param-opt  '())          (param-key  '())          (param-rest '()))       (while (and (not (null? params))                   (and (not (eq? (car params) &opt))                        (not (eq? (car params) &key))                        (not (eq? (car params) &rest))))          (set! param-base (cons (car params) param-base))          (set! params (cdr params)))       (if (and (not (null? params))                (eq? (car params) &opt))           (begin              (set! params (cdr params))              (while (and (not (null? params))                          (and (not (eq? (car params) &key))                               (not (eq? (car params) &rest))))                 (set! param-opt (cons (car params) param-opt))                 (set! params (cdr params)))))       (if (and (not (null? params))                (eq? (car params) &key))           (begin              (set! params (cdr params))              (while (and (not (null? params))                          (not (eq? (car params) &rest)))                 (set! param-key (cons (car params) param-key))                 (set! params (cdr params)))))       (if (and (not (null? params))                (eq? (car params) &rest))           (begin              (set! params (cdr params))              (set! param-rest (cons (car params) param-rest))))       (list param-base param-opt param-key param-rest))) ;;тест (split-params '(b1 b2 b3 &opt o1 (o2 12) (o3 13) &key k1 (k2 a) (k3 67) &rest r1)) ;;((b3 b2 b1) ((o3 13) (o2 12) o1) ((k3 67) (k2 a) k1) (r1))

Как видим она возвращает список из 4х списков параметров, вначале в цикле собирая базовые параметры, потом опциональные, затем ключевые и уже потом остаток. Имея этот список мы уже можем сформировать заголовок определения функции, подставив туда базовые параметры и, если есть, возможность получения дополнительных параметров в переменную rest-in-fun. И здесь мы используем базовые возможности тинисхемы, по получению дополнительных параметров. А далее мы вставляем код, позволяющий разобрать входящие дополнительные параметры, создать определения их символов и присвоить значения из входящих переменных, или из значений заданных по умолчанию. При этом происходит условная макроподстановка, т.е если некоторых определений в у функции нет, то и код по разбору таких параметров не добавляется.

Генерацию кода для инициализации параметров выполняют функции:

(define-m (make-opt-vars opt)   (reverse  (fold (lambda (all cur)                     (let ((val (cond                                 ((atom? cur) (cons cur (cons #f '())))                                 ((pair? cur) cur))))                       (cons val all)))                   '()                   opt)))  (define-m (make-key-vars keys)   (reverse  (fold (lambda (all cur)      (let ((val (cond ((atom? cur) (cons cur (cons #f '()))) ((pair? cur) (cons (car cur) (cdr cur))))))       (cons val all)))   '()   keys)))   (define-m (make-rest-vars rest)   (reverse  (fold (lambda (all cur)                     (let ((val (cond                                 ((atom? cur) (cons cur (cons #f '())))                                 ((pair? cur) cur))))                       (cons val all)))                   '()                   rest))) ;;тест (make-opt-vars '(o1 o2 (o3 12) o4 (o5 2))) ;;((o1 #f) (o2 #f) (o3 12) (o4 #f) (o5 2))    (make-key-vars '(k1 k2 (k4 3) k5 (k6 23))) ;;((k1 #f) (k2 #f) (k4 3) (k5 #f) (k6 23))

А вот генерацию кода для присвоения значений, из переданных в функцию параметров, выполняют функции:

(define (make-opt-sets opt args-var)   (do ((param opt (cdr param))        (rez   '()))       ((null? param) (reverse rez))     (set! rez           (cons            `(if (not (null? ,args-var))                 (begin                   (set! ,(car param) (car ,args-var))                   (set! ,args-var (cdr ,args-var))))            rez))))  (define-m (make-key-sets keys args-var)    (do ((param keys (cdr param))         (rez   '())         (tmp   (gensym)))        ((null? param) (reverse rez))      (set! rez    (cons     `(let ((,tmp (find-key ,args-var ,(caar param))))        (if (cdr ,tmp)     ;;ключ найден во входных аргументах!    (set! ,(cdar param) (cdar ,tmp))))     rez))))     (define-m (make-rest-sets rest args-var)   (cons    `(if (not (null? ,args-var))         (begin           (set! ,(car rest)   ,args-var)))    '()))

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

(define-m (split-args args opt keys rest)    (let ((opt-args '())          (keys-args '())          (rest-args '()))      (while (and (not (null? opt))   ;;есть несопоставленные опциональные аргументы?                   (not (null? args))  ;;есть переданные аргументы                  (not (cdr (find-key keys (car args))))) ;;а не является ли значение ключом?        (set! opt-args (cons (car args) opt-args))        (set! args (cdr args))        (set! opt  (cdr opt)))      (while (and (not (null? args))                ;;есть ли ещё аргументы?                  (cdr (find-key keys (car args)))) ;;тек. аргумент ялвяется ключом?        (set! keys-args (cons (cons (car args) (cadr args)) keys-args))        (set! args (cddr args)))      (if (not (null? args))          ;;если ещё остались аргументы сбросим всё в остаток.          (set! rest-args args))      (list (reverse opt-args) (reverse keys-args) rest-args))) 

Это основная рабочая лошадка разбирающая переданные в функцию аргументы. То есть, ещё раз: split-params работает на этапе генерации функции, а split-args работает когда функция вызывается. Она как и функция разбора параметров возвращает список списков, хранящий переданные ключевые аргументы, опциональные и остаточные.

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

;;ключевое слово это символ с префиксом типа : или & мы его создаём из обычного имени добавляя ":" (define (var2keyword var)   (string->symbol (string-append ":" (symbol->string var))))   (define-m (make-key-names keys)   (reverse  (fold (lambda (all cur)     (let ((val (cond ((pair? cur) (cons (var2keyword (car cur)) (car cur))) ((atom? cur) (cons (var2keyword cur)       cur)))))       (cons val all)))   '()   keys)))  ;;(make-key-names '(k1 k2 (k4 3) k5 (k6 23))) ;;((:k1 . k1) (:k2 . k2) (:k4 . k4) (:k5 . k5) (:k6 . k6))  (define-m (find cmp keys)    (do ((find  #f)         (ret   nil)         (keys keys (cdr keys)))          ((or find               (null? keys)) (cons ret find))       (let ((cur (car keys)))          (if (cmp cur)              (begin                 (set! ret cur)                 (set! find #t))))))                  (define-m (find-key keys key)    (find (lambda (cur)             (or (and (atom? cur) (eq? cur key))                 (and (pair? cur) (eq? (car cur) key))))          keys))  ;;(find-key  '((:k4 15) :k3 (:k2 13) :k1)  ':k2) ;;((:k2 13) . #t)

(define-m (make-opt-names opt)   (reverse  (fold (lambda (all cur)                     (let ((val (cond                                 ((pair? cur) (car cur))                                 ((atom? cur) cur))))                       (cons val all)))                   '()                   opt)))

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

Макрос действительно сложный для понимания и имеет множество вспомогательных функций, так что порой бывает не очень понятно какая функция для чего служит. Такой макрос за раз не пишеться, а пишется эволюционно, постпенно обрастая фунциональностью, которая в свою очередь тестируется поэтапно. Так что не пугайтесь, если с первого раза вы не поняли его работы. Метапрограммирование это действительно сложная задача. Но зато когда она решена мы можем пользоваться благами созданного нами языкового расширения. Все функции данного макроса собраны в файле defun.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"))

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

;; без аргументов (defun (f1) (prn "Hello\n")) ;;Hello  ;; используя базовые возможности тинисхемы (defun (f2 a b)     (prn "a: " a ", b: " b "\n"))  (f2 1 3 ) ;;a: 1, b: 3  ;;используем опциональные параметры (defun (f3 a b &opt o1 (o2 13) o3 (o4 15))   (prn "o1 : " o1 ", o2: " o2 ", o3: " o3 ", o4: " o4 "\n"))  (f3 1 3 4) ;;o1 : 4, o2: 13, o3: #f, o4: 15  ;;используем опциональные и ключевые аргументы (defun (f5 a b &opt o1 o2 &key k1 (k2 13) k3 (k4 15))   (prn "a: " a ", b: " b ", o1: " o1 ", o2: " o2 ", k1: "  k1  ", k2: " k2 ", k3: " k3 ", k4: "  k4 "\n"))  (f5 1  2 5 :k1 12 :k4 26 :k3 3 12 23 34 44) ;;a: 1, b: 2, o1: 5, o2: #f, k1: 12, k2: 13, k3: 3, k4: 26  (f5 1  2 :k1 12 :k4 26 :k2 31 12 23 34 44) ;;a: 1, b: 2, o1: #f, o2: #f, k1: 12, k2: 31, k3: #f, k4: 26  ;;использование опциональных, ключевых и остаточного параметра. (defun (f6 a b &opt o1 (o2 122) &key k1 (k2 13) k3 (k4 15) &rest last-vars)   (prn "a: " a ", b: " b ", o1: " o1 ", o2: " o2 ", k1: "  k1  ", k2: " k2 ", k3: " k3         ", k4: "  k4 ", last-vars: " last-vars "\n") )  (f6 1  2 5 :k1 12 :k4 26 :k3 3 12 23 34 44) ;a: 1, b: 2, o1: 5, o2: 122, k1: 12, k2: 13, k3: 3, k4: 26, last-vars: (12 23 34 44) 

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

Как оно работает.

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

функция использующая ключевые параметры.

(defun (f9 &key k1 (k2 3) k3 (k4 45) &rest last)   (print "Hello")   (prn "k1 : " k1 "\n")   (prn "k2 : " k2 "\n")   (prn "k3 : " k3 "\n")   (prn "k4 : " k4 "\n")   (prn "last:" last "\n")) 

;;(get-closure-code f9) (lambda gensym-49 ;;принимаемый параметр.   (let* ((k1 #f) (k2 3) (k3 #f) (k4 45) (last #f) ;;первоначальная инициализация переменных  (gensym-50 (split-args gensym-49 '() '((:k1 . k1) (:k2 . k2) (:k3 . k3) (:k4 . k4)) '(last))) ;;разбор переданных значений  (gensym-51 (car gensym-50))   ;;опциональные параметры  (gensym-52 (cadr gensym-50))  ;;ключевые   (gensym-53 (caddr gensym-50)));;остаток.     (let ((gensym-55 (find-key gensym-52 :k1)))      ;;присвоение значений ключевым параметрам       (if (cdr gensym-55) (set! k1 (cdar gensym-55))))     (let ((gensym-55 (find-key gensym-52 :k2)))       (if (cdr gensym-55) (set! k2 (cdar gensym-55))))     (let ((gensym-55 (find-key gensym-52 :k3)))       (if (cdr gensym-55) (set! k3 (cdar gensym-55))))     (let ((gensym-55 (find-key gensym-52 :k4)))       (if (cdr gensym-55) (set! k4 (cdar gensym-55))))     (if (not (null? gensym-53))                     ;;присвоение значений остатку.    (begin (set! last gensym-53)))     (print "Hello")                                 ;;тело исходной функции.     (prn "k1 : " k1 "\n")     (prn "k2 : " k2 "\n")     (prn "k3 : " k3 "\n")     (prn "k4 : " k4 "\n")     (prn "last:" last "\n")))

(f9  :k4 2  :k1 5 3 12 23 34 44) ;; "Hello" ;; k1 : 5 ;; k2 : 3 ;; k3 : #f ;; k4 : 2 ;; last:(3 12 23 34 44)

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

Второй пример, Функция использующая опциональные параметры:

(defun (f10 a1 a2 &opt o1 (o2 222) &rest rest)    (print "Hello")       (prn "a1 : " a1 "\n")       (prn "a2 : " a2 "\n")       (prn "o1 : " o1 "\n")       (prn "o2 : " o2 "\n")       (prn "rest:" rest "\n")) 

(get-closure-code f10) (lambda (a1 a2 . gensym-95)    (let* ((o1 #f) (o2 222) (rest #f)           (gensym-96 (split-args gensym-95 '(o1 (o2 222)) '() '(rest)))           (gensym-97 (car gensym-96))           (gensym-98 (cadr gensym-96))           (gensym-99 (caddr gensym-96)))       (if (not (null? gensym-97)) ;;обрабатываем опциональный параметр и уменьшаем список значений(если он есть)           (begin (set! o1 (car gensym-97))                  (set! gensym-97 (cdr gensym-97))))       (if (not (null? gensym-97))           (begin (set! o2 (car gensym-97))                  (set! gensym-97 (cdr gensym-97))))       (if (not (null? gensym-99))           (begin (set! rest gensym-99)))       (print "Hello")       (prn "a1 : " a1 "\n")       (prn "a2 : " a2 "\n")       (prn "o1 : " o1 "\n")       (prn "o2 : " o2 "\n")       (prn "rest:" rest "\n"))) 

А здесь нет кода обрабатывающего ключевые пареметры.

(f10 1 2 3) ;; "Hello" ;; a1 : 1 ;; a2 : 2 ;; o1 : 3 ;; o2 : 222 ;; rest:#f  (f10 1 2 3 4 5 6 7) ;; "Hello" ;; a1 : 1 ;; a2 : 2 ;; o1 : 3 ;; o2 : 4 ;; rest:(5 6 7) 

Единая точка синтаксической абстракции.

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

Например!! Посмотрите на код который генерируется при раскрытии функции f9, он работает, но это пять вызовов поиска по списку, причём если ключевого аргумента там нет, будет просмотрен весь список. Это очень не эффективно. Давайте изменим алгоритм присвоения значений ключевым параметрам и будем обрабатывать не не список ключей, а список текущих значений переданных ключей. За создание кода присвоения значений ключевым переменным отвечает функция make-key-sets.

;;keys: ((:k1 . k1) (:k2 . k2) (:k4 . k4) (:k5 . k5) (:k6 . k6)) ;;args-var  имеет формат : ((:k1 . 12) (:k4 . 26) (:k3 . 3)) (define-m (make-key-sets keys args-var)    (let ((el (gensym))          (cond-body '()))       `((for-list (,el ,args-var)                   (cond                    ,@(do ((cur-key   keys (cdr cur-key))                           (cond-body '()  (cons `((eq? (car ,el) ',(caar cur-key))                                                   (set! ,(cdar cur-key) (cdr ,el)))                                                 cond-body)))                            ((null? cur-key) (reverse cond-body))))))))  ;;двойная скобка перед for-list нужна для того чтобы соблюсти формат возврата ранее используемой ;;функции, хотя можно было бы поменять и основное тело макроса. 

(make-key-sets '((:k1 . k1) (:k2 . k2) (:k4 . k4) (:k5 . k5) (:k6 . k6))                'name-args-var) --> (let ((gensym-40 nil))    (let gensym-39          ((gensym-38 name-args-var))       (cond ((not (null? gensym-38))              (set! gensym-40 (car gensym-38))              (cond ((eq? (car gensym-40) ':k1)                     (set! k1 (cdr gensym-40)))                    ((eq? (car gensym-40) ':k2)                     (set! k2 (cdr gensym-40)))                    ((eq? (car gensym-40) ':k4)                     (set! k4 (cdr gensym-40)))                    ((eq? (car gensym-40) ':k5)                     (set! k5 (cdr gensym-40)))                    ((eq? (car gensym-40) ':k6)                     (set! k6 (cdr gensym-40))))              (gensym-39 (cdr gensym-38))))))

делаем это определение в системе и вновь определяем функцию f9 и смотрим

;;(get-closure-code f9) (lambda gensym-68    (let* ((k1 #f) (k2 3) (k3 #f) (k4 45) (last #f)           (gensym-69 (split-args gensym-68 '()                                  '((:k1 . k1) (:k2 . k2) (:k3 . k3) (:k4 . k4)) '(last)))           (gensym-70 (car gensym-69))           (gensym-71 (cadr gensym-69))           (gensym-72 (caddr gensym-69)))       (let ((gensym-74 nil))          (let gensym-67 ((gensym-66 gensym-71)) ;;начало цикла и присвоение первоначального значения - список ключ.             (cond ((not (null? gensym-66))                    (set! gensym-74 (car gensym-66))                    (cond ((eq? (car gensym-74) ':k1)                           (set! k1 (cdr gensym-74)))                          ((eq? (car gensym-74) ':k2)                           (set! k2 (cdr gensym-74)))                          ((eq? (car gensym-74) ':k3)                           (set! k3 (cdr gensym-74)))                          ((eq? (car gensym-74) ':k4)                           (set! k4 (cdr gensym-74))))                    (gensym-67 (cdr gensym-66)))))) ;;это и есть цикл по уменьшающемуся списку.       (if (not (null? gensym-72))           (begin (set! last gensym-72)))       (print "Hello")       (prn "k1 : " k1 "\n")       (prn "k2 : " k2 "\n")       (prn "k3 : " k3 "\n")       (prn "k4 : " k4 "\n")       (prn "last:" last "\n")))

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

Ну и на этом на сегодня всё. Спасибо за внимание.