(defvar *akk-cache* nil)

(defun akk (x y)
  (let ((*akk-cache* (or *akk-cache*
                         (make-hash-table :test 'equal)))
        (stack `((,x ,y))))
    (flet ((akk-cache (m n)
             (gethash `(,m ,n) *akk-cache*))
           (new-value (value)
             (setf (gethash (car stack) *akk-cache*)
                   value)
             (cond
               ((not stack) t)
               ((not (second stack))
                (pop stack))
               ((second (second stack))
                (pop stack))
               (t (let ((m (first (car stack)))
                        (n (second (car stack)))
                        (i (first (second stack))))
                    (pop stack)
                    (pop stack)
                    (push (list i (gethash `(,m ,n) *akk-cache*))
                          stack))))))
      (loop
         while stack
         do (let ((m (first (car stack)))
                  (n (second (car stack))))
              (if (akk-cache m n)
                  (pop stack)
                  (cond ((= m 0)
                         (new-value (1+ n)))
                        ((and (= n 0)
                              (akk-cache (1- m) 1))
                         (new-value (akk-cache (1- m) 1)))
                        ((= n 0)
                         (push (list (1- m) 1)
                               stack))
                        ((and (akk-cache m (1- n))
                              (akk-cache (1- m)
                                         (akk-cache m (1- n))))
                         (new-value (akk-cache (1- m)
                                               (akk-cache m (1- n)))))
                        ((akk-cache m (1- n))
                         (push (list (1- m)
                                     (akk-cache m (1- n)))
                               stack))
                        (t (push (list (1- m))
                                 stack)
                           (push (list m (1- n))
                                 stack))))))
      (akk-cache x y)))) 

• Постоянно поддерживается список отлаживаемых в данный момент потоков
  
• Добавлен параметр *max-debugging-threads*: максимально возможное количество одновременно отлаживаемых потоков, значение по умолчанию - 5.
• Функция debug-mode-on - активизирует отладочный режим.
• Функция debug-mode-off - отменяет отладочный режим, имеет необязательный параметр kill-debugging-threads (по-умолчанию T) , который определяет надо ли уничтожать отлаживаемые в данный момент потоки.
• В случая наличия в системе swank-сервера, в переменную swank::*connection-closed-hook* добавляется вызов debug-mode-off , который обеспечивает отмену отладочного режима и уничтожение отлаживаемых потоков после разрыва соединения.
• Описанная схема применяется только к потокам, которые созданы hunchentoot для обработки запросов.

Я уж почти обрадовался, когда обнаружил, что в винде есть Asynchronous Procedure Call (APC) — это ведь почти аналог сигналов, т.е. в API поддерживается выполнение своего кода в контексте чужой нити. Но вот незадача — они будут вызываться только в определенные моменты. Поэтому для вызова кода в контексте другой нити пришлось остановиться на манипуляции стеком и контекстом нити с целью подставить туда свою функцию. По крайней мере, полурабочее решение реализовать удалось. Как обстоит дело с обработкой различных блокирующих вызовов в прерываемой нити, еще надо разобраться (хотя в простых тестах все нормально).

Благодаря подсказке до меня все-таки дошло, как надо обращаться с %GS. Итак, план по использованию TLS таков: при запуске нити нить сохраняет указатель на свою структуру (точнее, селектор для созданного сегмента с базой, равной началу структуры с данными нити и с бесконечным пределом) в %FS:0x14 (arbitrary data slot внутри Windows Thread Information Block). В определенные моменты из %FS:0x14 этот селектор копируется в %GS: в самом начале нити, после каждого вызова чужеродной функции и при входе в "импланированный" вызов процедуры.

Сперва я вообще подумал, что %GS сбрасывается всегда, когда нить вытесняется, но эксперименты показали, что %GS сбрасывается только при вызове win32-функций. Сбило с толку то, что через SetThreadContext не удавалось установить значение %GS, поэтому подумал, что этот регистр вообще не сохраняется в контексте нити.

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

$a + $b[1] 

((:VARIABLE :A) + (:VARIABLE :B) [ 1 ])

(+ (:VARIABLE :A) (ELT (:VARIABLE :B) 1))

(define-mode for-tag (70 :all)
  (:allowed :all)
  (:entry "{for\\s+[^}]*}(?=.*{/for})")
  (:entry-attribute-parser parse-for-attributes)
  (:exit "{/for}"))

{template test}
  {for $x in range(10)} ! {/for}
{/template}

(closure-template.parser:template ("test")
  (closure-template.parser:for-tag ((:variable :x)
                                    (:range 10))
                                    " ! "))

Погуглил по рунету и обнаружил, что нигде нет getting started для того
чтобы поднять hunchentoot и заняться наконец веб-программированием на
лиспе.

Ну раз нет, то надо написать, люди просят.

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

Итак, начнем с установки всего необходимого:

0. Устанавливаем sbcl. Что вы делаете, если (он еще) у вас не стоит.
1. Устанавливаем hunchentoot, например так:
   
   (require 'asdf-install)
   (asdf-install:install 'hunchentoot)
   
2. Устанавливаем ваши любимые библиотеки.

Запускаем лисп. Я запускаю его, заходя на сервер по ssh, внутри
приятной тулзы screen. И начинаем собственно писать код:

0. Подгружаем библиотеки (которые вы установили ранее). У меня так:
   
   (in-package :cl-user)
   (asdf:operate 'asdf:load-op '#:alexandria)
   (asdf:operate 'asdf:load-op '#:hunchentoot)
   (asdf:operate 'asdf:load-op '#:clsql)
   (asdf:operate 'asdf:load-op '#:closure-template)
   (asdf:operate 'asdf:load-op '#:split-sequence)
   (asdf:operate 'asdf:load-op '#:babel)
   (asdf:operate 'asdf:load-op '#:cl-json)
   (asdf:operate 'asdf:load-op '#:postmodern)
   (asdf:operate 'asdf:load-op '#:cl-store)
   (asdf:operate 'asdf:load-op '#:cl-blackjack)
   (asdf:operate 'asdf:load-op '#:cl-whores)
   
1. Есть переменная, на которую мы будем смотреть, чтобы
узнать, выдавать вам ошибки в slime, или героически справляться с
ними самостоятельно. Так как у меня может приходить до пяти запросов в
секунду и в случае ошибки slime оказывается парализованным
выстреливающими сообщениями, я делаю простые функции, чтобы в случае
такого epic fail зайти по ssh, выполнить функцию, и разбираться в
спокойной обстановке.
   Правда, я не знаю что делать, если в момент появления ошибки я был
отключен от сервера. Я догадываюсь о том, что произошла ошибка по
увеличению количества потоков "Hunchentoot worker" в Slime Threads, но
на моей системе они не дебажатся, хотя должны. Впрочем я на фряхе
пока, может быть в этом все и дело. На FreeBSD в sbcl потоки "более
другие".
   
   (defvar *catch-errors-p* nil)
   (defun err-on ()
     (setf *catch-errors-p* nil))
   (defun err-off ()
     (setf *catch-errors-p* t))
   
2. Создаем свой acceptor, который будет принимать запросы:
   
   (defclass debuggable-acceptor (hunchentoot:acceptor) ())
   
3. Переопределяем метод hunchentoot:acceptor-request-dispatcher,
чтобы добавить всплывание ошибок в отладчике, если *catch-errors-p*
установлена в нужное значение.
   
   (defmethod hunchentoot:acceptor-request-dispatcher ((acceptor debuggable-acceptor))
     (if *catch-errors-p*
          (call-next-method)
          (let ((dispatcher (handler-bind ((error #'invoke-debugger))
                              (call-next-method))))
            (lambda (request)
              (handler-bind ((error #'invoke-debugger))
                (funcall dispatcher request))))))
   
4. Пишем свой диспетчер, который будет разруливать запросы
   
(defun dispatcher (request)
  (let* ((request-host (hunchentoot:host))
         (request-full-str (hunchentoot:request-uri request))
         (request-parted-list (split-sequence:split-sequence #\? (hunchentoot:request-uri request)))
         (request-str (string-right-trim "\/" (car request-parted-list))))

    (let ((output
           (cond ((equal "/somepage" request-str) (somepage request))
                 ((equal "/otherpage" request-str) (otherpage request param))
                 (t (404page request))
                 )))
      (setf (hunchentoot:content-type*) "text/html; charset=utf-8")
      (babel:string-to-octets output :encoding :utf-8))
    ))
   
5. Пишем функции somepage и otherpage, которые отдают конкретные
страницы в этом примере. Лично я считаю удобным помещать такое в
отдельные пакеты, разбивая по функционалу, но у вас может быть свое
мнение на этот счет - я не настаиваю.
   
   (defun somepage (request)
      "This is somepage")
   (defun otherpage (request)
      "This is otherpage")
   
6. Инстанцируем свой acceptor, передавая ему свой диспетчер на нужном
вам порту, если необходимо:
   
   (defvar *debuggable-acceptor* (make-instance 'debuggable-acceptor
                                  :request-dispatcher 'dispatcher
                                  :port 80))
   
7. Запускаем hunchentoot и запрещаем ему обрабатывать ошибки
самостоятельно, без высочайшего соизволения:
   
   (hunchentoot:start *debuggable-acceptor*)
   (setf hunchentoot:*handle-http-errors-p* nil)
   
8. Зажигаем огонек в глазах, складываем весь вышеприведенный код в
один файл, исполняем в лиспе и заходим на http:://localhost/somepage -
чтобы проверить, работает ли все это на самом деле.

9. Пишем комментарий к этому посту, чтобы сообщить автору где он
ошибся, а где вообще пидарас неправ.

• cl-routes-0.2.1 (новая возможность описанная здесь)
  
• cl-closure-template-0.1.4 (скомпилированные шаблоны должны стать быстрее)
  
• restas-0.0.4 (подробности в предыдущем сообщении)

Modules

(restas:define-module #:hello-world
  (:use :cl))

(in-package #:hello-world)

(define-route main ("hello")
  "<h1>Hello world!</h1>")

(restas:start '#:hello-world :port 8080)

Submodules

(restas:define-module #:test
  (:use :cl))

(in-package #:test)

(restas:define-submodule test-hello-world (#:hello-world))

(restas:start '#:test :port 8080)

(restas:define-submodule rulisp-static (#:restas.directory-publisher)
  (restas.directory-publisher:*directory* (merge-pathnames "static/" *resources-dir*))
  (restas.directory-publisher:*autoindex* nil))

(restas:define-submodule rulisp-files (#:restas.directory-publisher)
  (restas.directory-publisher:*baseurl* '("files"))
  (restas.directory-publisher:*directory* (merge-pathnames "files/" *vardir*))
  (restas.directory-publisher:*autoindex-template*
   (lambda (data)
     (rulisp-finalize-page :title (getf data :title)
                           :css '("style.css" "autoindex.css")
                           :content (restas.directory-publisher.view:autoindex-content data)))))

Внутренняя инициализация

(restas:define-initialization (context)
  (restas:with-context context
    (when *feeds*
      (restas:context-add-variable context
                                   '*spider*
                                   (make-instance 'spider
                                                  :feeds *feeds*
                                                  :schedule *schedule*
                                                  :cache-dir (if *cache-dir*
                                                                 (ensure-directories-exist (merge-pathnames "spider/"
                                                                                                            *cache-dir*))))))))

(restas:define-finalization (context)
  (let ((spider (restas:context-symbol-value context '*spider*)))
    (when spider
      (spider-stop-scheduler spider))))

Дуализм

(restas:start '#:restas.directory-publisher 
              :port 8080 
              :context (restas:make-context (restas.directory-publisher:*baseurl* '("tmp"))
                                            (restas.directory-publisher:*directory* #P"/tmp/")
                                            (restas.directory-publisher:*autoindex* t)))

Попробую я реализовать поддержку нитей в виндовом порте SBCL. Посмотрел на исходники и удивился, что до сих пор никто не реализовал — видимо, очень верно утверждение о том, что коммьюнити у SBCL маленькое.

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

Исходники у SBCL довольно интересные. Видно, что есть места, в которых давно не "ступала нога человека". Вообще, ряд мест в исходниках (особенно что касается обработки и блокировки сигналов), в которых сложно разбираться. Документация (особенно что касается введения в различные вопросы) довольно скудная, но в целом разобраться во всем можно. Особенно полезны старые статьи про CMUCL, ссылки на которые есть на sbcl-internals.

SBCL использует API операционных систем довольно необычным образом. Основное мое внимание — на том, что нужно для работы SBCL на винде.

Основная фича лиспа, которая вынуждает разработчиков SBCL идти на различного рода ухищрения и усложнения — это сборка мусора. В SBCLе сборщик мусора запускается тогда, когда для очередного выделения не хватит памяти, а также время от времени периодически (когда после последней сборки выделено достаточное число байтов). Сборщик мусора выполняется в вызвавшей его нити и останавливает все остальные нити. Когда все нити остановлены, он начинает сканировать корни сборки мусора (стек лиспа и глобальные переменные). Закончив сборку, сборщик мусора возобновляет работу остановленных нитей.

Так как выделение памяти — частая операция в лиспе, то она должна выполняться как можно быстрее. В SBCL у каждой нити выполнения имеется свой регион для выделения памяти, в котором выделение происходит без блокировки простым увеличением указателя на свободный участок региона (а если бы на выделение памяти использовалась блокировка, то было бы очень долго). Но выделение памяти — не атомарная операция (нужно увеличить указатель, сравнить его, и инициализировать объект), и если сборщик мусора остановит нить в тот момент, когда она выделяла память, то увидит противоречивое, некорректное состояние, в котором нарушены инварианты сборки мусора. Поэтому, компромиссным вариантом (и не слишком долго, и корректно, хотя и сложнее реализуемо, чем наивные блокировки или отсутсвие блокировок) является использование т.н. псевдо-атомарных секций — это определенные участки кода, находясь в которых нить по-особому обрабатывается сборщиком мусора — сборщик мусора останавливает нити таким образом, чтобы ни одна нить не находилась внутри псевдо-атомарной секции. Для этого, после того как все нити остановлены, сборщик дает всем нитям, находящихся в псевдо-атомарных секциях, возможность выйти из этой секции до начала сборки. Для этого нить при входе в псевдоатомарную секцую ставит флаг "нить находится в псевдо-атомарной секции", а при выходе сбрасывает его. Сборщик проверяет этот флаг для каждой нити, и если флаг установлен, то ставит свой флаг "сборщик ждет остановки нити"; нить проверяет этот флаг при выходе из псевдо-атомарной секции, и если он установлен, то уведомляет сборщик мусора и ждет завершения сборки.

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

Под линуксом SBCL использует сигналы, доставляемые нитям для того, чтобы приостановить или продолжить их выполнение. Используются сигналы реального времени по той причине, что обычные сигналы не ставятся в очередь: нить будет пропускать сигнал, если у нее имеется такой же необработанный сигнал. Для корректной обработки сигналов в определенные моменты изменяется маска сигналов нити.

Под windows использовать сигналы не имеет смысла: под виндой нет нативных сигналов (а тем более, сигналов реального времени). Зато есть возможность останавливать нить. Далее, у остановленной нити можно поменять контекст, например, сымитировать вызов функции или "вставить" вызов функции между двумя фреймами. Это дает возможность реализовать прерывание нити, выполнить в ней какой-нибудь код; также, это одна из возможностей реализовать синхронизацию псевдо-атомарных секций со сборщиком мусора.

У каждой нити есть область, локальная для данной нити. Под линуксом на нее указывает сегментный регистр %FS (x86) или %R12 (x86-64). Windows для каждой позволяет хранить произвольное двойное слово по адресу %FS:0x14; некоторые рантаймы используют регистр %GS для хранения базы локальной области данных. С помощью функций NtQueryInformationProcess/NtSetInformationProcess можно указать базу и лимит для сегмента памяти, а затем с помощью GetThreadContext/SetThreadContext передать селектор сегмента нитке в сегментный регистр (%GS для для windows/x86-32, так как %FS уже используется windows для TEB). В сегментный регистр загружается селектор сегмента, определенный в локальной таблице дескрипторов. Всего селекторов 8192, поэтому можно будет создать около 8k нитей (часть селекторов уже будет занята). В области локальных данных можно хранить:

1. стек биндингов
2. стек управления
3. флаги нити
4. объекты синхронизации нити
5. значения симвоолов
6. указатель на регион выделения

Рассмотрим, как работает выделение памяти со сборщиком GENCGC. Выделение памяти в нити происходит с использованием региона выделения нити и представляет собой псевдо-атомарную секцию кода. Нить входит в псевдо-атомарную секцию; если в регионе выделения достаточно свободного места, то выделение происходит в регионе нити, иначе же выделяется новый регион выделения (что, возможно, вызывает сборщик мусора; тогда сборщик останавливает все нити и проводит сборку), в котором и производится выделение. Что происходит при сборке и как выделяется регион выделения, находится на совести сборщика мусора; сборщик про нити знает только где найти их стеки и области локальных данных, чтобы пройтись по ним.

Теперь, про динамически биндинги специальных переменных. При работе на многонитевых системах SBCL хранит глобальное значение в структуре символа, а также в структуре символа хранится tls-индекс, по которому в локальной области нити можно получить его текущее значение. Также имеется стек биндингов, в котором находятся пары символ/значение. Когда код выполняет динамическое связывание специальной переменной, то в стек заносятся символ и старое значение символа, а также новое значение заносится в область локальных данных нити по tls-индексу символа. При анбиндинге все происходит наоборот: в области локальных данных стека по tls-индексу восстанавливается сохраненное значение.

Стек лиспа (называемый control stack) отделен от стека foreign-кода, называемого numeric stack а также от стека биндингов динамических переменных. Разница между стеком лиспа и стеком foreign-кода состоит в том, что в лисповом стеке находятся лишь забоксенные лисповые объекты и они просматриваются сборщиком мусора, а стек же foreign-кода никак не контролируется сборщиком мусора.

В sb-thread определен обычный набор функций управления нитями: создание нити (make-thread), ожидание завершения (join-thread), прерывание (interrupt-thread) и завершение (terminate-thread). Прерывание нити — это аналог unix-сигнала: нить прекращает делать то, что делала, и выполняет заданную функцию; если нить уже прервана, то добавляемое прерывание становится в очередь, а не прерывает текущее прерывание. Завершение нити основано на прерывании: в нити вызывается функция, которая откатит стек и выйдет из нити. Под линуксом прерывание реализуется с помощью сигнала, а под windows можно реализовать через SuspendThread + правку стека и регистров.

На прерываниях также основан код таймера (таймер — такая штука, которая периодически запускает указанную функцию в указанной нити или в новой нити).

Основной объект синхронизации, который использует SBCL — это futex. Под линуксом он реализован как linux futex (откуда и пошло название), но его в SBCL называют lutex. По сути, futex — это мьютекс + переменная условия, т.е. защищает доступ к данным и позволяет ожидать изменения данных. Ожидание изменения используется, например, в недрах SBCL для того, чтобы ждать, когда изменится состояние нитей. Под windows нет переменных условия (они появились там совсем недавно), поэтому надо реализовать futex на основе имеющихся примитивов (например, критическая секция + событие). Интересная особенность: API фьютексов реализовано таким образом, что фьютексы не сохраняются не видны наружу, а в функции передается только указатель на защищаемые данные. Это позволяет не сохранять сами фьютексы при дампе образа и вообще как-либо заботиться об их инициализации/финализации, что очень упрощает их реализацию.

Вчера прочитал главу SICP, посвященную потокам (streams). Возникло острое желание переписать примеры на Common Lisp (CL). Тема очень интересна сама по себе. Еще подстегивало то, что некоторые активисты упорно пропагандируют идею оторванности CL от функциональной парадигмы (ФП), как бы это абсурдно ни звучало. Но когда я приступил к переписыванию кода на CL, мое первое обманчивое впечатление было таким, что потоки будет реализовать труднее, чем в Схеме. Например, в CL нет аналога схемовского DEFINE, который бы позволил определять переменные рекурсивно. Но, к счастью, все разрешилось удачным образом. Как и должно было быть, выручили макросы, могучая сила CL. Они же мне позволили в свое время добавить очень простой и удобный синтаксический сахар для монад по типу нотации do, о чем я писал ранее.

Итак, все начинается с ленивости. Для этого определяются конструкции DELAY и FORCE, но прежде нужна вспомогательная функция MEMO, которая возвращает функцию без аргументов, результат которой кешируется:

(defun memo (fun)
  (let ((already-run? nil)
        (result nil))
    #'(lambda ()
        (if (not already-run?)
            (progn
              (setf result (funcall fun))
              (setf already-run? t)
              result)
            result))))

Тут все по книге SICP, только там функция называлась MEMO-PROC.

Дальше определяем конструкции DELAY и FORCE, причем DELAY должен быть непременно макросом, чтобы он мог упрятать свой аргумент в лямбду, сделав его тем самым ленивым:

(defmacro delay (exp)
  `(memo #'(lambda() ,exp)))

(defun force (delayed-exp)
  (funcall delayed-exp))

Теперь можно приступить к реализации примитивов, с помощью которых будут создаваться потоки. Среди этих примитивов выделяется особо конструктор пары CONS-STREAM, который тоже должен быть макросом, чтобы иметь возможность сделать свой второй аргумент ленивым. Собственно, в этом заключена суть потоков.

(defmacro cons-stream (a b)
  `(cons ,a (delay ,b)))

(defun stream-car (stream)
  (car stream))

(defun stream-cdr (stream)
  (force (cdr stream)))

(defun stream-null (stream)
  (null stream))

(defparameter *empty-stream* nil)

Функция STREAM-CDR раскрывает ленивую CDR-часть потока, если она не была до того уже раскрыта. Как помним, на нижнем уровне за это отвечает функция MEMO, которая встраивается при создании каждой пары. В общем, это все уже описано в SICP. Поэтому останавливаться не буду.

Следующая функция STREAM-REF аналогична AREF, но работает уже с потоками.

(defun stream-ref (stream n)
  (loop for i from 0 to n
     for s = stream then (stream-cdr s)
     finally (return (stream-car s))))

Несмотря на присутствие в реализации совсем нефункционального LOOP, функция является чистой.

Далее идут отображения для потоков. Вполне в духе ФП.

(defun stream-map (fun stream)
  (if (stream-null stream) stream
      (cons-stream (funcall fun (stream-car stream))
                   (stream-map fun (stream-cdr stream)))))

(defun stream-map2 (fun s1 s2)
  (cond
    ((stream-null s1) s1)
    ((stream-null s2) s2)
    (t (cons-stream (funcall fun (stream-car s1) (stream-car s2))
                    (stream-map2 fun (stream-cdr s1) (stream-cdr s2))))))

Далее понадобится функция фильтрации потока. Я поменял имя STREAM-FILTER на более идиоматическое. К тому же задействовал LOOP. При этом функция остается чистой.

(defun stream-remove-if-not (test stream)
  (loop for s = stream then (stream-cdr s)
     when (stream-null s) do (return s)
     when (funcall test (stream-car s)) do
       (return
         (cons-stream (stream-car s)
                      (stream-remove-if-not test (stream-cdr s))))))

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

(defun stream-iter (fun stream)
  (loop for s = stream then (stream-cdr s)
       while (not (stream-null s))
       do (funcall fun (stream-car s))))

(defun print-stream (stream)
  (stream-iter #'(lambda (x) (format t "~%~a" x)) stream))

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

CL-USER> (print-stream (cons-stream 1 (cons-stream 2 (cons-stream 3 nil))))

1
2
3
NIL

Подходим к главному препятствию. В схеме мы могли легко определить поток рекурсивно. Например, поток единиц задавался бы так:

(define ones (cons-stream 1 ones))  ;; Scheme!

Несмотря на кажущуюся простоту выражения, компилятор выполняет много работы. Придется это повторить. Я лишь покажу конечный результат. Аналогом на CL будет следующее определение:

(defparameter *ones*
  (recurrent-let ((ones (cons-stream 1 ones)))
    ones))

Здесь RECURRENT-LET похож на LET с одной переменной. Отличие заключается в том, что к самой переменной можно обращаться внутри определения. То есть, определение может быть рекурсивным.

Сам макрос RECURRENT-LET достаточно прост:

(defmacro recurrent-let (((name value)) &body body)
  (let ((x (gensym)))
    `(let ((,x (cons nil nil)))
       (symbol-macrolet ((,name (force (car ,x))))
         (setf (car ,x) (delay ,value))
         ,@body))))

Вот, во что будет раскрыта внутренняя часть определения параметра *ONES*:

(LET ((#:G764 (CONS NIL NIL)))
  (SYMBOL-MACROLET ((ONES (FORCE (CAR #:G764))))
    (SETF (CAR #:G764) (DELAY (CONS-STREAM 1 ONES)))
    ONES))

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

Стоит заметить, что данное представление бесконечного потока единиц на самом деле занимает очень мало памяти, поскольку поток ссылается на самого себя.

Если присмотреться к определению макроса, то можно увидеть, что внутри определения рекурсивной переменной мы можем использовать еще один RECURRENT-LET, а также любую другую конструкцию, включая LET, FLET и LABELS. Это открывает путь к вложенным и более сложным взаимно-рекурсивным определениям, что и будет продемонстрировано далее.

В соответствии с SICP определим вспомогательные функции:

(defun add-streams (stream1 stream2)
  (stream-map2 #'+ stream1 stream2))

(defun scale-stream (stream factor)
  (stream-map #'(lambda (x) (* x factor)) stream))

Далее определим поток целых чисел:

(defun integers-starting-from (n)
  (cons-stream n (integers-starting-from (+ n 1))))

(defparameter *integers-alpha*
  (integers-starting-from 1))

Этот же самый поток мы можем определить иначе:

(defparameter *integers*
  (recurrent-let
      ((integers (cons-stream 1 (add-streams *ones* integers))))
     integers))

Естественно, без определения потока чисел Фибоначчи мое сообщение можно было бы считать неполным:

(defparameter *fibs*
  (recurrent-let
      ((fibs (cons-stream 0
                          (cons-stream 1
                                       (add-streams (stream-cdr fibs)
                                                    fibs)))))
    fibs))

Теперь можем узнать, каким будет 1001-ое число Фибоначчи:

CL-USER> (stream-ref *fibs* 1001)
70330367711422815821835254877183549770181269836358732742604905087154537118196933579742249494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125598767690091902245245323403501

Как и следовало ожидать, ответ был немедленным.

Следуя SICP, далее приведу пример определения потока простых чисел. Но прежде мне понадобятся две простые утилиты.

(defun square (n) (* n n))
(defun divisible-p (x y) (= (mod x y) 0))

Сам поток определен ниже. Это также пример взаимно-рекурсивного определения.

(defparameter *primes*
  (recurrent-let
      ((primes
        (flet ((prime-p (n)
                 (labels ((iter (ps)
                            (cond ((> (square (stream-car ps)) n) t)
                                  ((divisible-p n (stream-car ps)) nil)
                                  (t (iter (stream-cdr ps))))))
                   (iter primes))))
          (cons-stream
           2
           (stream-remove-if-not #'prime-p (integers-starting-from 3))))))
    primes))

Еще один пример — решатель дифференциальных уравнений. Сначала определяем интеграл, где интегрируемая функция передается лениво:

(defun integral (delayed-integrand initial-value dt)
  (recurrent-let
      ((int (cons-stream initial-value
                         (let ((integrand (force delayed-integrand)))
                           (add-streams (scale-stream integrand dt)
                                        int)))))
    int))

Теперь сам решатель:

(defun solve (f y0 dt)
  (recurrent-let
      ((y (recurrent-let
              ((dy (stream-map f y)))
            (integral (delay dy) y0 dt))))
    y))

Можем проверить как и в SICP:

CL-USER> (stream-ref (solve #'(lambda (y) y) 1 0.001) 1000)
2.7169204

Как видим, примеры достаточно легко ложатся на CL, хотя и выглядят несколько иначе. При этом они вполне соответствуют духу ФП. Разве что, использование LOOP несколько необычно для этой области, но это прекрасный пример сочетания разных подходов к программированию. Основа остается несомненно функциональной. Неужели после этого может кто-то по-прежнему утверждать, что CL не является языком функционального программирования?

CL-USER>(defparameter *map* (make-instance 'routes:mapper))
CL-USER>(routes:connect *map* (routes:make-route "/foo/:id" (list :id #'parse-integer)))
CL-USER>(routes:match *map* "/foo/1")
(#<ROUTES:ROUTE {...}> (:ID . 1))
CL-USER>(routes:match *map* "/foo/hello")
NIL

(define-route myroute ("/foo/:id" :parse-vars (list :id #'parse-integer))
...)

Сначала цитата - вдруг кто-то не знает об этом замечательном инциденте.

И даже более впечатляющий пример удаленной отладки произошел в
миссии NASA «Deep Space 1» в 1998 году. Через полгода после запуска
космического корабля, небольшой код на Lisp должен был управлять
космическим кораблем в течении двух дней для проведения серии
экспериментов. Однако, неуловимое состояние гонки (race condition) в
коде не было выявлено при тестировании на земле и было обнаружено уже
в космосе. Когда ошибка была выявлена в космосе (100 миллионов миль от
Земли) команда смогла произвести диагностику и исправление работающего
кода, что позволило завершить эксперимент. Один из программистов
сказал об этом следующее:

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

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

Я и не знал, что многие этого не знают, а те кто знают - забывают
рассказать. Это как секс - после того как первый раз сделаешь это -
начинаешь делать все на автомате, не задумываясь :)

Итак, по шагам:

1. Заходим на сервак по ssh:
   ssh user@host.ru
   Спрашивают пароль, вводить нужно правильный, иначе странным образом
   ничего не получается.

2. Запускаем screen. По какой-то магической причине, если пропустить
   этот шаг, то после того как терминальная сессия закроется вся магия
   исчезнет.

3. Внутри screen запускаем sbcl. Тут сразу дают REPL, но весь
   дзен будет дальше, поэтому...

4. Вводим в REPL следующий код (можно скопировать прямо отсюда, вреда
   не будет, я гарантирую это!)
   (require 'asdf)
   (asdf:oos 'asdf:load-op 'swank)
   (setq swank:*use-dedicated-output-stream* nil)
   (swank:create-server :coding-system "utf-8-unix" :dont-close t
   :port 4005)
   Этот код запустить swank внутри sbcl и он (swank) начнет слушать
   4005 порт, но будет делать это на удаленной машине - ну а мы там и
   находимся пока внутри терминальной сессии.

5. Нажимаем Ctrl+a d - чтобы выйти из screen без его закрытия, оставив
   под screen`ом работающий sbcl с запущенным в нем swank`ом. Больше
   нам нечего делать в терминальной сессии, поэтому можно
   нажать Ctrl+d чтобы из нее выйти. Теперь мы снова у себя на машине.

6. Открываем ssh-тоннель на удаленную машину:
   ssh -2 -N -f -L 4005:localhost:4005 user@host.ru
   Теперь все обращения к нашему 4005 порту будут уходить на удаленную
   машину и обращаться там по 4005 порту - а нам это и надо

7. Заходим в emacs и набираем M-x slime-connect - и емакс послушно
   коннектится на локальный 4005 порт, который форвардится на
   удаленный 4005 порт, где его принимает swank, после чего вы можете
   наслаждаться мощью лиспа ни в чем себе не отказывая.

--------------------------

Что может быть полезным:

1. swank сам по себе - это библиотка лиспа. Она может быть
   неустановлена. Установиить можно например с помощью asdf-install,
   например так
   (require 'asdf-install)
   (asdf-install:install 'swank)
   Но лучше бы вам знать, как устанавливать библиотки в лиспе вручную.
   Все просто - нужно слить библиотеку, положить ее в нужную папку 
   (у меня это /usr/lib/sbcl/site/) и сделать симлинк на asd-файл в 
   папке систем (у меня это /usr/lib/sbcl/site-systems/). Нужные папки
   легко найти по команде locate site-systems - там оно все рядом. 
   Альтернативный вариант поиска, если вы знаете какую-нибудь из установленных
   библиотек, например alexandria - это выполнить в REPL такой код:
   (asdf:component-pathname (asdf:find-system '#:alexandria))

2. версия swank (снапшот) должна быть идентична и на клиенте и на
   сервере. Если об этом забыть можно словить прикольные глюки :)

3. Если, когда вы отошли хакнуть что-нибудь другое или просто попить кофе,
   ssh-тоннель умирает от безделья и вам приходится с матом поднимать его
   снова, то пропишите в /etc/ssh/ssh_config директиву 
   ServerAliveInterval 5

4. Некоторые лисперы забывают сконфигурировать emacs :) В вашем
   инициализационном файле емакса должно быть что-то похожее на это:

   ;; Lisp (SLIME) interaction
   (setq inferior-lisp-program "sbcl"
         lisp-indent-function 'common-lisp-indent-function
         slime-complete-symbol-function 'slime-fuzzy-complete-symbol
   ;     common-lisp-hyperspec-root "file:///Users/lisp/HyperSpec"
         slime-startup-animation nil)
   ;; SLIME
   (add-to-list 'load-path "~/.emacs.d/slime")
   (require 'slime)
   ;(set-language-environment "utf-8")
   (setq slime-net-coding-system 'utf-8-unix)
   (slime-setup '(slime-fancy))


Это не единственно-верный способ работать с лиспом удаленно. Но я
им пользуюсь и нахваливаю. Ссылки на другие способы приветствуются

• SBCL-1.0.35.18 - 3.076 с
• SBCL-1.0.30 - 2.778 с
• Clozure CL 1.5-dev-r13281M-trunk (64 bit) - 76.218124 с
• ACL 8.1 (32 bit) - 271.669 с
• CLISP 2.47 (64 bit) - 409.74057 с

{template panel}
   <table class="panel">
       <tbody>
           <tr>
               <td class="TL"></td>
               <td class="TM">
                   <span class="TML">{$title |noAutoescape}</span>
                   {if $close}
                       <div class="TRx"></div>
                   {/if}
               </td>
               <td class="TR"></td>
           </tr>

           <tr>
               <td class="ML"></td>
               <td class="MM">{$body |noAutoescape}</td>
               <td class="MR"></td>
           </tr>

           <tr>
               <td class="BL"></td>
               <td class="BM"></td>
               <td class="BR"></td>
           </tr>
       </tbody>
   </table>
{/template}

{call editable-text data="$name" /}

{call panel}
   {param title: 'Name' /}
   {param close: true /}
   {param body}
       {call editable-text data="$name" /}
   {/param}
{/call}

Finished running tests.
Status:
 Failure:             interface.pure.lisp / WITH-TIMEOUT-FORMS
 Failure:             stream.pure.lisp / (STREAM LISTEN-VS-SELECT)
 Unhandled error      alien.impure.lisp
 Unhandled error      clos-interrupts.impure.lisp
 Unhandled error      deadline.impure.lisp
 Expected failure:    debug.impure.lisp / (UNDEFINED-FUNCTION BUG-353)
 Failure:             debug.impure.lisp / (THROW NO-SUCH-TAG)
 Invalid exit status: exhaust.impure.lisp
 Failure:             external-format.impure.lisp / (CHARACTER-DECODE-LARGE
                                                     ATTEMPT-RESYNC)
 Unhandled error      foreign-stack-alignment.impure.lisp
 Unhandled error      load.impure.lisp
 Expected failure:    packages.impure.lisp / USE-PACKAGE-CONFLICT-SET
 Expected failure:    packages.impure.lisp / IMPORT-SINGLE-CONFLICT
 Unhandled error      pathnames.impure.lisp
 Unhandled error      print.impure.lisp
 Failure:             run-program.impure.lisp / RUN-PROGRAM-CAT-1
 Failure:             signals.impure.lisp / (ASYNC-UNWIND SPECIALS)
 Failure:             signals.impure.lisp / (SIGNAL ERRNO)
 Unhandled error      stream.impure.lisp
 Unhandled error      swap-lispobjs.impure.lisp
 Unhandled error      threads.impure.lisp
 Failure:             timer.impure.lisp / (TIMER DEREFERRABLES-BLOCKED)
                                          ;btw, тест DEREFERRABLES-UNBLOCKED
                                          ;просто виснет, приходится его закомменчивать
 Failure:             timer.impure.lisp / (TIMER RELATIVE)
 Failure:             timer.impure.lisp / (TIMER ABSOLUTE)
 Failure:             timer.impure.lisp / (TIMER REPEAT-AND-UNSCHEDULE)
 Failure:             timer.impure.lisp / (TIMER RESCHEDULE)
 Failure:             timer.impure.lisp / (TIMER STRESS)
 Failure:             timer.impure.lisp / (WITH-TIMEOUT TIMEOUT)
 Failure:             timer.impure.lisp / (WITH-TIMEOUT NESTED-TIMEOUT-SMALLER)
 Failure:             timer.impure.lisp / (WITH-TIMEOUT NESTED-TIMEOUT-BIGGER)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RESTART-FRAME
                                                              SPECIAL)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RESTART-FRAME
                                                              OPTIONAL-SPECIAL)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RESTART-FRAME
                                                              NORMAL)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RETURN-FROM-FRAME
                                                              SPECIAL)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RETURN-FROM-FRAME
                                                              OPTIONAL-SPECIAL)
 Failure:             unwind-to-frame-and-call.impure.lisp / (RETURN-FROM-FRAME
                                                              NORMAL)
 Unhandled error      unwind-to-frame-and-call.impure.lisp
test failed, expected 104 return code, got 1

А SLIME хорошеет. Сегодня он преподнес мне сюрприз: оказывается, в нем появилась подсказка по аргументам локальных функций (flet).

Т.е., если набирать вот такой вот код:

(defun foobar ()
  (flet ((bar (x y z) (+ x y z)))
    (bar )))

Fare Rideau. Использовать EVAL-WHEN вредно для вашего психического здоровья. (перевод: Кальянов Дмитрий).

Оригинальная публикация: http://fare.livejournal.com/146698.html.

Fare Rideau. Использовать EVAL-WHEN вредно для вашего психического здоровья

В CL код, изначально представленный в виде исходного текста, прежде чем будет исполнен в виде программы, обрабатывается в несколько стадий вычисления (которые могут быть разделены во времени, проходить одновременно или же чередоваться): чтение кода (read), раскрытие макросов (macro expansion), компиляция (compilation), загрузка (loading), исполнение (execute). За первые два этапа отвечают читатель лиспа (lisp reader) и макросы. Форма EVAL-WHEN позволяет указывать, в какой из трех стадий будет выполняться код (компиляция, загрузка, исполнение).

Чередование стадий вычисления происходит от того, что код обрабатывается последовательно, форма за формой; каждая форма верхнего уровня (top-level form) проходит стадии обработки кода, и только затем читается следующая форма. Это дает возможность производить какие-либо побочные эффекты, которые могут повлиять на обработку следующей формы. Например, если файл компилируется с помощью compile-file, то каждая форма проходит следующие стадии: чтение, раскрытие макросов, компиляция, и только при вызове load для скомпилированного fasl'а будут произведены эффекты времени загрузки; если файл загружается с помощью load, то каждая форма проходит через стадии: чтение, раскрытие макросов, компиляция, загрузка; если формы набираются в REPL, то форма проходит все стадии от чтения до исполнения. Поэтому, в зависимости от способа ввода кода (ввод в REPL; загрузка с помощью LOAD; компиляция и загрузка с помощью (LOAD (COMPILE-FILE ..)); вызов EVAL или COMPILE для формы), эффекты от него могут быть различными, так как побочные эффекты от разных форм будут наступать в разное время (чаще всего, разница будет в том, что будут ошибки компиляции либо загрузки).

(Примечание: приведем примеры, когда происходят какие эффекты. Формы defpackage, in-package производят побочные эффекты (соответственно, defpackage создает пакет, а in-package изменяет значение переменной *package*) на стадиях компиляции и загрузки, поэтому во время компиляции файла компилятор уже имеет созданный пакет, и символы будут читаться в указанный пакет. Форма defun производит свой основной побочный эффект (определение функции) во время компиляции - поэтому при компиляции файла макросы не видят функции, определенные в этом же файле.)

Самая первая стадия обработки кода - это чтение. Из потока текста (фанаты Интерлиспа и Смоллтока скажут, что это - неудачный выбор спецификации) читается лисповый код, и возвращается в виде CONS-ячеек, содержащих S-выражения (фанаты PLT Scheme скажут, что это тоже неудачный выбор спецификации). Во время чтения может выполняться код, определяемый выражениями #. и текущей таблицей чтения (*READTABLE*). Это дает возможность (хотя и довольно неудобную) компилировать код, записанный каким-либо другим синтаксисом (см., например, http://kpreid.livejournal.com/14713.html).

Вторая стадия обработки кода (сразу после чтения формы) - раскрытие макросов. То, как проходит раскрытие макросов, определяется макросами, определенными через DEFMACRO, DEFINE-SYMBOL-MACRO и их лексическими вариантами MACROLET, SYMBOL-MACROLET, а также макросами, определенными с помощью DEFINE-SETF-EXPANDER и DEFINE-MODIFY-MACRO, макросами компиляции DEFINE-COMPILER-MACRO и динамической переменной *MACROEXPAND-HOOK*. Макросы лиспа являются одновренно и всемогущими (в принципе, способны осуществить любой преобразование кода), но также ничего не знающими (так как не могут анализировать окружающий лексический контекст, не прибегая к реализации полного code-walker'а для CL или к расширениям стандарта (примечание: в CLtL2 определены функции для анализа лексического контекста, но в CL они не включены; в ряде реализаций они присутствуют, например, в пакете SB-CLTL2)). Вследствие этого появляются неудобства, связанные с отсутствием гигиены, сложностью отслеживания ошибок, но, что самое важное, становится невозможно описывать нелокальные преобразования кода модульным образом, не прибегая к переписыванию системы обработки кода или к управлению ей (но это тоже проблематично: так как *MACROEXPAND-HOOK* не вызывается для специальных и обычных форм, то необходимо модифицировать читатель, чтобы можно было обрабатывать все формы, не заставляя пользователя оборачивать каждую форму в какой-нибудь "волшебный" макрос-обертку).

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

Если код вводится в REPLе или с помощью LOAD загружается исходный текст или с помощью EVAL либо вычисляется форма, то код проходит только стадию исполнения (и не проходит стадии компиляции или загрузки). Если встречается EVAL-WHEN с параметром :EXECUTE, то он превращается просто в PROGN, и иначе в NIL. Это же может происходить вперемешку с раскрытием макросов; например, SBCL может начать вычислять выражение (when nil (foo)) и вернуть nil, не раскрывая макрос (foo); поэтому, если ожидалось выполнения побочных эффектов от этого макроса, их не будет (мы тоже этому удивились, когда тестировали ASDF-DEPENDENCY-GROVEL).

Если вы компилирует код с помощью COMPILE, то этот код будет исполнен во время стадии исполнения (:EXECUTE), поэтому если он содержит EVAL-WHEN, то он ведет себя аналогично предыдущему случаю. Так как компилируемый код всегда является функцией (именованной или безымянной), то в этом коде нет формы верхнего уровня (toplevel form), поэтому указание стадий :COMPILE-TOPLEVEL и :LOAD-TOPLEVEL не имеет смысла и игнорируется. Если я правильно понимаю, то компилятор может не раскрывать макросы, если он может статически доказать, что они находятся в недостижимом коде; однако на практике компиляторы работают в несколько проходов, и макросы раскрываются полностью, прежде чем код анализируется на наличие недостижимых частей кода.

Иная ситуация наблюдается, когда EVAL-WHEN встречается в коде, который сперва компилируется с помощью COMPILE-FILE, и затем полученный FASL загружается с помощью LOAD. В этом случае, каждая форма после раскрытия макросов обрабатывается таким образом, что отделяются побочные эффекты, которые происходят во время компиляции от эффектов, происходящих во время загрузки. Если указать :COMPILE-TOPLEVEL в EVAL-WHEN, то побочные эффекта кода, заключенного в EVAL-WHEN, будут происходить во время компиляции (т.е., в текущем образе, а также сохранятся в CFASL (которые поддерживаются с SBCL-1.0.30.4) и будет воспроизведены при загрузке указанного CFASL). Если указать :LOAD-TOPLEVEL, то побочные эффекты кода будут происходить во время загрузки (т.е., они сохраняются в FASL и произойдут при загрузке FASL, но они не будут происходить в текущем образе, если также не указана стадия :COMPILE-TOPLEVEL). Некоторые специальные формы имеют побочные эффекты как во время компиляции, так и во время загрузки, например IN-PACKAGE, которая меняет текущий пакет (*PACKAGE*) во время компиляции и во время загрузки; DEFVAR объявляет переменную специальной как во время компиляции (в текущем образе), так и во время загрузки (в том образе, в который будет загружаться FASL), а также устанавливает значение во время загрузки. Указание :EXECUTE для форм верхнего уровня игнорируется (но во вложенном EVAL-WHEN имеет смысл использовать только :EXECUTE).

На практике, стоит запомнить, что единственная безопасная и полезная комбинация параметров - это (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) ...), в который следует заворачивать вещи, которые должны быть доступны во время компиляции и во время работы кода такие: например, объявления функций, переменных и побочных эффектов, которые используются макросами.

Использовать (:LOAD-TOPLEVEL :EXECUTE) безопасно, но любая форма верхнего уровня уже неявно обернута в (EVAL-WHEN (:LOAD-TOPLEVEL :EXECUTE) ..), поэтому использовать эту комбинацию не имеет смысла (за исключением ситуации, когда форма расположена внутри EVAL-WHEN с другими параметрами).

Другая безопасная комбинация параметров - (:COMPILE-TOPLEVEL :EXECUTE), но польза от нее ограничена. Ее можно использовать для того, чтобы побочные эффекты от выполнения кода были только в среде компиляции; например, изменение таблицы чтения (readtable). Но если такой побочный эффект произойдет во время компиляции файла и сохранится в сеансе работы (например, если изменять значение какой-либо переменной, для которой создаются локальные привязки во время компиляции, например *READTABLE*, то изменения не сохранятся после компиляции), то во время загрузки скомпилированного FASLа этого изменения может не быть (если FASL загружен из другого сеанса), что может создать непонятные проблемы при компиляции и сборке программ. Недетерминированные действия во время компиляции (например, использование файловой системы) - это плохой вкус. Если требуется вычислить что-либо детерминированно, то это можно сделать и во время чтения, а если недетерминированно, то стоит отложить вычисления на более позднее время (например, провести вычисления во время сохранения образа). Один из разумных вариантов использования (:COMPILE-TOPLEVEL :EXECUTE) - это сохранение побочных эффектов времени компиляции, когда для сборки используется XCVB с поддержкой механизма CFASL (который поддерживается в SBCL >= 1.0.30.4); при этом гарантируется, что при компиляции всех файлов, которые зависят от данного файла, эти побочные эффекты будут воспроизведены. В итоге, хотя использование (:COMPILE-TOPLEVEL :EXECUTE) безопасно, оно годится лишь для очень ограниченного числа случаев. Если вы не эксперт, то даже не пытайтесь.

Другие комбинации параметров EVAL-WHEN можно не рассматривать. Они бессмыслены, и имеют смысл разве что лишь гипотетически внутри низкоуровневого макроса оптимизации; всегда будет возможность загрузить код каким-либо образом, что побочные эффекты наступят неожиданно и приведут к неожиданным последствиям. У пользователя должна быть возможность, в зависимости от его нужд, компилировать и загружать код так, как он захочет - просто LOAD'ом, или же (LOAD (COMPILE-FILE ...)), или же загрузка FASLа в новый образ или же инкрементальная рекомпиляция с помощью ASDF - код всегда должен загружаться и работать предсказуемо.

Когда загружается FASL или CFASL, происходят все сохраненные в нем эффекты: в пакеты добавляются символы, вычисляются выражения для LOAD-TIME-VALUE, добавляются определения переменных, макросов и функций, любые другие побочные эффекты от toplevel-форм. При этом, побочные эффекты стадии чтения и стадии раскрытия макросов не считаются эффектами времени компиляции или загрузки, и поэтому не проявляются при загрузке FASL или CFASL. На самом деле, это даже полезно, так как это позволяет делать что-либо во время чтения кода или при раскрытии макросов, и эти вычисления не будут заново производиться при загрузке кода. Например, SBCL (и другие вменяемые реализации) не будут повторять эффекты времени раскрытия макросов при загрузке кода (хотя, гипотетически, можно представить такую реализацию). Но если ваши макросы совершают какие-то побочные эффекты, которые не должны пропасть после компиляции, то макросы должны не только производить эти эффекты, но и раскрываться в код, который производит те же побочные эффекты во время компиляции и/или загрузки (используя EVAL-WHEN). В качестве примера: когда я переводил крупный проект с ASDF на XCVB, пришлось отлаживать макрос, который вызывал (EVAL (DEFCLASS ...)) и FINALIZE-INHERITANCE во время раскрытия макроса, чтобы иметь возможность использовать MOP для анализа сгенерированного класса, но не включал DEFCLASS в раскрываемый код; в результате, при компиляции "с нуля", макрос работал, но не работал при загрузке из FASLов (используя инкрементальную компиляцию в ASDF) или при детерминированной сборке (используя XCVB), так как другие макросы в других файлах ожидали, что класс будет определен (чего не происходило при загрузке из FASLов).

EVAL-WHEN легко использовать неправильно, и на самом деле у которого есть только одно разумное применение (если использовать XCVB, то два). Важно понимать, в каких случаях EVAL-WHEN нужен - прежде всего для объявления функций и переменных, которые используются макросами. Если вам нравится использовать нетривиальное метапрограммирование, то рекомендую избегать такого примитивного в этом отношении языка, как Common Lisp, и использовать современный язык с многостадийной компиляцией и четко определенной семантикой (например, язык модулей PLT Scheme, camlp4 для OCaml, и другие системы, обрабатывающие файлы детерминированным образом). У макросов PLT есть ряд преимуществ: гигеничность, совместимость с отладчиками и другими инструментами и т.п.

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

{namespace example.githubway.view}

// Представление текстового элемента
{template editable-text}
<div class="editable-text" json="{$json}">
    <p>
        {$value}
        <em class="edit-text">click to edit</em>
    </p>    
</div>
{/template}

// Форма для редактирование элемента
{template edit-text}
<form method="post" action="{$saveLink}" json="{$json}">
    <input type="text" value="{$value}" name="value"></input>

    <div class="form-actions">
        <input type="submit" class="minibutton save" value="Save"></input>
        <span class="fakelink cancel">cancel</span>
    </div>
</form>
{/template}

• value - значение элемента
• saveLink - URL, который может использоваться для обновления значения элемента с помощью POST-запроса
• json - а вот это любопытно, это предыдущие аргументы в формате JSON. Зачем это надо? Напомню, что cl-closure-template позволяет создавать шаблоны, доступные как на сервеной, так и на клиентской стороне. Я хочу, что бы JavaScript-код получил полную информацию об элементе модели, которую он сможет в последующем использовать для передачи в эти же шаблоны для генерации новой разметки. Для этого я сохраняю эти данные в атрибуте json корневого элемента генерируемой разметки, что существенно упрощает последующую обработку.

function EObject (node) {
 // node - узел DOM-дерева, представляющего элемент данных
 if (node) {
     this.node = node;
 }
}

// Возвращает описание элемента модели в виде
// пригодном для генерации разметки с помощью шаблонов
EObject.prototype.modelData = function () {
 var data = $.evalJSON(this.node.attr("json"))
 data.json = $.toJSON(data);
 return data;
};

// Метод для генерации основной разметки
EObject.prototype.toHTML = function (data) {
 throw "Method toHTML not implemented";
};

// Метод для генерации формы редактирования
EObject.prototype.editForm = function (data) {
 throw "Method editForm not implemented";
};

// Вспомогательный метод, позволяющий заменить разметку элемента
// таким образом, что бы в объекте осталась ссылка на актуальный
// элемент DOM-дерева
EObject.prototype.replaceHTML = function (html) {
 this.node.after(html);
 this.node = this.node.next();
 this.node.prev().remove();
};

// Заменяет основное представление на форму редактирования
EObject.prototype.startEdit = function () {
 this.replaceHTML(this.editForm(this.modelData()));

 var obj = this;

 $('.cancel:first', this.node).click(function (evt) { obj.endEdit(); });

 this.node.ajaxForm({
     dataType: 'json',
     success: function (data) { obj.endEdit(data)},
     error: function () { alert("Не удалось сохранить данные"); obj.endEdit() }
 });
};

// Заменяет форму редактирования на основной вариант разметки
EObject.prototype.endEdit = function (data) {
 this.replaceHTML(this.toHTML(data || this.modelData()));

 // Похоже на хак, но мне кажется нормальным решением.
 // Фактически, просто ре-инициализация объекта, которая,
 // например, приведёт к активизации нужных обработчиков событий
 this.constructor(this.node);
};

function EditableText (node) {
 if (node) {
     // вызываем конструктор базового класса
     EObject.prototype.constructor.call(this, node);

     // Инициируем вызов процедуру редактирования по клику мышкой
     var obj = this;
     this.node.click(function (evt) { obj.startEdit(); });
 }
}

// Инициализируем прототип
EditableText.prototype = new EObject;

// Необходимо, что бы иметь возможность создать новый класс, наследующий от EditableText
EditableText.prototype.constructor = EditableText;

// Генерируем разметку с помощью ранее описанного шаблона editable-text
EditableText.prototype.toHTML = example.githubway.view.editableText;

// Генерируем форму редактирования с помощью ранее описанного шаблона edit-text
EditableText.prototype.editForm = example.githubway.view.editText;

$(document).ready(function () {
 // Тоже довольно любопытно. Просто создаём новые объекты "в никуда".
 // Но благодаря привязке этих объектов к DOM-дереву через обработчики
 // событий они останутся "жить" и будут выполнять свою работу
 $(".editable-text").each( function (i, node) { new EditableText($(node)); })
});

• closure-template
• parenscript
• RESTAS
• cl-json

(defparameter *name* "Ivan Petrov")

(defparameter *email* "Ivan.Petrov@example.com")


(defun with-json (&rest args)
 (list* :json (json:encode-json-plist-to-string args)
        args))

(defun name-to-json ()
 (with-json :value *name*
            :save-link (genurl 'save-name)))

(defun email-to-json ()
 (with-json :value *email*
            :save-link (genurl 'save-email))) 

(define-route main ("")
 (example.githubway.view:page (list :name (name-to-json)
                                    :email (email-to-json))))

{call editable-text data="$name" /}
{call editable-text data="$email" /}

(define-route save-name ("api/name" :method :post :content-type "application/json")
 (setf *name*
       (hunchentoot:post-parameter "value"))
 (json:encode-json-plist-to-string (name-to-json)))

(define-route save-email ("api/email" :method :post :content-type "application/json")
 (setf *email*
       (hunchentoot:post-parameter "value"))
 (json:encode-json-plist-to-string (email-to-json)))

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

В общем, это все уже работает на F#, хотя и медленно. Рабочее название соответствующей библиотеки для F# – Aivika. Теперь я перенес базовую часть на Common Lisp, назвав новую библиотеку Salika. Соответствующий монадический макрос назвал как WITH-DYNAMICS-MONAD. Этот макрос полностью соответствует интерфейсу монадических макросов из пакета cl-monad-macros, о котором я писал в своем блоге ранее. Вкратце, такие макросы добавляют удобный синтаксический сахар по типу нотации do из хаскеля.

Возьмем простую динамическую систему, описанную на языке MapSim:

A = integ (-F, 100);
B = integ (F - G, 0);
C = integ (G, 0);

F = ka * A;
G = kb * B;

ka = 1;
kb = 1;

Функция integ задает интеграл. В первом параметре функции определяется производная по времени. Во втором – начальное значение интеграла. Интегрирование происходит на промежутке starttime <= t <= stoptime с шагом dt. Здесь A(t), B(t) и C(t) – интегралы. Их еще иногда называют в системной динамике резервуарами. Функции F(t) и G(t) называют дополнительными. В системе также заданы константы ka и kb.

В первой ссылке есть пример того, как эту систему можно задать на языке F#. Там получается достаточно близко к математической нотации. Во многом благодаря тому, что для типа монады моделирования легко определить арифметические операции и стандартные функции типа синуса и косинуса. Такой подход можно встретить, например, в книге “The Haskell School of Expression” автора Paul Hudak. В случае же Common Lisp я предпочитаю использовать монадические макросы напрямую, поскольку это порождает в целом более эффективный код. Думаю, что наглядность при этом страдает несильно.

Итак, такую систему мы можем описать на Common Lisp следующим образом.

(defun create-process ()
  (let* ((ka 1d0)
         (kb 1d0))
    (let* ((integ-a (make-instance 'integ-stock :initial-value 100d0))
           (integ-b (make-instance 'integ-stock :initial-value 0d0))
           (integ-c (make-instance 'integ-stock :initial-value 0d0)))
      (let* ((f (with-dynamics-monad
                  (let! ((a (current-value integ-a)))
                    (unit (* ka a)))))
             (g (with-dynamics-monad
                  (let! ((b (current-value integ-b)))
                    (unit (* kb b))))))
        (setf (outflow integ-a) f)
        (setf (inflow integ-b) f)
        (setf (outflow integ-b) g)
        (setf (inflow integ-c) g)
        (current-value integ-a)))))

Единственный момент – в примере возвращается лишь интеграл A, но как часть всей системы. Здесь монаду можно увидеть в том, как задаются динамические процессы для переменных F и G. Внутри макроса WITH-DYNAMICS-MONAD макроc LET! эквивалентен стрелке из нотации do, а макрос UNIT – функции return для монады. Получается, что F и G возвращают монады. Более того, выражение (current-value integ-a) – тоже монада. Это представления динамических процессов.

Такую систему достаточно просто промоделировать. Нижеследующая функция запускает соответствующую имитацию и возвращает значения интеграла A в основных узлах интегрирования, как это принято в методах Эйлера и Рунге-Кутта.

(defun run-process ()
  (with-dynamics-monad
    (run! (create-process) (make-specs :start-time 0.0 :stop-time 10.0 :method 'runge-kutta-4 :dt 0.1)))))

Среда лиспа проинтегрирует модель методом Рунге-Кутта четвертого порядка, начиная от точки 0 и заканчивая точкой 10 с основным шагом интегрирования 0,1.

SALIKA> (run-process)
(100.0d0 90.48374986516933d0 81.8730898966253d0 74.08184186894766d0
         67.03202849220888d0 60.65309299043932d0 54.88119294695767d0
         49.658561349146126d0 44.932928437803035d0 40.65699857475723d0
         36.787976893068794d0 33.28714099238066d0 30.119453392811955d0
         27.253210868708226d0 24.65972715266909d0 22.313045834254343d0
         ...)

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

Тем не менее, во время интегрирования таких уравнений внутри используется сугубо императивная функция мемоизации MEMO-PROCESS. Она аналогична функции memo из F#-вской библиотеки. Обе эти функции принимают динамический процесс, т.е. некоторое значение в монаде моделирования, и возвращают процесс-двойник, который кеширует все значения первого процесса в узлах интегрирования, причем вычисления происходят строго последовательно по узлам. Это открывает путь к построению гибридных моделей, поскольку мы здесь знаем, что первый, т.е. кешируемый процесс будет вычисляться в строго определенном порядке (если нет других ссылок на него). Такой процесс мы можем реализовать как итерационный. Это еще одна вещь наряду с недетерминизмом, которую будет трудно или почти невозможно воспроизвести в хаскеле.

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

Это все прекрасно, но у моего метода есть большой недостаток. Монада моделирования работает медленно, очень медленно. Например, MapSim компилирует симуляцию в эффективный байт-код, который выполняется гораздо быстрее. Или, быть может, просто MapSim быстр? Но монада моделирования позволяет достаточно просто и легко строить очень сложные гибридные модели. И пока я не определился в своем отношении к изобретению. Просто игрушка для ума или серьезная и полезная вещь?

Версия для F# достаточно зрелая и многое умеет, включая стохастику. Версия для Common Lisp реализует пока лишь интегралы и мемоизацию, причем нет оптимизации по типам. Может быть, потом выложу результаты в свободный доступ. Хотя мне кажется, что описанное в обеих частях достаточно легко воспроизвести, поскольку первая часть содержит полное описание монады моделирования на языке F#.

В продолжение функциональной темы. В ходе беседы у меня возникла идея того, как можно создавать и обрабатывать так называемые алгебраические типы данных (algebraic data types - ADT) вроде таких

Здесь NoneValue, SingleValue и DoubleValue являются также конструкторами данных. Компилятор хаскеля по такому определению автоматически создает одноименные функции. Мы их тоже создадим. Будем делать все через списки. Первым элементом списка будет идти символическое имя конструктора, т.е. тег. Затем в списке будут идти данные. Это позволит нам различать значения.

Как видим, все очень просто. Теперь мы можем вручную устроить сопоставление с образцом (pattern-matching).

Писать каждый раз такой код – дело утомительное и ненужное. Поэтому я придумал вспомогательные утилиты.

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

Следующий макрос позволяет более наглядно сопоставлять с образцом. Его имя похоже на имена стандартных макросов CASE, CCASE и ECASE. Приставка ADT указывает, что работа идет с алгебраическими типами данных.

Тогда наш исходный код превращается в легко-читаемый и более краткий. Более того, мы ничего не должны знать о том, что там где-то внутри используются списки для реализации ADT. Более высокий уровень абстракции!

Сопоставление с образцом было бы неполным, если бы не было замены хаскелевского шаблона “_”. Я выбрал в качестве аналога лисповский терм T. Соответствующее условие должно быть самым последним в списке, иначе компилятор выдаст ошибку.

И, наконец, приведу функцию, которая берет значение типа TaggedType и возвращает либо NIL, либо новую CONS-пару.

Пример использования:

Недавно нашлось время поработать над cl-gtk2, выложил пару изменений. Ниже — краткая их сводка.

Проверка на минимальную версию библиотек

При загрузке cl-gtk2 теперь проверяет, какая версия Gtk+ установлена и генерирует ошибку комиляции, если версия слишком старая. Видимо, вопросов о том, почему не cl-gtk2 компилируется, должно быть меньше.

Поддержка нескольких версий Gtk+

Добавлена рудиментарная поддержка нескольких версий Gtk+. При загрузке cl-gtk2 добавляет в *features* символы, соответствующие версиям glib и Gtk+, и остальной код может использовать их для условной компиляции классов/функций/методов. Поэтому, если загрузить cl-gtk2 при установленной Gtk+-2.18, то будут доступны классы из Gtk+-2.18. Но при обновлении Gtk+ надо будет перекомпилировать cl-gtk2.

Улучшена демонстрационная программа

Немного переделал интерфейс демо-программы gtk-demo:demo, теперь выглядит как текстовая страница со ссылками на демонстрации:

Работа с главным циклом приложения

Теперь функции ensure-gtk-main, leave-gtk-main, join-gtk-main и макрос within-main-loop работают схожим образом как в многопоточных лиспах, так и в однопоточных.

Использовать их следует следующим образом. В главную функцию 'main' помещается код вида:

(defun run ()
  (within-main-loop
    (your-application-code) ;; в какой-то момент приложение вызове leave-gtk-main
  ))
(defun main ()
  (run)
  (join-gtk-main)
  (quit))

Тогда функция main вернет управление, когда приложение вызовет leave-gtk-main, и приложение завершится. Функцию main можно использовать в качестве toplevel-функции при сохранении образа или при запуске скрипта, а функцию run можно использовать для запуска приложения во время разработки — приложение будет запущено в фоне и можно будет спокойно его дописывать.

Потокобезопасная финализация экземпляров GBoxed-типов

Как-то совсем забыл изначально сделать финализацию GBoxed'ов потокобезопасной, а теперь вот вспомнил — встретил ряд багов, связанных с этим.

• Продемонстрировать, что common lisp не является deprecated, как утверждалось где-то в журнале
• Продемонстрировать, что решения на CL практичны: при сравнимом LOC оказываются производительнее и потребляют меньше памяти, нежели решения на других языках
• В выгодном свете акцентировать внимание на самых сильных сторонах CL: метапрограммирование и генерация кода в рантайме

Генерация кода

(COND
  ((AND (> Y 42.965324) (<= Y 54.692776))
   (COND
     ((AND (> Y 51.11711) (<= Y 54.692776))
      (WHEN (<= X (+ (* Y -3.0087342) 306.6176))
        (SETF CROSS (LOGNOT CROSS)))
      (COND
        ((> Y 54.099148)
         (WHEN (<= X (+ (* Y 0.029405717) 140.45332))
           (SETF CROSS (LOGNOT CROSS))))
        ((<= Y 51.62894)
         (WHEN (<= X (+ (* Y 4.129624) -58.274612))
           (SETF CROSS (LOGNOT CROSS)))
         (COND
           ((> Y 51.19278)
            (WHEN (<= X (+ (* Y -3.135153) 316.7981))
              (SETF CROSS (LOGNOT CROSS))))))
        ((AND (> Y 52.99881) (<= Y 53.746616))
         (WHEN (<= X (+ (* Y -0.3500023) 160.2204))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 52.383385) (<= Y 52.8256))
         (WHEN (<= X (+ (* Y 0.32559264) 124.49829))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 53.746616) (<= Y 54.099148))
         (WHEN (<= X (+ (* Y 1.8018049) 44.56803))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 52.14762) (<= Y 52.383385))
         (WHEN (<= X (+ (* Y -0.14995793) 149.40924))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 52.84809) (<= Y 52.99881))
         (WHEN (<= X (+ (* Y 0.6042015) 109.64873))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 52.8256) (<= Y 52.84809))
         (WHEN (<= X (+ (* Y -5.259837) 419.552))
           (SETF CROSS (LOGNOT CROSS)))))))
   (COND
     ((AND (> Y 47.88031) (<= Y 52.14762))
      (WHEN (<= X (+ (* Y 0.18784428) 131.79366))
        (SETF CROSS (LOGNOT CROSS)))
      (COND
        ((AND (> Y 50.30867) (<= Y 51.19278))
         (WHEN (<= X (+ (- Y) 207.4937))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 49.766396) (<= Y 50.30867))
         (WHEN (<= X (+ (* Y 0.5555665) 129.23521))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 49.719467) (<= Y 49.766396))
         (WHEN (<= X (+ (* Y -3.0089417) 306.62793))
           (SETF CROSS (LOGNOT CROSS)))))))
   (COND
     ((AND (> Y 42.965324) (<= Y 49.719467))
      (WHEN (<= X (+ (* Y 1.6237954) 76.29072))
        (SETF CROSS (LOGNOT CROSS)))
      (COND
        ((<= Y 43.59513)
         (WHEN (<= X (+ (* Y -0.517238) 168.28091))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 44.528984) (<= Y 45.74067))
         (WHEN (<= X (+ (* Y -1.2019796) 199.16792))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 45.795887) (<= Y 46.891037))
         (WHEN (<= X (+ (* Y -0.014922306) 141.6298))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 43.812305) (<= Y 44.528984))
         (WHEN (<= X (+ (* Y 0.5151565) 122.7056))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 47.193726) (<= Y 47.88031))
         (WHEN (<= X (+ (* Y 0.86301005) 99.466515))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 43.59513) (<= Y 43.812305))
         (WHEN (<= X (+ (* Y -1.0000175) 189.08887))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 46.98366) (<= Y 47.193726))
         (WHEN (<= X (+ (* Y -3.8077252) 319.89594))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 46.891037) (<= Y 46.98366))
         (WHEN (<= X (+ (* Y 0.70128906) 108.04591))
           (SETF CROSS (LOGNOT CROSS))))
        ((AND (> Y 45.74067) (<= Y 45.795887))
         (WHEN (<= X (+ (* Y -58.71558) 2829.8784))
           (SETF CROSS (LOGNOT CROSS)))))))))

CL-GEO> (draw-file #p"/home/swizard/devel/lisp/cl-geo/data/poly/adygeya.poly" 150 75)
; compiling (IN-PACKAGE :CL-GEO)
; compiling (DEFUN ADYGEYA-0 ...)
; compiling (DEFUN ADYGEYA-1 ...)
; compiling (DEFUN ADYGEYA-2 ...)
; compiling (DEFUN ADYGEYA ...)
------------------------------------------------------------------------------------------------------------------------------------------------------ 45.19193
----------------------------------------------------------------*********----------------------------------------------------------------------------- 45.172714
---------------------------------------------------------------***********---------------------------------------------------------------------------- 45.1535
-------------------------------------------------------------****************------------------------------------------------------------------------- 45.134285
-----------------------------------------------------------***********************-------------------------------------------------------------------- 45.11507
----------------------------------------------------------*****************************----------------**********------------------------------------- 45.095856
-------------------------------------------------------**************************************--*********************---------------------------------- 45.07664
-----------------------------------------------------****************************************************************--------------------------------- 45.057426
-------------******--------------------------------*********-***********************************************************------------------------------ 45.03821
-***-------********-----------------------------************------------**************************************************---------------------------- 45.018997
-*********************-------------------------************------------***************--**************************************------------------------ 44.999783
-***********************---------*-------******************----------***-*********--------**************************************---------------------- 44.980568
-**************************---******************************--------**-----*****-----------***************************************-------------------- 44.961353
-******-********************************************************-----*-------**------------*****************************************------------------ 44.94214
----------********************************************************-------------------------*-****************************************----------------- 44.922924
------------*******************************************************---------------------------*****************************************--------------- 44.90371
---------------******************************************************------------------------******************************************--------------- 44.884495
------------------****************************************************----------------------********************************************-------------- 44.86528
----------------------**********************************************-------------------------********************************************------------- 44.846066
-------------------------*****************************************------------------------------******************************************------------ 44.82685
--------------------------------------------------***************------------------------------********************************************----------- 44.807636
------------------------------------------------------------------------------------------------********************************************---------- 44.78842
-------------------------------------------------------------------------------------------------********************************************--------- 44.769207
--------------------------------------------------------------------------------------------------*****************************-----*********--------- 44.749992
--------------------------------------------------------------------------------------------------***************************----------******--------- 44.730778
----------------------------------------------------------------------------------------------******************************------------******-------- 44.711563
------------------------------------------------------------------------------------------**********************************------------*******------- 44.69235
-------------------------------------------------------------------------------------------*********************************------------*******------- 44.673134
------------------------------------------------------------------------------------------**********************************--------------******------ 44.65392
------------------------------------------------------------------------------------------********************************-----------------*******---- 44.634705
-------------------------------------------------------------------------------------------*****************************----------------------******-- 44.61549
-------------------------------------------------------------------------------------------****************************-----------------------*******- 44.596275
-----------------------------------------------------------------------------------------******************************------------------------*****-- 44.57706
---------------------------------------------------------------------------------------*********************************------------------------****-- 44.557846
---------------------------------------------------------------------------------------***********************************-----------------------***-- 44.53863
---------------------------------------------------------------------------------------*************************************---------------------****- 44.519417
---------------------------------------------------------------------------------------**************************************--------------------***** 44.500202
----------------------------------------------------------------------------------------**************************************-------------------***** 44.480988
---------------------------------------------------------------------------------------***************************************---------------*******-- 44.461773
-------------------------------------------------------------------------------------****************************************------------------------- 44.44256
------------------------------------------------------------------------------------*****************************************------------------------- 44.423344
-----------------------------------------------------------------------------------******************************************------------------------- 44.40413
----------------------------------------------------------------------------------*******************************************------------------------- 44.384914
---------------------------------------------------------------------------------********************************************------------------------- 44.3657
---------------------------------------------------------------------------------*********************************************------------------------ 44.346485
-----------------------------------------------------------------------------------------**************************************----------------------- 44.32727
------------------------------------------------------------------------------------------**************************************---------------------- 44.308056
-------------------------------------------------------------------------------------------*************************************---------------------- 44.28884
--------------------------------------------------------------------------------------------***********************************----------------------- 44.269627
-----------------------------------------------------------------------------------------------------************************------------------------- 44.250412
------------------------------------------------------------------------------------------------------*********************--------------------------- 44.231197
-----------------------------------------------------------------------------------------------------**********************--------------------------- 44.211983
------------------------------------------------------------------------------***-------------------***********************--------------------------- 44.19277
----------------------------------------------------------------------------*******-----------------***********************--------------------------- 44.173553
----------------------------------------------------------------------------********----------------***********************--------------------------- 44.15434
----------------------------------------------------------------------------********--------------*************************--------------------------- 44.135124
----------------------------------------------------------------------------************--------***************************--------------------------- 44.11591
------------------------------------------------------------------------------***********-------****************************-------------------------- 44.096695
-------------------------------------------------------------------------------**********------*****************************-------------------------- 44.07748
-------------------------------------------------------------------------------*********************************************-------------------------- 44.058266
------------------------------------------------------------------------------*********************************************--------------------------- 44.03905
-----------------------------------------------------------------------------***********************************************-------------------------- 44.019836
-----------------------------------------------------------------------------***************************************************---------------------- 44.00062
------------------------------------------------------------------------------***************************************************--------------------- 43.981407
------------------------------------------------------------------------------***************************************************--------------------- 43.962193
----------------------------------------------------------------------------*****************************************************--------------------- 43.942978
-----------------------------------------------------------------------------***************************************************---------------------- 43.923763
---------------------------------------------------------------------------------*******--************************************------------------------ 43.90455
--------------------------------------------------------------------------------------------*********************************------------------------- 43.885334
-----------------------------------------------------------------------------------------------******************************------------------------- 43.86612
-------------------------------------------------------------------------------------------------***************************-------------------------- 43.846905
----------------------------------------------------------------------------------------------------------******************-------------------------- 43.82769
------------------------------------------------------------------------------------------------------------***************--------------------------- 43.808475
--------------------------------------------------------------------------------------------------------------************---------------------------- 43.78926
----------------------------------------------------------------------------------------------------------------********------------------------------ 43.770046
NIL

Метапрограммирование

1. ITER-XML-STREAM: язык для декларативного описания обработки xml тагов
2. ITER-PARSE-STREAM: язык для декларативного описания парсинга входного потока (поиск подстрок, восстановление цифр)
3. ITER-STREAM: язык для описания посимвольной обработки входного потока
4. ITERATE: он и в африке iterate
5. Common Lisp: примитивный, с аккуратной декларацией типов
6. Asm/машинный код: максимально нативный, без боксинга, без задействования GC (ни единой аллокации), без generic-функций.

(defun/iter-xml perform-pass-1 ((poly-ctx poly-context) (hash-table node-idx))
  "Scans SRC-OSM xml stream extracting <node> tags, checks each node for polygon
belonging via POLY-CONTEXT, and sets index NODE-IDX in case of success"
  (with (the (unsigned-byte 56) way-offset) = 0)
  (xml-on-tag "node"
              (attrs ("id" uint64 node-id)
                     ("lon" float lon)
                     ("lat" float lat))
              (on-match (when (poly-check poly-context lon lat)
                          (setf (gethash node-id node-idx) 1))))
  (xml-on-tag "way" (on-match (when (zerop way-offset)
                                (setf way-offset tag-offset))))
  (tracing-tag-offset tag-offset)
  (finally (return (1- way-offset))))

1. За повышение уровня абстракции надо платить потерей производительности
2. Серебряной пули не существует

• DSL iterate используется для описания итеративных процессов. Чтение данных из потока к таким процессам вполне относится
• DSL iter-stream использует два цикла iterate: первый для read-sequence данных в буфер, и второй (вложенный) по только что считанному буферу. Пользователю предлагается абстрактное окружение, в котором для него в цикле предоставляется очередной октет из потока.
• DSL iter-parse-stream использует iter-stream и простенькие КА для фильтрации потока на предмет заданных паттернов
• И, наконец, iter-xml-stream использует iter-parse-stream, предоставляя пользователю язык для описания правил обработки xml-тагов.

Изобрел монадические макросы для Common Lisp и оформил их в виде пакета cl-monad-macros. На мой взгляд, получилась довольно интересная вещь, основным достоинством которой является высокая эффективность генерируемого кода. Здесь было бы интересно посостязаться с хаскелевскими компиляторами. Потом поместил объявление на comp.lang.lisp.

Основная идея состоит в том, что мы задаем монадические макросы типа WITH-MONAD, которые внутри себя через MACROLET определяют унифицированные макросы UNIT, FUNCALL!, LET! и PROGN!. Макрос UNIT – это хасклевская функция return, FUNCALL! – это bind с обратным порядком параметров (=<<), LET! – альтернатива стрелке, а PROGN! – замена хаскелевского then (>>). Причем LET! по виду похож на стандартный LET*, а PROGN! – на стандартный PROGN. Более того, в случае монады Identity (макрос WITH-IDENTITY-MONAD) макрос LET! совпадает с LET*, PROGN! – с PROGN, FUNCALL! – c FUNCALL, а UNIT становится эквивалентным обычной функции IDENTITY. Все это позволяет писать код в единой нотации – меняем только монадические макросы типа WITH-MONAD.

Например, макрос WITH-LIST-MONAD задает монаду List. Следующая функция возвращает все возможные перестановки заданного списка.

Функцию можно протестировать:

По своей сути LET!  – это обобщенный случай List Comprehension. PROGN! создает последовательность вычислений. Самое интересное, что реализация всех этих макросов в общем случае проста как топор. За это отвечает монадический макрос WITH-MONAD.

Пакет cl-monad-macros предоставляет также готовые монадические макросы для монад Identity, List, Maybe, Reader, State и Writer. Последняя монада несколько отличается от канона, но суть та же. Такие специализированные макросы порождают намного более эффективный код для своих монад, чем обобщенный макрос WITH-MONAD.

Были сложности с монадными трансформерами. Для них, кстати, отдельные макросы – необходимость. В пакете есть макросы для трансформеров Reader, State и Writer. Это параметризуемые монадические макросы, где параметром является другой монадический макрос. Довольно мощная абстракция, которая позволяет комбинировать несколько монад в одной.

Если пытаться использовать монадические макросы для транформеров непосредственно в коде, то легко загнать лисповский компилятор в ступор. Дело в том, что эти макросы при раскрытии создают множество вложенных MACROLET-ов. У компиляторов от этого сносит голову напрочь. Но пока мне такая кодо-генерация представляется единственно возможной для трансформеров, если делать именно через макросы, а не generic-функции. Но, к счастью, есть простое решение. Назвал его упрощением (редукцией) монадических макросов. С обычными же непараметризуемыми макросами типа WITH-MONAD и WITH-LIST-MONAD все нормально.

Теперь вот думаю дополнить монадические макросы вспомогательными макросами. Нужны аналоги хаскелевских полиморфных функций типа fmap, sequence, join и т.д. Еще нужно что-то придумать для циклов. В хаскеле этого уже нет, но зато есть в F#.

Это все собираюсь использовать для симуляции моделей системной динамики. Обнаружил, что динамический процесс может быть определен как вариация монады Reader. Что важно, это позволяет задавать задачи моделирования декларативно, т.е. на высоком уровне абстракции. Я уже написал такую библиотеку на F#, но меня не устраивает ее скорость – слишком много накладных расходов, связанных с монадами. Надеюсь, что лисповская реализация на основе придуманных мною монадических макросов будет быстрее, во многом благодаря особой технике генерации кода для монады Reader. Там получается, что FUNCALL и LAMBDA чередуются друг с другом, то есть их можно сократить, но об этом написано уже у меня в документации к пакету cl-monad-macros.

О намерениях. Данная компиляция не стремиться убедить вас использовать
Common Lisp. Не хотите - не используйте. Нам же лучше.

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



## Синтаксис.

Он отличается, то что вы пишете как
function add(x, y) {
 return x+y
}
в Common Lisp записывается как
(defun add (x y)
  (+ x y))
К этому можно быстро привыкнуть, а вознаграждение в том, что такая
запись позволяет легко и удобно заниматься метапрограммированием.


## Арифметика.
(+ 5/9 3/4) будет равно 47/36 а не 1.30555556
Это позволяет избегать многих ошибок округления. Разрядная сетка
увеличивается автоматически.


## Places

Forms и places можно рассматривать как если бы они были конкретными,
изменяемыми переменные и присваивать им значения. Проиллюстрирую это
на алгол-подобном языке

a = ['red' 'green' 'blue'];
first(a); // выведет 'red'
first(a) = 'yellow';
first(a); // теперь выведет 'yellow'

На лиспе это записывается так:

(defvar *colours* (list "red" "green" "blue"))
(first *colours*) ;; выведет "red"
(setf (first *colours*) "yellow")
(first *colours*) ;; выведет "yellow"


## Множественные значения

Изучая ассемблер, в частности соглашения о вызовах си-функций, я
недоумевал - кто это решил, что функция должна возвращать только одно
значение? Никаких аппаратных ограничений на это ведь нет. В Common
Lisp функция может возвращать сколько угодно значений. В переводе на
алгол-подобный язык это было бы так:

func(param) {
 return (param*3) (param*6)
}

a, b = func(5)

а на Common Lisp это будет вот так
(defun func (param)
 (values (* 3 param) (* 6 param)))

(multiple-value-bind (a b)
  (func 5))

Теперь не нужно строить структуру данных, когда вы просто хотите
возвратить чуточку больше чем собирались ранее.


## Макросы

Макрос в Common Lisp это функция, возвращающая код, который после
возврата будет немедленно скомпилирован и исполнен в контексте вызова
макроса. Думаю не нужно объяснять, какие возможности это открывает при
умелом применении для метапрограммирования.


## Функции как сущности первого класса

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


## Анонимные функции и лексические замыкания

Это функции без имени, объявленные и использованные в контексте
объявления. Например вот так мог бы выглядеть некий вызвов функции
сортировки слов, где мы создаем анонимную функцию, прямо в контексте
вызова, которая возвращает true или false в зависимости от результата
сравнения a и b:

sort_words("one two alfa beta",
            create_function(a, b)
             {...});

А на лиспе это еще проще:

(sort-words "one two alfa beta"
            (lambda (a b)
              ...))


## Необязательные и именованные параметры

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

func(a, b="default value", с:key="alfa") {
 ...
}

Здесь a - обязательный параметр, b - необязательный, а c -
именованный. Если вы вызовете функцию так:

func(1, key:2)

то внутри функции a будет равно 1, b - "default value", а c - 2. На
лиспе это будет выглядеть вот так:

(defun func (a &optional b &key (key "alfa"))
  ...)

Указывать значения по умолчанию для ключевых параметров
необязательно. Вы так же можете создавать функци и с неопределенным
количеством параметров, добавляя модификатор &rest - все параметры
сверх попадут в него:

(defun func (a &optional b &key (key "alfa") &rest other-args)
  ...)

Использование ключевых параметров повышает читабельность, сравните эти
два вызова:

(xf86InitValuatorAxisStruct device, 0, 0, -1, 1, 0, 1))

и

(xf86-init-valuator-axis-struct :dev device :ax-num 0
                                :min-val 0 :max-val -1
                                :min-res 0 :max-res 1
                                :resolution 1)


Многое еще осталось неупомянутым, но сегодня я уже не нахожу в себе
силы закончить. Продолжение следует, а самые нетерпеливые могут
обратиться к первоисточнику тут:
http://abhishek.geek.nz/docs/features-of-common-lisp

Буду также очень благодарен всем, кто исправит ошибки.

(asdf:operate 'asdf:load-op :cl-who)
(asdf:operate 'asdf:load-op :restas)

(restas:defsite :restas.example-3
 (:use :cl))

(in-package :restas.example-3)

(define-route main ("" :method :get)
 (who:with-html-output-to-string (out)
   (:html
    (:body
     ((:form :method :post
             :enctype "multipart/form-data")
      ((:input :name "file"
               :type "file"))
      (:br)
      ((:input :type "submit"
               :value "Send")))))))

(define-route main/post ("" :method :post)
 (let ((file-info (hunchentoot:post-parameter "file")))
   (if file-info
       (who:with-html-output-to-string (out)
         (:html
          (:body
           (:div
            (:b  "Name: ")
            (who:str (second file-info)))
           (:div
            (:b  "Content-Type: ")
            (who:str (third file-info)))
           (:div
            (:b "Content")
            (:br)
            (who:str (hunchentoot:escape-for-html (alexandria:read-file-into-string (first file-info)))))
           ((:a :href (restas:genurl 'main)) "Try again"))))
       (restas:redirect 'main))))

(restas:start-site :restas.example-3 :port 8080)