← Архив: Common Lisp

Простой code walker

Author: · 22.11.2014 16:29
· original author: archimag
Есть (будет) код на базе cl-async. Это значит, что в нём много разных lambda, которые вызываются асинхронно. Есть некое состояние, представленное в виде набора специальных (динамических) переменных. Очень хочется, что бы это состояние было одинаковым во всех вложенных lambda. Но поскольку это все работает в асинхронной среде, то с помощью let этого добиться нельзя. Есть идея использовать небольшой code-warlker, который модифицирует все вложенные lambda таким образом, что бы перед вызовом оригинального кода происходила настройка необходимого контекста.
Какой самый простой способ сделать это? Пока думаю взять код из iterate или arnesi и модифицировать его.
· original author: motopeh
В ходе асинхронных операций состояние может меняться?
· original author: archimag
> В ходе асинхронных операций состояние может меняться?
Состояние может, но биндинги остаются те же самые. Речь идёт о RESTAS в связке с cl-async (wookie). Надо что объекты *request*, *reply*, а также контекст модулей, были доступны во всём вложенном коде без явного участия разработчика. 
· original author: vi1
>Но поскольку это все работает в асинхронной среде, то с помощью let этого добиться нельзя. 


Из-за того что-ли, что special vars thread local?


Не совсем понял задачу, на простом примере можно?


IMHO code-walker любого рода оправдан только в коде реализации.
· original author: archimag
> Не совсем понял задачу, на простом примере можно?
Вот есть старый пример на базе синхронного веб-сервера (Hunchentoot): https://github.com/archimag/restas/blob/master/example/example-1.lisp
Теперь я хочу заставить его работать с асинхронным веб-сервером wookie. Для этого я переписываю этот пример (а ещё много чего другого) следующим образом:
(ql:quickload "cl-who")
(ql:quickload "restas.wookie")
(restas:define-module #:restas.example-1
  (:use #:cl #:iter)
)

(in-package #:restas.example-1)
(restas:define-route main ("" :method :get)
  (who:with-html-output-to-string (out)
    (:html
     (:body
      ((:form :method :post)
       ((:input :name "message"))
       ((:input :type "submit" :value "Send"))
)
)
)
)
)

(restas:define-route main/post ("" :method :post)
  (let ((future (asf:make-future)))
    (as:with-delay (3)
      (asf:finish future
       (who:with-html-output-to-string (out)
         (:html
          (:body
           (:div
            (:b (who:fmt "test message: ~A"
                         (restas:post-parameter "message")
)
)
)

           ((:a :href (restas:genurl 'main)) "Try again")
)
)
)
)
)

    future
)
)

(restas.wookie:start '#:restas.example-1 :port 8080)
Т.е. я добавил as:with-delay для задержки ответа на 3 секунда.
Через 3 секунды главный even-loop обнаружит это событие и активирует код, который находится в теле макроса as:with-delay.
И упадёт, потому что в этом коде происходит вызов (restas:post-parameter "message"), который требует настроенной переменной restas:*request* и в начале обработки маршрута она была настроена. Но замыкания не захватывают динамический контекст. И по событию таймера, когда запустится основной код, эта переменная окажется unbound.
RESTAS активно используют динамические переменные, я считаю это удобным (очень) и хочу продолжать использовать необходимые динамические переменные даже при асинхронной обработке.
· original author: motopeh
Т.е. проблему можно выразить так?
CL-USER> (defvar *dynamic-variable-x*)
*DYNAMIC-VARIABLE-X*
CL-USER> (defun foo ()
           (format *standard-output* "~A~%"
                   *dynamic-variable-x*
)
)

FOO
CL-USER> (as:start-event-loop
          (lambda ()
            (let ((future (asf:make-future))
                  (*dynamic-variable-x* "Hello")
)

              (as:with-delay (3)
                (asf:finish future
                            (funcall #'foo)
)
)

              (setf *dynamic-variable-x* "Bye")
)
)
)

; Evaluation aborted on #<UNBOUND-VARIABLE *DYNAMIC-VARIABLE-X* {B388C89}>.
· original author: vi1
А еще лучше так, без веба вашего, которого я не знаю :)
(require :bordeaux-threads)
(defvar *q* 'main)
(defun foo ()
  (print *q*))
(defmacro in-thread (&body body)
  `(bt:join-thread
     (bt:make-thread
       (lambda ()
         ,@body))))
(in-thread (foo)) ; => MAIN
(let ((*q* 'main-new)) (foo)) ; => MAIN-NEW
(let ((*q* 'main-new)) (in-thread (foo))) ; => MAIN
· original author: motopeh
Теперь тоже самое но без тяжёлых ОС-тредов, а асинхронно.
· original author: motopeh
CL-USER> (as:start-event-loop
          (lambda ()
            (let ((future (asf:make-future))
                  (*dynamic-variable-x* "Hello")
)

              (let ((x *dynamic-variable-x*))
                (as:with-delay (1)
                  (let ((*dynamic-variable-x* x))
                    (asf:finish future
                                (funcall #'foo)
)
)
)
)

              (setf *dynamic-variable-x* "Bye")
)
)
)

Hello
1
· original author: motopeh
Форматтер кода сломался, что-ли?
· original author: vi1
Я не знаю, что есть as:, но если он не создает тредов, то и проблемы с special varsбы не было, am I right?
· original author: motopeh
cl-async
· original author: vi1
OK. раз на cl-async проявляется "проблема", значит cl-async треды использует,  в чем его легкость?
· original author: vi1
В общем думать надо :) Если было желание использовать special vars
по делу (dynamic binding) и "нахаляву" (same syntax) 
в multi-threaded env, то, наверное, облом. Если dynamic binding нужен
по делу, то может эмулировать это поведение стеком. С локами там,
всеми делами, которые можно в макросы засунуть. Опять же, рассуждения
общие, какая нужна механика именно для веба не представляю.
· original author: archimag
>  раз на cl-async проявляется "проблема", значит cl-async треды использует, 
Хм. Забей. Это придумали несколько лет назад. Если интересно, то можешь посмотреть например http://libevent.org/ (на ней основанна cl-async) . Правда, cl-async сейчас портируют на libuv, но это не важно.
· original author: orivej
> Какой самый простой способ сделать это? Пока думаю взять код из iterate или arnesi и модифицировать его.
Наверное, проще всего использовать macroexpand-dammit.
Ещё с sb-walker легко экспериментировать, и может, стоит его использовать с #+sbcl.
Интересно, как в зависимости от walker'а компилятор будет сообщать об ошибках в коде.
· original author: archimag
> Наверное, проще всего использовать macroexpand-dammit
А я попробовал cl-walker,  он правда типа устарел и вместо него теперь dwim.hu.walker, но у меня на dwim.hu аллрегия, поэтому взял вот этот форк: https://github.com/angavrilov/cl-walker
Теперь простой вариант "проброса" переменных restas:*request* и restas:*reply* выглядит так:
(defmacro with-restas-context (form)
  (alexandria:with-unique-names (request reply)
    (labels ((visitor (item)
               (when (typep item 'cl-walker:lambda-function-form)
                 (modify-lambda item)
)

               item
)

             #|---------------------------------------------------------------|#
             (modify-lambda (lform)
               (let* ((request-bind (make-instance 'cl-walker:variable-binding-entry-form
                                                   :name 'restas:*request*
                                                   :value (make-instance 'cl-walker:free-variable-reference-form
                                                                         :name request
)
)
)

                      #|------------------------------------------------------|#
                      (reply-bind (make-instance 'cl-walker:variable-binding-entry-form
                                                 :name 'restas:*reply*
                                                 :value (make-instance 'cl-walker:free-variable-reference-form
                                                                       :name reply
)
)
)

                      #|------------------------------------------------------|#
                      (let-form (make-instance 'cl-walker:let-form
                                               :parent lform
                                               :bindings (list request-bind reply-bind)
                                               :body (cl-walker:body-of lform)
)
)
)

                 #|-----------------------------------------------------------|#
                 (setf (cl-walker:parent-of request-bind) let-form
                       (cl-walker:parent-of reply-bind) let-form
)

                 #|-----------------------------------------------------------|#
                 (iter (for x in (cl-walker:body-of lform))
                       (setf (cl-walker:parent-of x) let-form)
)

                 #|-----------------------------------------------------------|#
                 (setf (cl-walker:body-of lform)
                       (list let-form)
)
)
)
)

      #|----------------------------------------------------------------------|#
      (let* ((ast (cl-walker:walk-form form))
             #|---------------------------------------------------------------|#
             (request-bind (make-instance 'cl-walker:variable-binding-entry-form
                                          :name request
                                          :value (make-instance 'cl-walker:free-variable-reference-form
                                                                :name 'restas:*request*
)
)
)

             #|---------------------------------------------------------------|#
             (reply-bind (make-instance 'cl-walker:variable-binding-entry-form
                                        :name reply
                                        :value (make-instance 'cl-walker:free-variable-reference-form
                                                              :name 'restas:*reply*
)
)
)

             #|---------------------------------------------------------------|#
             (result-form (make-instance  'cl-walker:let-form
                                          :parent (cl-walker:parent-of ast)
                                          :bindings (list request-bind reply-bind)
                                          :body (list ast)
)
)
)

        #|--------------------------------------------------------------------|#
        (cl-walker:map-ast #'visitor ast)
        #|--------------------------------------------------------------------|#
        (cl-walker:unwalk-form result-form)
)
)
)
)

И проблемный код, если его обернуть в данный макрос, начинает правильно работать.
· original author: motopeh
Ты хочешь чтобы функции as:with-delay работали в теле определения маршрутов? Почему бы просто не определить адаптированные под restas формы with-delay на базе as:with-delay?
· original author: archimag
> Ты хочешь чтобы функции as:with-delay работали в теле определения маршрутов?
Нет, макрос as:with-delay тут просто для примера, именно он на самом деле нужен меньше всего. Я хочу делать асинхронный запрос к БД  (или ещё к чему-нибудь) и получил результат генерить HTML (или JSON). Я не знаю какой именно драйвер БД будет использоваться и, собственно, не хочу это знать. Синтаксис может быть очень разным (например, может использоваться cl-async-future), но в любом случае для callback будет использоваться lambda (как вариант, flet/labels).
· original author: fionbio
(сейчас предпочитаю регистрироваться как ivan4th, но на мой e-mail на сайте
осталась старая регистрация, как fionbio).
Андрей, я уже писал в письме, что, на мой взгляд, с самой идеей
использовать walker есть некоторые проблемы. Одна из них - то,
что обрабатываться будет только тело маршрута. Допустим, если
я сделаю функцию вроде
(defun load-object (param-name)
  (alet ((x (do-something)))
    ...
    (load-something-async (restas:post-parameter param-name))
)
)

, а затем вызову её из маршрута, то получу проблемы, т.к. walker
эту функцию не обрабатывает. Можно, конечно, добавить сюда
свой defun, но это, на мой взгляд, уже слишком. Не говоря уже
про прочие проблемы walker'ов - например, в iterate под CCL
не работают assert'ы из-за сложностей со special forms, а для
отладчика блоки iterate являются единым целым, что не слишком
урощает отладку. iterate я всё равно ценю и активно использую,
но не хотелось бы умножения подобного кода с трудностями.
Я в письме тебе предлагал уже альтернативный способ,
связанный с оборачиванием callback'ов для futures (promises
в blackbird). Я форкнул blackbird и реализовал там эту
фичу, отправлю позже pull request автору - https://github.com/ivan4th/blackbird
Ключевой коммит:
https://github.com/ivan4th/blackbird/commit/12b083519273ae79e7563e48ec8463fe1e41bb2b
Пример использования:
(defpackage :blackbird-special-vars
   (:use :cl :alexandria)
)

(in-package :blackbird-special-vars)
(defun dbg (fmt &rest args)
  (let ((*print-readably* nil))
    (format *debug-io* "~&;; ~?~%" fmt args)
)
)

(defun aprint (future)
  (asf:attach future
              #'(lambda (&rest values)
                  (format t "values=~{~a~^ ~}" values)
)
)
)

(defvar *my-var* nil)
(pushnew '*my-var* bb:*promise-keep-specials*)
(defun some-db-request ()
  (let ((promise (bb:make-promise)))
    (as:with-delay (0.1)
      (bb:finish promise 100)
)

    promise
)
)

(defun get-my-var () *my-var*)
(defun some-func ()
  (let ((*my-var* 42))
    (bb:alet ((x (some-db-request)))
      (when x (* *my-var* x))
)
)
)

В repl (при использовании cl-async-repl) это выглядит так
(тут у меня сломалась вставка кода в сообщении форума):
BLACKBIRD-SPECIAL-VARS> (aprint (some-func))
#<BLACKBIRD:PROMISE callback(s): 0 errback(s): 0 finished: NIL forward: NIL {100F334723}>
values=4200
Caveat - эта штука работает только с promises, для
того же as:with-delay и других не-promise-асинхронных-примитив
она не сработает. Но, насколько я понимю, тут
мы исходим именно из работы с promises (ранее futures).
· original author: fionbio
Сорри, скопипастил код, который ещё для cl-async-future, а
не blackbird сделан - всё равно работает в силу обратной совместимости,
но лучше так:
· original author: fionbio
... код почему-то не вставился(?):
(defpackage :blackbird-special-vars
  (:use :cl :alexandria)
)

(in-package :blackbird-special-vars)
(defun dbg (fmt &rest args)
  (let ((*print-readably* nil))
    (format *debug-io* "~&;; ~?~%" fmt args)
)
)

(defun aprint (promise)
  (bb:attach promise
             #'(lambda (&rest values)
                 (format t "values=~{~a~^ ~}" values)
)
)
)

(defvar *my-var* nil)
(pushnew '*my-var* bb:*promise-keep-specials*)
(defun some-db-request ()
  (let ((promise (bb:make-promise)))
    (as:with-delay (0.1)
      (bb:finish promise 100)
)

    promise
)
)

(defun get-my-var () *my-var*)
(defun some-func ()
  (let ((*my-var* 42))
    (bb:alet ((x (some-db-request)))
      (when x (* *my-var* x))
)
)
)
· original author: fionbio
Последний *my-var* можно для убедительности заменить
на (get-my-var) (хотя пофиг)
· original author: archimag
> с самой идеей использовать walker есть некоторые проблемы
Ну, проблемы всегда есть, но я хотел бы иметь несколько альтернативных вариантов преодоление проблемы.
> Одна из них - то,что обрабатываться будет только тело маршрута
Проблему решает макрос with-keep-restas-context, который можно использовать где угодно. Применение валкера для самого маршрута в любом случае будет опциональным, ибо там один и тот же код как для синхронного варианта (где это не нужно), так и для асинхронного.
> в iterate под CCL не работают assert'ы и
iterate основана на очень старом коде, там очень старый кодевалкер. А cl-walker основана на коде из arnesi, который потом ещё допиливал  Attila Lendvai (он же маньяк).