← Архив: Common Lisp

Ленивый LET

Author: · 07.02.2011 18:26
· original author: Paul.Alkhimov
Существует ли такой let/let*, который выполнял бы привязку только в тот момент, когда это значение используется?
· original author: pseudo-cat
а зачем нужна ленивая привязка
· original author: treep
Если речь про что-то вроде
(let ((big (make-array '(много))))
  (if что-то
      big используется
      не используется
)
)

т.е. чтобы не аллоцировать память раньше времени, то можно просто использовать setf чтобы контролировать время аллокации:
(let (big)
  (if что-то
      (progn
        (setf big (make-array '(много))) ;; привязка
        big используется
)

      не используется
)
)

или даже так сделать, чтобы не запутаться:
(llet ((big (make-array '(много))))
  (if что-то
      (progn
        (bind big) ;; привязали
        big используется
        (unbind big) ;; отвязали
        результат
)

      не используется
)
)

;;; или
(llet ((big (make-array '(много))))
  (if что-то
      (with-bind (big)
        big используется
        результат
)

      не используется
)
)


unbind в данном случае может быть нужет если алгоритм работает действительно долго и есть смысл отвязать переменную (для GC).
· original author: treep
Хотя, проще let подвинуть под if :)
· original author: Paul.Alkhimov
Я поясню.
Вот у меня есть большая функция, с множеством привязок. По большому счёту, мне бы хорошо автозаменой все использования переменных заменить на вызываемый код в том месте, где встречаются переменные. Но некоторые встречаются по нескольку раз, поэтому переменные всё-таки вводить нужно. Но если я всё это сделаю, то читать код станет невозможно. Сейчас код громоздкий, но читабельный. А станет нечитабельным.
Лучше всего было бы использовать что-то вроде макроса, полностью аналогичного let'у, но кэширующего, если можно так выразиться. Для функций подобная техника называется memoize.
Меня же интересует такое же, но для переменных.
Вот код функции.
(defun intersection-of-aabb-with-ray (aabb ray)
  "RAY is an array [2 3] coordinates: the vector \"from\" and the vector \"direction\". "
  (declare (optimize (debug 3)))
  (let* ((x (aref ray 0 0))
         (y (aref ray 0 1))
         (z (aref ray 0 2))
         (dx (aref ray 1 0))
         (dy (aref ray 1 1))
         (dz (aref ray 1 2))
         (aabb-data (corners aabb))
         (x0 (car aabb-data)) (aabb-data (cdr aabb-data))
         (y0 (car aabb-data)) (aabb-data (cdr aabb-data))
         (z0 (car aabb-data)) (aabb-data (cdr aabb-data))
         (x1 (car aabb-data)) (aabb-data (cdr aabb-data))
         (y1 (car aabb-data)) (aabb-data (cdr aabb-data))
         (z1 (car aabb-data))
         (method
          (cond ((not (= 0.0 (* dx dy dz))) :arbitrary) ;; the most frequent case is tested first
               ((= 0.0 dx dy dz) :zero-direction)
                ((= 0.0 dy dz) :x-line)
                ((= 0.0 dx dz) :y-line)
                ((= 0.0 dx dy) :z-line)
                ((= 0.0 dz) :xy-plane)
                ((= 0.0 dx) :yz-plane)
                ((= 0.0 dy) :xz-plane)
                (t (error "Failed to test the (~a,~a,~a) vector." dx dy dz))
)
)

         ;; To make dx, dy and dz >=0, the space can be flipped:
        (flipped-x (when (< dx 0.0)
                      (setf dx (- dx))
                      (setf x (- x))
                      (setf x0 (- x1))   ;; !!! 0 -> 1
                     (setf x1 (- x0))
)
)
;; !!! 1 -> 0
        (flipped-y (when (< dy 0.0)
                      (setf dy (- dy))
                      (setf y (- y))
                      (setf y0 (- y1))   ;; !!! 0 -> 1
                     (setf y1 (- y0))
)
)
;; !!! 1 -> 0
        (flipped-z (when (< dz 0.0)
                      (setf dz (- dz))
                      (setf z (- z))
                      (setf z0 (- z1))   ;; !!! 0 -> 1
                     (setf z1 (- z0))
)
)
;; !!! 1 -> 0
        (result (case method
                   (:x-line (when (and (<= y0 y y1)
                                       (<= z0 z z1)
                                       (<= x x0)
)

                              (list x0 y z)
)
)

                   (:y-line (when (and (<= x0 x x1)
                                       (<= z0 z z1)
                                       (<= y y0)
)

                              (list x y0 z)
)
)

                   (:z-line (when (and (<= x0 x x1)
                                       (<= y0 y y1)
                                       (<= z z0)
)

                              (list x y z0)
)
)

                   (:xy-plane (let* ((t-from-x (/ (- x0 x) dx))
                                     (t-from-y (/ (- y0 y) dy))
                                     (x-hit (+ x (* dx t-from-y)))
                                     (y-hit (+ y (* dy t-from-x)))
)

                                (when (and (<= 0.0 t-from-x)
                                           (<= 0.0 t-from-y)
                                           (<= z0 z z1)
)

                                  (if (<= x0 x-hit x1)
                                      (list x-hit y0 z)
                                      (when (<= y0 y-hit y1)
                                        (list x0 y-hit z)
)
)
)
)
)

                   (:xz-plane (let* ((t-from-x (/ (- x0 x) dx))
                                     (t-from-z (/ (- z0 z) dz))
                                     (x-hit (+ x (* dx t-from-z)))
                                     (z-hit (+ z (* dz t-from-x)))
)

                                (when (and (<= 0.0 t-from-x)
                                           (<= 0.0 t-from-z)
                                           (<= y0 y y1)
)

                                  (if (<= x0 x-hit x1)
                                      (list x-hit y z0)
                                      (when (<= z0 z-hit z1)
                                        (list x0 y z-hit)
)
)
)
)
)

                   (:yz-plane (let* ((t-from-y (/ (- y0 y) dy))
                                     (t-from-z (/ (- z0 z) dz))
                                     (y-hit (+ y (* dy t-from-z)))
                                     (z-hit (+ z (* dz t-from-y)))
)

                                (when (and (<= 0.0 t-from-y)
                                           (<= 0.0 t-from-z)
                                           (<= x0 x x1)
)

                                  (if (<= y0 y-hit y1)
                                      (list x y-hit z0)
                                      (when (<= z0 z-hit z1)
                                        (list x y0 z-hit)
)
)
)
)
)

                   (:arbitrary (let* ((te (/ (- x0 x) dx)) ;; hit YZ plane at x = x0
                                     (y-res (+ y (* dy te)))
                                      (z-res (+ z (* dz te)))
)

                                 (if (and (<= 0.0 te)
                                          (<= y0 y-res y1)
                                          (<= z0 z-res z1)
)

                                     (list x0 y-res z-res)
                                     (let* ((te (/ (- y0 y) dy)) ;; hit XZ plane at y = y0
                                           (x-res (+ x (* dx te)))
                                            (z-res (+ z (* dz te)))
)

                                       (if (and (<= 0.0 te)
                                                (<= x0 x-res x1)
                                                (<= z0 z-res z1)
)

                                           (list x-res y0 z-res)
                                           (let* ((te (/ (- z0 z) dz)) ;; hit XY plane at z = z0
                                                 (x-res (+ x (* dx te)))
                                                  (y-res (+ y (* dy te)))
)

                                             (when (and (<= 0.0 te)
                                                        (<= x0 x-res x1)
                                                        (<= y0 y-res y1)
)

                                               (list x-res y-res z0)
)
)
)
)
)
)
)
)
)
)

    (when result
      (when flipped-x
        (setf (nth 0 result) (- (nth 0 result)))
)

      (when flipped-y
        (setf (nth 1 result) (- (nth 1 result)))
)

      (when flipped-z
        (setf (nth 2 result) (- (nth 2 result)))
)
)

    (values result
            method
            (when flipped-x :flipped-x)
            (when flipped-y :flipped-y)
            (when flipped-z :flipped-z)
)
)
)

Хотелось бы получить этот механизм на уровне конструкции языка, а не вводить дополнительную логику в программу.
Подскажите, кто видел что-то подобное описанному мною?
· original author: Paul.Alkhimov
Я немного притомился и забыл пояснить. В этой большой функции добавлять ленивость нужно на переменные TE, #-HIT, T-FROM-#, #-RES.
Из этой функции вылетать надо как можно быстрее, вычисляя как можно меньше по ходу пьесы. Если же я делаю вычисления заранее, то я потенциально сильно замедляю алгоритм: функция будет вызываться очень много раз, накладные расходы будут очень велики.
Например, в кусочке:
(:arbitrary (let* ((te (/ (- x0 x) dx)) ;; hit YZ plane at x = x0
                 (y-res (+ y (* dy te)))
                  (z-res (+ z (* dz te)))
)

             (if (and (<= 0.0 te)
                      (<= y0 y-res y1)
                      (<= z0 z-res z1)
)

                 (list x0 y-res z-res)

вычислять y-res нужно только после того, как известно, что [0.0 <= te]. А z-res надо вычислять только после того, как y-res пройдёт тест.
· original author: vsedach
Можно сделать вот так:
(defmacro lazy-let1 (((var exp)) &body body)
  (let ((storage-var (gensym)))
   `(let (,storage-var)
      (symbol-macrolet ((,var (or ,storage-var (setf ,storage-var ,exp))))
        ,@body
)
)
)
)
· original author: Paul.Alkhimov
Круто, спасибо!
· original author: Paul.Alkhimov
Я ж так понимаю, единственный способ обойти постоянные проверки на наличие значение в рантайме - это какой-то codewalker времени компиляции?
Существует что-нибудь на эту тему?
· original author: Ander Skirnir
Есть честный self-modifying code на уровне машинных кодов, но это очень хитрая и низкоуровневая тема, там надо учитывать глубину кеша процессора и вообще быть с ним на ты :)
Есть threaded-code аля форт.
А здесь могу еще предложить нечто наподобие call-by-need - обернуть ленивость санками. Чота типа:
(labels ((lazy () (setf #'lazy (constantly (your-expression)))))
  ...
)

У меня щас под рукой нету Лиспа, поэтому всё приблизительно. Суть в том, что вместо ленивого биндинга используется функция, переопределяющая себя при первом вызове в константную функцию, возвращающую результат вычисления заданного выражения. Это скорее всего будет тормознее подхода с макролитом, зато есть и преимущество - выражение будет вычисляться 1 раз на все 100, а в (or ,storage-var (setf ,storage-var ,exp)) есть pitfall - если это находится в цикле и выражение возвращает nil, то вычисляться будет на каждой итерации.
· original author: Paul.Alkhimov
Так я же хочу вычислить один раз, т.е. кешировать. А
(labels ((lazy () (setf #'lazy (constantly (your-expression)))))
  ...
)

будет вычислять тело your-expression каждый раз при вызове lazy.
Или я чего-то не понял в идее?
· original author: anton0xf
constantly вычисляет свой аргумент и возвращает лямбду, которая всегда возвращает результат этого вычисления, и после первого вычисления lazy станет равна этой лямбде, так что все, вроде правильно)
· original author: Ander Skirnir
anton0xf правильно подметил. Кстати, на зелёной надписи constantly можно кликнуть и почитать в спеке.
Вышеприведённый код в таком виде работать не будет, но теперь я снова с имаксом:
(let (lazy-var)
  (setq lazy-var
        (lambda ()
          (funcall
           (setq lazy-var
                 (lambda () (print 5))
)
)
)
)

  #1=(funcall lazy-var)
  (+ #1# #1# #1#)
)

5
5
5
5
=> 15
(let (lazy-var)
  (setq lazy-var
        (lambda ()
          (funcall
           (setq lazy-var
                 (constantly (print 5))
)
)
)
)

  #1=(funcall lazy-var)
  (+ #1# #1# #1#)
)

5
=>
15
(defmacro lazy-let-1 (((var expr)) &body body)
  (let ((sym (gensym)))
    `(let (,sym)
       (setq ,sym
             (lambda ()
               (funcall
                (setq ,sym
                      (constantly ,expr)
)
)
)
)

       (symbol-macrolet ((,var (funcall ,sym)))
         ,@body
)
)
)
)

(lazy-let-1 ((x (print 5)))
  (+ x x x)
)

5
=>
15
Первые два наглядно демонстрируют, что эта телега всё-таки работает как-надо. Дальше - обёртка этого дела макросом.
· original author: Ander Skirnir
Правда лучше пример использования макроса такой:
(lazy-let-1 ((x (print 5)))
  (princ "im first")
  (+ x x x)
)

Легко убедиться, что (print 5) отрабатывает позже, чем (princ "im first").
· original author: slav
ИМХО наиболее эффективный вариант такой:
(defmacro lazy-let (bindings &body body)
  (flet ((gensym-maker (suffix)
           (lambda (x) (gensym (concatenate 'string (string x) (string suffix))))
)
)

    (let ((values (loop for (var  nil) in bindings
                     collect (gensym (string var))
)
)

          (undef (gensym "UNDEF"))
)

      `(let ,(loop for val in values
                  collect `(,val ',undef)
)

         (declare (ignorable ,@values))
         (symbol-macrolet ,(loop for (var expr) in bindings
                              for val in values
                              collect `(,var (if (eq ,val ',undef)
                                                 (setf ,val ,expr)
                                                 ,val
)
)
)

           ,@body
)
)
)
)
)

Пример использования:
CL-USER> (lazy-let ((a (print 'a))
                    (b (print 'b))
                    (c (progn (print 'c) nil))
)

           (print 'first)
           (list c a c)
)

FIRST
C
A
(NIL A NIL)
Как можно видеть, a и c вычислены по 1 разу (в т. ч. и c, возвращающее nil), b не вычислено ни разу.
Фактически, мы используем уникальный символ (полученный через gensym) как маркер "неинициализированной" переменной - таким образом мы можем корректно обрабатывать возвращаемые nil-ы. Другой способ - завести отдельные переменные-флаги того, что значения вычислились (это может быть нужно если мы хотим, к примеру, декларировать тип у "ленивых" переменных с целью, к примеру, оптимизации).
· original author: slav
Вернее там в макросе самый первый flet не нужен. Т. е. макрос такой:
(defmacro lazy-let (bindings &body body)
  (let ((values (loop for (var  nil) in bindings
                   collect (gensym (string var))
)
)

        (undef (gensym "UNDEF"))
)

    `(let ,(loop for val in values
              collect `(,val ',undef)
)

       (declare (ignorable ,@values))
       (symbol-macrolet ,(loop for (var expr) in bindings
                            for val in values
                            collect `(,var (if (eq ,val ',undef)
                                               (setf ,val ,expr)
                                               ,val
)
)
)

         ,@body
)
)
)
)
· original author: Paul.Alkhimov
@Ander Skirnir: а почему в коде
;; пусть EXPR возвращает число, тогда (см. комментарии):
(defmacro lazy-let-1 (((var expr)) &body body)
  (let ((sym (gensym)))
    `(let (,sym)
       (setq ,sym ;; 5) на символ привязываем лямбду из п.4, т.е. число
            (lambda () ;; 4) на эту лямбду привязываем число
              (funcall ;; 3) вызвали замыкание и получили число
               (setq ,sym ;; 2) привязали замыкание к символу
                     (constantly ,expr)
)
)
)
)
;; 1) вернули замыкание
      (symbol-macrolet ((,var (funcall ,sym))) ;; 6) привязываем к ,var число вызовом лямбды из п.5
        ,@body
)
)
)
)

делается так многоступенчато? Почему прямо невозможно переназначить символу другую лямбду? Почему надо funcall'ом вызывать лямбду, полученную из constantly (а потом ещё раз внутри макролета)? И почему лямбда назначается символу два раза? И последнее, я правильно понял ход алгоритма (описано в комментариях)?
@slav: красиво. А что делал тот ненужный флет?
· original author: Ander Skirnir
Корректны пункты 1, 2, 3, если вкладывать в это правильный смысл.
Число, и лямбда, возвращающая число - это разные вещи.
Для начала, symbol-macrolet работает иначе - к ,var мы привязываем не число, а выражение (funcall ,sym), вот полный макроикспанд:

(sb-cltl2:macroexpand-all
 '(lazy-let-1 ((x (print 5)))
   (princ "im first")
   (+ x x x)
)
)

=>
(LET (#:G906)
  (SETQ #:G906
        (LAMBDA ()
          (FUNCALL (SETQ #:G906
                         (CONSTANTLY (PRINT 5))
)
)
)
)

  (PRINC "im first")
  (+ (FUNCALL #:G906) ;; 1
    (FUNCALL #:G906) ;; 2
    (FUNCALL #:G906) ;; 3
    
)
)

Теперь постараюсь по помеченным циферками вызовам описать суть:
1. В этом месте программы, до вычисления этого выражения, значением #:G906 будет

(LAMBDA ()
  (FUNCALL (SETQ #:G906
                 (CONSTANTLY (PRINT 5))
)
)
)

Ну запускается, значит, нащ вычислятор funcall с параметром - этой лямбдой, и давай её вычислять.
А вот по порядку, что за чем вычисляется (метки слева просто для обозначения):
<A>: (print 5) - печатает 5 и возвращает число 5
<B>: (constantly <A>) ===
(constantly 5) возвращает (lambda () 5)
<C>: (SETQ #:G906 <B>) - присваивает лексическому биндингу
#:G906 значение <B> и возвращает <B>
<D>: (FUNCALL <C>) - вычисляет лямбду
(lambda () 5) и возвращает число 5.
Итак, выражение слева от `;; 1` возвращает число 5.
2. В здесь значение
#:G906 уже равно (lambda () 5), потому оно вычисляется просто в 5.
3. См. 2.
· original author: Ander Skirnir
По теме:
http://en.wikipedia.org/wiki/Thunk_%28delayed_computation%29
http://en.wikipedia.org/wiki/Evaluation_strategy#Non-strict_evaluation
· original author: Paul.Alkhimov
По поводу пункта 4) я плохо выразился. Я имел в виду такое:
(lambda() 100)
Я правильно понимаю, что вызов фанколом лямбды нужна для того, чтобы отложить вычисление на момент выполнения (FUNCALL #:G906)?
Мне просто виделось что-то в виде, описанном slav - 09.02.2011 02:25: однократное вычисление переданного выражения и сохранение полученного значения в переменной.
· original author: Ander Skirnir
> Я правильно понимаю, что вызов фанколом лямбды нужна для того, чтобы отложить вычисление на момент выполнения (FUNCALL #:G906)?
Да.
> Мне просто виделось что-то в виде, описанном slav - 09.02.2011 02:25: однократное вычисление переданного выражения и сохранение полученного значения в переменной.
Ну так само
переданное выражение вычисляется однократно, при первом funcall #:.. Неоднократно форсится потом уже константный thunk, который возвращает вычисленный единожды результат исходного выражения. Это просто альтернативный подход. Здесь не надо делать проверку, а там не надо funcall'ить. Так как в common-lisp вызов функции - достаточно дорогая операция, этот подход по производительности значительно проигрывает. А вот что мне в нём нравится - это то, что он концептуально ближе к честному хотпатчингу.
· original author: Ander Skirnir
> хотпатчингу
Хотя я этот термин использую неправильно :(
Я имею ввиду самопереписывающийся код.