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

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

(define (test1)
  (let ((i 0))
     (while (< i 5)
	    (prn "i: " i "\n")
		(set! i (+ i 1))
)))	

;;код функции
(get-closure-code test1)
;(lambda () (let ((i 0)) (while (< i 5) (prn "i: " i "\n") (set! i (+ i 1)))))

Как видно текст функции храниться в неизменном виде.
Давайте посмотрим к какому поведению это приводит. Для этого слегка изменим макрос while

(define-macro (while . param-list)
  (prn "Run macro 'while'\n")
  (let ((cond-continue (car param-list))
        (body  (cdr param-list))
        (loop  (gensym)))
    `(let ,loop ()
          (when  ,cond-continue
            ,@body
            (,loop))
          )))

Как видно вызов функции prn не входит в код возвращаемый макросом, т.е не её вызов не будет вставлен в AST генерируемого макросом.

(test1)
Run macro 'while'
i: 0
i: 1
i: 2
i: 3
i: 4

Вроде ничего не законного нет? Один раз раскрыли макрос и всё! Давайте слегка изменим программу.

(define (test2)
  (let ((i 0))
     (while (< i 3)
	    (let ((j 0))
	        (while (< j 2)
	            (prn "i: " i ", j: " j "\n")
				(set! j (+ j 1)))
		(set! i (+ i 1)))
        )))	

(test2)
;;Run macro 'while'
;;Run macro 'while'
;;i: 0, j: 0
;;i: 0, j: 1
;;Run macro 'while'
;;i: 1, j: 0
;;i: 1, j: 1
;;Run macro 'while'
;;i: 2, j: 0
;;i: 2, j: 1
;;()

Вот здесь уже видна проблема, макрос while вызывается столько раз, сколько раз на него передаётся управление, один раз при входе во внешний цикл, и 3 раза при входе во внутренний цикл. Теперь я думаю вы начинаете представлять, что происходит при работе функции sort-quick3, она вся состоит из макросов той или иной степени сложности раскрытия, и только номинально является "быстрой".

Как избежать такого поведения тинисхемы?

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

Я сделал это при помощи функции our-macro-expand1 и макроса define-m(они помещены в файл util.scm):

;раскрываем макросы в функциях до использования функций с помощью макроса define-m
(define (our-macro-expand1 tr)
   (if (atom? tr)
       tr
       (let ((head-code (our-macro-expand1 (car tr)))
             (rest-code (our-macro-expand1 (cdr tr))))
         (let ((ret  (cons head-code rest-code)))
           (if (and (symbol? head-code)
                    (defined? head-code)
                    (macro? (eval head-code)))
                 (our-macro-expand1 (macro-expand ret)) ;;в раскрытии макроса могут быть макросы!
                 ret))
         )))

(define-macro (define-m . param-list)
  (let ((body   param-list)
        (name   (caar param-list)))
    `(begin
       (define ,@body)
       (define ,name (eval (our-macro-expand1 (get-closure-code ,name)))))))

Макрос define-m вначале определяет функцию как обычно, а затем извлекая её код связанный с именем, раскрывает все макросы с помощью вызова функции our-macro-expand1, переопределяет функцию.

Посмотрим, что из этого получиться:

(define-m (test2)
  (let ((i 0))
     (while (< i 3)
	    (let ((j 0))
	        (while (< j 2)
	            (prn "i: " i ", j: " j "\n")
				(set! j (+ j 1)))
		(set! i (+ i 1)))
        )))
;;Run macro 'while'
;;Run macro 'while'
;;test2

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

(test2)
i: 0, j: 0
i: 0, j: 1
i: 1, j: 0
i: 1, j: 1
i: 2, j: 0
i: 2, j: 1

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

(get-closure-code test2)

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

Тестируем скорость выполнения функций подвергшихся раскрытию макросов

Выполненные нами действия вероятно ускорили выполнение наших функций, вопрос состоит в том, на сколько ускорили?

Для определения скорости работы тестов, да и любых функций нам потребуется конструкция замеряющая время их выполнения. В скрипт-фу реализована функция gettimeofday, но воспользоваться ей не удастся, это функция встроена в скрипт-фу из переделанного расширения tsx, и работает НЕПРАВИЛЬНО. Нам нужно воспользоваться оригинальной функцией из этого расширения. Как работать с расширениями и скомпилировать их для использования в скрипт-фу я уже рассказывал выше. Итак грузим расширение:

(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"))

(define p-ext (string-append (getenv "HOME") "/work/scheme/tiny/gimp/"))
(define p-ext-my (string-append p-ext "my-ext/myext"))
(load-extension p-ext-my)
(load-extension (string-append p-ext "tsx/tsx"))

(load (string-append path-lib "random.scm"))

Проверяем правильно ли работает необходимая нам функция

;;работа функции из поставки скрипт-фу
(gettimeofday)
;;(-1457 -674093)
;; работа оригинальной функции из tsx
(gettimeofday)
;;(1696493712 956295)

(define sec-day (* 3600 24))
(define sec-year (365 (* 3600 24)))
(/ (car (gettimeofday)) sec-year)
;;53,79548697.0
(+ 1970 (/ (car (gettimeofday)) sec-year))
;;2023,795488.0

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

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

(define-macro (time . param-list)
   (let ((body   (car  param-list))
         (tmp1   (gensym))
         (tmp2   (gensym))
         (val    (gensym)))
     `(let ((,tmp1 (gettimeofday))
            (,tmp2 #f)
            (,val  #f))
        (set! ,val ,body)
        (set! ,tmp2 (gettimeofday))
        (display "exec time : ")
        (display (+ (* (- (car ,tmp2) (car ,tmp1)) 1000000)
                    (- (cadr ,tmp2) (cadr ,tmp1)))) (newline)
                    ,val)))

Для проверки загрузим функции сортировки из sort.scm и sort2.scm, отличающиеся друг от друга тем, что во втором применен макрос define-m для определения функций сортировки, и к именам функций добавлен суффикс -c, обозначающий что функция скомпилирована(т.е избавлена от макросов).

(load (string-append path-lib "sort.scm"))
(load (string-append path-lib "sort2.scm"))

(define (compare-work-sort f1 f2 compare lst)
  (let ((r1 #f)     
        (r2 #f))
    (set! r1 (time (f1 compare lst)))
    (set! r2 (time (f2 compare lst)))
    (if (equal? r1 r2)
        (begin
          (display "EQVIVALENT rez: ") (display r1) (newline))
        (begin
          (display "DIFERENCE rez1: ") (display r1) (newline)
          (display "DIFERENCE rez2: ") (display r2) (newline)))))

(define (list2vector lst)
  (let* ((len (length lst))
         (rez (make-vector len)))
    (do ((cur lst (cdr cur))
         (i    0  (+ i 1)))
        ((or (>= i len)  (null? cur)) rez)
         (vector-set! rez i (car cur)))))

Для тестирования определим ещё пару функций. В тинисхеме есть функция превращающая список в массив, НО при 1000 элементах в списке она просто зависает!! Связано это с максимальным количеством аргументов при вызове функции.

(compare-work-sort sort sort-c < (list2vector (rand-lst 100 100)))
;;exec time : 1666329
;;exec time : 14658
;;EQVIVALENT rez: #(0 1 2 5 6 6 9  ..... 99)
(/ 1666329 14658)
;;113,6805158.0

(compare-work-sort sort sort-c < (rand-lst 100 100))

;;exec time : 386582
;;exec time : 20633
;;EQVIVALENT rez: (2 2 4 4 6 6 ......  99)
;;#t#<EOF>
(/ 386582  20633)
;;18,73610236.0

Разница на массиве длины 100 составила более 100 раз, на списках, всего 18 раз!

(compare-work-sort sort sort-c < (list2vector (rand-lst 500 1000)))
;;exec time : 39732146
;;exec time : 479992
;;EQVIVALENT rez: #(0 0 1 1 1 2 2 ... 499)
(/ 39732146 479992)
;;82,77668378.0
(compare-work-sort sort sort-c < (list2vector (rand-lst 500 1000)))
;;exec time : 63250106
;;exec time : 754232
;;EQVIVALENT rez: #(0 0 ...
(/ 63250106 754232)
;;83,86027907.0

(compare-work-sort sort sort-c < (rand-lst 500 1000))
;;exec time : 11278720
;;exec time : 1081434
;;EQVIVALENT rez: (0 0 3 3 ...
(/ 11278720 1081434)
;;10,42941132.0

(/ 16398333 1125471)
;;14,57019594.0

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

;;код без макросов
(time (sort-c > (list2vector (rand-lst 1000 5000)))) ;;5000 элементов массив
;;exec time : 5136027

;;код с макросами
(time (sort > (list2vector (rand-lst 1000 5000))))   ;;5000 элементов массив
;;не дождался окончания, пришлось убить скрипт-фу

;;код без макросов
(time (sort-c > (rand-lst 1000 5000)))               ;;5000 элементов список
;;exec time : 6710530

;;код с макросами
(time (sort > (rand-lst 1000 1000)))                 ;;1000 элементов список
;;exec time : 8262799

(time (sort > (rand-lst 1000 2000)))                 ;;2000 элементов список
;;exec time : 14677815

(time (sort > (rand-lst 1000 3000)))                 ;;3000 элементов список
;;exec time : 34436987

(time (sort > (rand-lst 1000 4000)))
;;не дождался окончания.

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

P.S. Единственным отрицательным моментом при таком подходе будет некоторое снижение скорости работы функции загрузки кода load, так как теперь при загрузке происходит раскрытие макросов. С этим негативным фактором тоже можно бороться, путём сохранения кода функций у которого уже раскрыты макросы в промежуточные файлы, которые и следует загружать.