Собственная линейная алгебра на лиспе 2

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

Пусть, например, есть такие две функции

(defun get-vector-one () (print "get-vector-one") (vec3f 1.0 0.0 0.0))
(defun get-vector-two () (print "get-vector-two") (vec3f 0.0 2.0 0.0))

Тогда вызов

(add3f (get-vector-one) (get-vector-two)) 


выдаст:

"get-vector-one"
"get-vector-two"
"get-vector-one"
"get-vector-two"
"get-vector-one"
"get-vector-two"
#(1.0 2.0 0.0)

Получается, что обе функции будут вызваны трижды. Чтобы понять почему это так, можно посмотреть во что развернется макрос add3f в этом вызове:

>(macroexpand '(add3f (get-vector-one) (get-vector-two)))

(MAKE-ARRAY 3 :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-CONTENTS
    (LIST (+ (VEC3F-X (GET-VECTOR-ONE)) (VEC3F-X (GET-VECTOR-TWO)))
          (+ (VEC3F-Y (GET-VECTOR-ONE)) (VEC3F-Y (GET-VECTOR-TWO)))
          (+ (VEC3F-Z (GET-VECTOR-ONE)) (VEC3F-Z (GET-VECTOR-TWO)))))

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

Решение проблемы заключается в том, чтобы ввести вспомогательные переменные при помощи конструкции (let (...) ...) и вычислить значения параметров один раз в эти вспомогательные переменные. Фактически, хочется чтобы при раскрытии «(add3f (get-vector-one) (get-vector-two))» получалось:

(LET ((TEMP1 (GET-VECTOR-ONE)) (TEMP2 (GET-VECTOR-TWO)))
  (VEC3F (+ (VEC3F-X TEMP1) (VEC3F-X TEMP2))
         (+ (VEC3F-Y TEMP1) (VEC3F-Y TEMP2))
         (+ (VEC3F-Z TEMP1) (VEC3F-Z TEMP2))))

Чтобы не заморачиваться с тем, как называть временные переменные, в Common Lisp есть функция GENSYM, которая возвращает уникальный символ, которым не пользовались и не воспользуются где-то еще. Теперь макрос add3f будет совершать еще два действия: во-первых, создавать на каждый входной параметр уникальный символ функцией GENSYM, и, во-вторых, генерировать конструкцию LET с необходимыми присвоениями:

(defmacro add3f (&rest vecs) "Сложение векторов"
  (let ((gensyms (loop for v in vecs collect (gensym))))
       `(let (,@(loop for g in gensyms for v in vecs collect `(,g ,v)))
           (vec3f (+ ,@(map 'list (lambda(v) `(vec3f-x ,v)) gensyms)) 
                  (+ ,@(map 'list (lambda(v) `(vec3f-y ,v)) gensyms)) 
                  (+ ,@(map 'list (lambda(v) `(vec3f-z ,v)) gensyms))))))

Абсолютно тоже самое нужно проделать и для разности. Для остальных векторных макросов с фиксированным кол-вом параметров все гораздо проще, можно воспользоваться известным макросом once-only. Изначально в Common Lisp его вроде как нет, но его легко можно написать самому, или взять отсюда:

(defmacro once-only ((&rest names) &body body)
  (let ((gensyms (loop for n in names collect (gensym))))
    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
      `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
        ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
           ,@body)))))

Суть его проще всего понять на примере. Вот так вот выглядит исправленная версия mul3f:

(defmacro mul3f (v s) "Покомпонентное умножение вектора v на скаляр s"
  (once-only (v s)
    `(vec3f (* (vec3f-x ,v) ,s) 
            (* (vec3f-y ,v) ,s) 
            (* (vec3f-z ,v) ,s))))

once-only обеспечивает одноразовое вычисление переданных ей параметров.

Наконец, под катом привожу полный код текущей версии векторной математики:



(defmacro once-only ((&rest names) &body body)
  (let ((gensyms (loop for n in names collect (gensym))))
    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
      `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
        ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
           ,@body)))))

(defmacro vec3f (x y z) "Создание вектора по координатам"
  `(make-array 3 :element-type 'single-float :initial-contents (list ,x ,y ,z)))

;;; Привычное обращение к координатам вектора
(defmacro vec3f-x (v)   `(elt ,v 0))
(defmacro vec3f-y (v)   `(elt ,v 1))
(defmacro vec3f-z (v)   `(elt ,v 2))

(defmacro mul3f (v s) "Покомпонентное умножение вектора v на скаляр s"
  (once-only (v s)
    `(vec3f (* (vec3f-x ,v) ,s) 
            (* (vec3f-y ,v) ,s) 
            (* (vec3f-z ,v) ,s))))

(defmacro div3f (v s) "Покомпонентное деление вектора v на скаляр s"
  (once-only (v s)
    `(vec3f (/ (vec3f-x ,v) ,s) 
            (/ (vec3f-y ,v) ,s) 
            (/ (vec3f-z ,v) ,s))))

(defmacro dot3f (a b) "Скалярное произведение векторов"
  (once-only (a b)
    `(+ (* (vec3f-x ,a) (vec3f-x ,b)) 
        (* (vec3f-y ,a) (vec3f-y ,b))
        (* (vec3f-z ,a) (vec3f-z ,b)))))

(defmacro qlen3f (v)  "Квадрат длины вектора"  (once-only (v) `(dot3f ,v ,v)))
(defmacro len3f  (v)  "Длина вектора"          `(sqrt (qlen3f ,v)))
(defmacro norm3f (v)  "Нормирование вектора" 
  (once-only (v) `(div3f ,v (len3f ,v))))

(defmacro add3f (&rest vecs) "Сложение векторов"
  (let ((gensyms (loop for v in vecs collect (gensym))))
      `(let (,@(loop for g in gensyms for v in vecs collect `(,g ,v)))
           (vec3f (+ ,@(map 'list (lambda(v) `(vec3f-x ,v)) gensyms)) 
                  (+ ,@(map 'list (lambda(v) `(vec3f-y ,v)) gensyms)) 
                  (+ ,@(map 'list (lambda(v) `(vec3f-z ,v)) gensyms))))))

(defmacro sub3f (&rest vecs) "Вычитание векторов"
  (let ((gensyms (loop for v in vecs collect (gensym))))
      `(let (,@(loop for g in gensyms for v in vecs collect `(,g ,v)))
           (vec3f (- ,@(map 'list (lambda(v) `(vec3f-x ,v)) gensyms)) 
                  (- ,@(map 'list (lambda(v) `(vec3f-y ,v)) gensyms)) 
                  (- ,@(map 'list (lambda(v) `(vec3f-z ,v)) gensyms))))))

(defmacro cross3f (a b) "Векторное произведение векторов"
  (once-only (a b)
    `(vec3f (- (* (vec3f-y ,a) (vec3f-z ,b)) (* (vec3f-z ,a) (vec3f-y ,b)))
            (- (* (vec3f-z ,a) (vec3f-x ,b)) (* (vec3f-x ,a) (vec3f-z ,b)))
            (- (* (vec3f-x ,a) (vec3f-y ,b)) (* (vec3f-y ,a) (vec3f-x ,b))))))

(defmacro triple3f (a b c) "Смешанное произведение векторов"
  `(dot3f (cross3f ,a ,b) ,c))