1. Кодогенерация (макросы, использование программы как данных)
2. ФП на примере обработки списков (lambda, map, reduce, apply и т.д.)

Updated: 23.01.12

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

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

Посмотреть справку

(pushnew "/path/to/embeddable-maxima" asdf:*central-registry*)
(ql:quickload :embeddable-maxima)
(in-package :maxima)

Для просмотра справки необходимо вызвать функцию describe("function-name"). Данная функция в окружении лиспа определена, как $describe. В лиспе вызывать ее следует с помощью mfuncall (maxima function caller). Например, просмотр справки для функции ratsimp.

MAXIMA> (mfuncall '$describe "ratsimp")

 -- Function: ratsimp ()
 -- Function: ratsimp (, , ..., )
     Simplifies the expression  and all of its subexpressions,
     including the arguments to non-rational functions.  The result is
     returned as the quotient of two polynomials in a recursive form,
     that is, the coefficients of the main variable are polynomials in
     the other variables.  Variables may include non-rational functions
     (e.g., `sin (x^2 + 1)') and the arguments to any such functions
     are also rationally simplified.

     `ratsimp (, , ..., )' enables rational
     simplification with the specification of variable ordering as in
     `ratvars'.

     When `ratsimpexpons' is `true', `ratsimp' is applied to the
     exponents of expressions during simplification.

     See also `ratexpand'.  Note that `ratsimp' is affected by some of
     the flags which affect `ratexpand'.

     Examples:

          (%i1) sin (x/(x^2 + x)) = exp ((log(x) + 1)^2 - log(x)^2);
                                                   2      2
                             x         (log(x) + 1)  - log (x)
          (%o1)        sin(------) = %e
                            2
                           x  + x
          (%i2) ratsimp (%);
                                       1          2
          (%o2)                  sin(-----) = %e x
                                     x + 1
          (%i3) ((x - 1)^(3/2) - (x + 1)*sqrt(x - 1))/sqrt((x - 1)*(x + 1));
                                 3/2
                          (x - 1)    - sqrt(x - 1) (x + 1)
          (%o3)           --------------------------------
                               sqrt((x - 1) (x + 1))
          (%i4) ratsimp (%);
                                     2 sqrt(x - 1)
          (%o4)                    - -------------
                                           2
                                     sqrt(x  - 1)
          (%i5) x^(a + 1/a), ratsimpexpons: true;
                                         2
                                        a  + 1
                                        ------
                                          a
          (%o5)                        x


  There are also some inexact matches for `ratsimp'.
  Try `?? ratsimp' to see them.

Выполнить строку

(pushnew "/path/to/embeddable-maxima" asdf:*central-registry*)
(ql:quickload :embeddable-maxima)
(in-package :maxima)

Делай ast с помощью специальной функции macsyma-read-string, раз:

Важно не забыть один из терминальных символов ";" или "$".

MAXIMA> (macsyma-read-string "ratsimp( (2*x^2 + 3*x + 1) - (x^2 + x^2 - 2*x + 4*x + 1) );")

(($RATSIMP)
 ((MPLUS) ((MPLUS) ((MTIMES) 2 ((MEXPT) $X 2)) ((MTIMES) 3 $X) 1)
  ((MMINUS)
   ((MPLUS) ((MEXPT) $X 2) ((MEXPT) $X 2) ((MTIMES) ((MMINUS) 2) $X)
    ((MTIMES) 4 $X) 1))))

Выполняй ast с помощью вызова максимы-функции ev(expression,arg_1,arg_2,...,arg_n), два:

MAXIMA> (mfuncall '$ev *)

$X

Отображай полученное ast в строчку, три:

MAXIMA> (displa *)

x
NIL

В данном примере мы упростили выражение ((2*x^2 + 3*x + 1) - (x^2 + x^2 - 2*x + 4*x + 1)) с помощью функции ratsimp.

Простой json-rpc для maxima

Осторожно, американский стиль повествования!Верите ли вы, что я сделаю это за 42 строчки? А вот да, сделаю. Конечно это лисп, и здесь в рамках одной строки вмещается раза в два больше информации, чем в алгольных языках. При этом я еще и поиспользую кучу библиотек, хотя считается, что под cl их нет. Ладно, если не считать пустых строк, то их всего 32. Ну что поверили? А вот я опять вас обманул. Действительно полезных строк 27. Итак json-rpc сервис для maxima, для того, чтобы вы из любого языка, который умеет http и json могли решить дифференциальное уравнение второго порядка. Только здесь и только сейчас.

Загружаем три библиотеки, 1-ая строка:

(mapcar #'ql:quickload '(:embeddable-maxima :restas :cl-json))

Обозначаем restas модуль для обработки http запросов, 4-ая строка:

(restas:define-module :maxima-json-rpc
  (:use #:cl #:restas #:json #:json-rpc))
(in-package :maxima-json-rpc)

Создаем функцию для проверки: заканчивается ли переданная максима команда с помощью терминальных символов $ или ;, 11-ая строка:

(defun ensure-valid-maxima-input (input)
  "Returns string with appended ';', if input string does not have maxima command terminator at the end."
  (let* ((input-trimmed (string-trim '(#\Space #\Newline #\Tab) input))
        (last-char (char input-trimmed (1- (length input-trimmed)))))
    (if (and (not (char= #\; last-char)) (not (char= #\$ last-char)))
        (concatenate 'string input-trimmed ";")
        input-trimmed)))

Создаем функцию, которая преобразовывает строковое выражение в АСТ для максимы, 13-ая строка:

(defun maxima-ast-from-string (input)
  (maxima::macsyma-read-string (ensure-valid-maxima-input input)))

Макрос, который заставляет максиму, выводить результат в "компьютерном" синтаксисе (дроби через /, степени - ^, и т.д.), 16-ая строка:

(defmacro with-2d-output (&body body)
  `(let ((maxima::$display2d nil))
     ,@body))

Экспортируемая функция доступная из удаленных источников. Создается с помощью json-rpc:defun-json-rpc, 24-ая строка:

(defun-json-rpc evaluate :explicit (text)
  "Evaluate maxima expression"
  (let ((result (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)))
    (with-output-to-string (*standard-output* result)
      (with-2d-output
        (maxima::displa
         (maxima::mfuncall 'maxima::$ev (maxima-ast-from-string text)))))
    result))

Обработчик http маршрута, например, http://127.0.0.01/jsonrpc. 31-ая строка:

(define-route jsonrpc ("jsonrpc"
                            :method :post 
                            ;;:content-type "application/json"
                            )
  "json rpc route"
  (let ((*json-rpc-version* +json-rpc-2.0+))
    (invoke-rpc (hunchentoot:raw-post-data :force-text t))))

Ну а здесь мы предоставляет простую страничку, которая умеет с помощью jquery, ajax, json-rpc решать те самые диффуры:

(define-route example ("example")
   (merge-pathnames "examples/js-maxima-rpc-client.html" (asdf:component-pathname (asdf:find-system :maxima-json-rpc))))

Последняя строка для запуска:

(restas:start '#:maxima-json-rpc :port 8080)

Да, это все оформлено и в репозитарии лежит. https://github.com/filonenko-mikhail/maxima-json-rpc

Но это еще не всё. В дополнение вы получаете простой пример на php для того, чтобы моментально находить ответы на непростые математические вопросы. Внимание, данный пример требует наличия JSON-RPC PHP!

<?php
  require_once 'jsonRPCClient.php';
  $maxima = new jsonRPCClient('http://127.0.0.1:8080/jsonrpc');
  print "Maxima evaluator\n";
  print "Evaluate ratsimp(x^2 + 2*x + 1 - (x + 1)^2)\n";
  print $maxima->evaluate("ratsimp(x^2 + 2*x + 1 - (x + 1)^2)");

  print "Evaluate x^2 + 2*x + 1 + (x + 1)^2 in environment x=2\n";
  print $maxima->evaluate("ev(x^2 + 2*x + 1 + (x + 1)^2, x=2)");
?>

И напоследок, sh и решение диффуров. Диффуры такие:

(%i1) 'diff(f,x,2) = sin(x) + 'diff(g,x);

                                2
                               d f            dg
(%o1)                          --- = sin(x) + --
                                 2            dx
                               dx
(%i2) 'diff(f,x) + x^2 - f = 2*'diff(g,x,2);

                                               2
                               2   df         d g
(%o2)                         x  + -- - f = 2 ---
                                   dx           2
                                              dx

sh файлик такой:

#!/bin/sh
curl -i -X POST -d "{\"jsonrpc\": \"2.0\", \"method\": \"evaluate\", \"params\": [\"desolve(['diff(f(x),x,2) = 'diff(g(x),x,1)+sin(x), 'diff(f(x),x,1)-f(x)+x^2 = 2*'diff(g(x),x,2)], [f(x),g(x)]);\"], \"id\": 1}" http://linkfly.ru:8181/jsonrpc

А теперь, кто готов все повторить, но уже на пайтоне?

P.S. А Firemax, что расширение для Firefox, очень даже неплохо справляется с задачей эмуляции emacs под броузером.

Сразу код: караоке.

Установите PortAudio.
Включите музыку (желательно, с вокалом), и выполните следующий код:

sudo pacman -S portaudio
git clone --depth 1 https://github.com/filonenko-mikhail/cl-portaudio.git
emacs
M+x slime
  (pushnew "path/to/cl-portaudio/" asdf:*central-registry*)
  (ql:quickload :cl-portaudio)
  (ql:quickload :cl-portaudio-tests)
  (portaudio-tests:test-read-write-echo)

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

CL-PortAudio

CL-PortAudio cffi-биндинги к PortAudio. PortAudio небольшая кроссплатформенная библиотека для работы со звуком. Она позволяет:

• записывать звук;
• воспроизводить звук.

CL-PortAudio соответственно позволяет делать эти вещи из лиспа.

Документация скопирована и переработана.

API

PortAudio предоставляет очень простое API. Для передачи данных в обоих направлениях можно использовать функцию обратного вызова (callback) или блокирующие функции чтения/записи. Блокирующие функции, надо сказать, можно "разблокировать", с помощью вызова *available функций, которые возвращают возможность чтения/записи данных.

CL-PortAudio использует только блокирующий ввод/вывод, так как функция обратного вызова исполняется в "критическом" контексте, и в ней нельзя даже память выделить, не говоря уже об интерпретаторе лиспа.

Common Lisp позволил уменьшить код основной работы со звуком до 4 функций/макросов. Вот код караоке, которое было вначале.

 (use-package :portaudio)

 (defconstant +frames-per-buffer+ 1024)
 (defconstant +sample-rate+ 44100d0)
 (defconstant +seconds+ 15)
 (defconstant +sample-format+ :float)
 (defconstant +num-channels+ 2)


 (defun test-read-write-converted-echo ()
  "Record input into an array; Separate array to channels; Merge channels into array; Play last array." 
  (with-audio
    (format t "~%=== Wire on. Will run ~D seconds . ===~%" +seconds+) 
    (with-default-audio-stream (astream +num-channels+ +num-channels+ :sample-format +sample-format+ :sample-rate +sample-rate+ :frames-per-buffer +frames-per-buffer+) 
      (dotimes (i (round (/ (* +seconds+ +sample-rate+) +frames-per-buffer+)))
        (ignore-errors (write-stream astream
                                    (merge-channels-into-array astream
                                                               (separate-array-to-channels astream
                                                                                           (read-stream astream)))))))))

• with-audio (&body body)

  Макрос инициализирует в начале и деинициализирует в конце body библиотеку portaudio.

• with-default-audio-stream ((var num-input num-output &key (sample-format :float) (sample-rate 44100.0d0) (frames-per-buffer 1024)) &body body)

  Макрос открывает в начале и закрывает в конце поток для ввода/вывода с заданным количеством каналов, форматом данных (только :float), частотой и количеством данных за один вызов записи/чтения.Макрос также запускает и останавливает открытый поток.

• read-stream (pa-stream)

  Читает данные из потока запущенного ранее. Возвращает одномерные массив данных типа sample-format (только 'single-float) размером (* frames-per-buffer num-input).

• write-stream (pa-stream buffer)

  Записывает данные в поток запущенный ранее. Массив должен быть одномерным типа sample-format (только 'single-float) размером (* frames-per-buffer num-output).

• separate-array-to-channels (pa-stream array)

  Преобразует одномерный массив в (кол-во_каналов)-мерный массив.

• merge-channels-into-array (pa-stream channels)

  Преобразует (кол-во_каналов)-мерный массив в одномерный массив.

Бинарные сборки библиотеки PortAudio можно скачать вот здесь http://planet.plt-scheme.org/package-source/clements/portaudio.plt/2/3/lib/. Очень большое спасибо ракетчикам.

Протестировано:

• SBCL 1.0.54, archlinux x86_64
• SBCL 1.0.53.74.mswinmt.1092-207a13d, windows 7 x86_64 (vbox).

Завлекушная картинка.

Захотелось тут написать простой интерактивный просмотрщик дву- и трехмерных графиков.

Я начал с библиотеки clx. Данная библиотека реализует протокол общения с графическим X сервером и не содержит внешних зависимостей. X сервер содержит расширение glx позволяющее использовать opengl. Я думал, что расширение glx заведется. Не завелось. Хотя под windows+cygwin/x+clx успех был, но это не моя конфигурация по-умолчанию.

На канале #lisp подсказали библиотеку glop, которую можно назвать урезанным clx'ом. Данная библиотека не реализует протокол самостоятельно, а просто является оберткой над сишными клиентами, а под windows и macos использует родные api.

Сегодня пойдет речь о том, как создать рендерер графиков на коммон лиспе с помощью библиотеки glop. По сути, это будет движок для приближения/отдаления точки и вращения вокруг нее.

Сразу же код:

(defpackage :3dplot
  (:use #:cl )
  (:export #:draw-plot #:while))

(in-package #:3dplot)

(defvar *min-zoom* 0.1)
(defvar *zoom-step* 0.1)
(defvar *rotate-multiplicator* 0.3)
(defvar *viewport-multiplicator* 10)

(defclass plotwindow (glop:window)
  ((1st-pressed :initform nil :accessor 1st-pressed)
   (zoom :initform 1 :accessor zoom)
   (xangle :initform 0 :accessor xangle)
   (yangle :initform 0 :accessor yangle)))

(defmethod glop:on-event ((window plotwindow) (event glop:key-event))
  (when (eq (glop:keysym event) :escape)
    (glop:push-close-event window))
  (when (and (glop:pressed event) (eq (glop:keysym event) :f))
    (glop:toggle-fullscreen window))
  (when (and (glop:pressed event) (eq (glop:keysym event) :g))
    (glop:set-fullscreen window)))

(defmethod glop:on-event ((window plotwindow) (event glop:button-event))
  (case (glop:button event)
    (1 ;; main button
     (setf (1st-pressed window) (glop:pressed event)))
    (4 ;; scroll up
     (when (> (zoom window) *min-zoom*)
       (decf (zoom window) *zoom-step*)
       (glop:push-event window (make-instance 'glop:resize-event :height (glop:window-height window)
                                                                 :width (glop:window-width window))))) 
    (5 ;; scroll down
     (incf (zoom window) *zoom-step*)
     (glop:push-event window (make-instance 'glop:resize-event :height (glop:window-height window)
                                                               :width (glop:window-width window))))))

(defmethod glop:on-event ((window plotwindow) (event glop:mouse-motion-event))
  (when (1st-pressed window)
    (incf (xangle window) (* *rotate-multiplicator* (glop:dx event)))
    (incf (yangle window) (* *rotate-multiplicator* (glop:dy event)))))

(defmethod glop:on-event ((window plotwindow) (event glop:resize-event))
  (let* ((width (glop:width event))
         (height (glop:height event))
         (aspect-ratio (/ height width))
         (zoom (zoom window)))
    (gl:viewport 0 0 width height)
    (gl:matrix-mode :projection)
    (gl:load-identity)
    (gl:ortho
     (* zoom (- *viewport-multiplicator*))
     (* zoom *viewport-multiplicator*)
     (* zoom (- (* *viewport-multiplicator* aspect-ratio)))
     (* zoom (* *viewport-multiplicator* aspect-ratio))
     (* zoom (- *viewport-multiplicator*))
     (* zoom *viewport-multiplicator*))))

(defmacro while (condition &body body)
  (let ((var (gensym)))
    `(do ((,var nil (progn ,@body)))
         ((not ,condition) ,var))))

(defun draw-3d-axes ()
  "Draw opengl 3d axes"
  (gl:color 0 1 0)
  (gl:with-primitives :lines
    (gl:vertex -10.0 0.0 0.0)
    (gl:vertex 10.0 0.0 0.0)
    ;; arrow
    (gl:vertex 10.0 0.0 0.0)
    (gl:vertex 9.5 0.5 0.0)
    (gl:vertex 10.0 0.0 0.0)
    (gl:vertex 9.5 -0.5 0.0)

    (gl:vertex 1.0 -0.2 0.0)
    (gl:vertex 1.0 0.2 0.0))
  (gl:color 1 1 0)
  (gl:with-primitives :lines
    (gl:vertex 0.0 -10.0 0.0)
    (gl:vertex 0.0 10.0 0.0)
    ;; arrow
    (gl:vertex 0.0 10.0 0.0)
    (gl:vertex -0.5 9.5 0.0)
    (gl:vertex 0.0 10.0 0.0)
    (gl:vertex 0.5 9.5 0.0)
    ;;unit
    (gl:vertex -0.2 1.0 0.0)
    (gl:vertex 0.2 1.0 0.0))
  (gl:color 0.4 0.5 1)
  (gl:with-primitives :lines
    (gl:vertex 0.0 0.0 -10.0)
    (gl:vertex 0.0 0.0 10.0)
    ;; arrow
    (gl:vertex 0.0 0.0 10.0)
    (gl:vertex -0.5 0.0 9.5)
    (gl:vertex 0.0 0.0 10.0)
    (gl:vertex 0.5 0.0 9.5)
    ;; unit
    (gl:vertex -0.2 0 1.0)
    (gl:vertex 0.2 0 1.0)))

(defun draw-plot-points (fn x-start x-end x-step y-start y-end y-step)
  "Draw plot of given function"
  (gl:color 1 1 1)
  (do ((x x-start (+ x x-step)))
      ((< x-end x) nil)
    (gl:with-primitives :line-strip
      (do ((y y-start (+ y y-step)))
          ((< y-end y) nil)
        (gl:vertex x y (funcall fn x y)))))
  (do ((y y-start (+ y y-step)))
      ((< y-end y) nil)
    (gl:with-primitives :line-strip
      (do ((x x-start (+ x x-step)))
          ((< x-end x) nil)
        (gl:vertex x y (funcall fn x y))))))


(defun draw-plot (fn x-start x-end x-step y-start y-end y-step)
  (glop:with-window (win "Interactive 3d plot" 800 600 :win-class 'plotwindow)
    ;; GL init
    (gl:clear-color 0 0 0 0)
    ;; idle loop, we draw here anyway
    (let ((frames 0)
          (last-time (get-universal-time)))
      (while (glop:dispatch-events win :blocking nil :on-foo nil)
        ;; rendering
        (gl:matrix-mode :modelview)
        (gl:load-identity)
        (gl:scale 1 1 -1)
        (gl:clear :color-buffer)
        ;; transform view
        (gl:with-pushed-matrix 
          (gl:rotate (xangle win) 0.0 1.0 0.0)
          (gl:rotate (yangle win) 1.0 0.0 0.0)
          (gl:color 1 1 1)
          (draw-3d-axes)
          (draw-plot-points fn x-start x-end x-step y-start y-end y-step))
        (gl:flush)
        (glop:swap-buffers win)
        (incf frames)
        (when (< 1 (- (get-universal-time) last-time))
          (format *standard-output* "fps ~a~%" (/ frames  (- (get-universal-time) last-time)))
          (setf last-time (get-universal-time))
          (setf frames 0))))))

Объявляем пакет 3dplot, экспортируем из него символ draw-plot.

draw-plot fn x-start x-end x-step y-start y-end y-step

Функция принимает:

• fn функция от двух аргументов x и y, должна вернуть числовое значение
• x-start x-end x-step начальное, конечное и приращение аргумента x
• y-start y-end y-step начальное, конечное и приращение аргумента y

Пример, сетчатого графика для функции z = sin(x) + cos(x), где X э [-5,5] и Y э [-5,5], шаг 0.1(э должна быть перевернута:), можете покрутить колесиком мыши или зажав левую клавишу подвигать ею.

(ql:quickload :glop)
(ql:quickload :cl-opengl)

(3dplot:draw-plot (lambda (x y) (+ (sin x) (cos y))) -5 5 0.1 -5 5 0.1)

Почему так много скобок.

Повторюсь: то, что получилось, представляет собой небольшой 3d движок. Можно даже сказать совсем небольшой. Что в нем реализовано:

• Фокусирование на точке (0, 0, 0)
• Приближение к данной точке
• Отдаление от данной точки
• Вращение вокруг данной точки

(defvar *min-zoom* 0.1)
(defvar *zoom-step* 0.1)
(defvar *rotate-multiplicator* 0.3)
(defvar *viewport-multiplicator* 10)

Это регуляторы для нашего движка.

• *min-zoom* минимальное расстояние, меньше которого приближаться нельзя
• *zoom-step* скорость приближения
• *rotate-multiplicator* скорость поворота
• *viewport-multiplicator* глобальное увеличение

Далее класс нашего окна для рисований. Наследуем его от glop:window.

(defclass plotwindow (glop:window)
  ...

Объект такого класса будет хранить следующие параметры.

• 1st-pressed зажата ли левая клавиша мыши
• zoom текущее увеличение
• xangle текущий поворот относительно оси x
• yangle текущий поворот относительно оси y

В этот же класс можно было бы добавить глобальные константы, но это в следующий раз.

Теперь реализуем обработчики событий от нашего окна. Первый специфируемый параметер: окно, второй - событие.

(defmethod glop:on-event ((window plotwindow) (event glop:key-event)
  ....

Обрабатываем нажатые клавиши мыши:

• ESC - выход из программы. Осуществляется отсылкой сообщения glop:close-event нашему окну.
• f - перключение полноэкранного режима
• g - включение полноэкранного режима

(defmethod glop:on-event ((window plotwindow) (event glop:button-event)
  ....

Обрабатываем события от мыши. Если нажата левая клавиша: устанавливаем флаг в слоте окна 1st-pressed. Если нажата scroll up, приближем сцену, если scroll down - отдаляем. Для применения приближения или отдаления отсылаем сообщение об изменениях размеров. В обработчике того события происходит настройка сцены.

(defmethod glop:on-event ((window plotwindow) (event glop:mouse-motion-event))
  ....

Обработчик события передвижения мыши. Если зажата левая (главная клавиша) увеличиваем углы поворота сцены на "пробег" мыши.

(defmethod glop:on-event ((window plotwindow) (event glop:resize-event))
  ....

Здесь обрабатываем изменение размеров окна. Кроме того, данное событие "наступает", когда пользователь воспользовался функцией приближения/отдаления. Я не буду объяснять данный код, так как в книжках по opengl (например, redbook) это сделано гораздо лучше.

(defmacro while (condition &body body)
  ....

Вспомогательный макрос.

(defun draw-3d-axes ()
  ....

Отрисовываем оси координат, единичные отрезки и даже стрелочки. Делаем это разным цветом.

• Ось X - зеленая
• Ось Y - желтая
• Ось Z - синяя

(defun draw-plot-points (fn x-start x-end x-step y-start y-end y-step)
  ....

Примитивная отрисовка графика.

(defun draw-plot (fn x-start x-end x-step y-start y-end y-step)
  ....

Главная функция. Создаем окно, настраиваем цвет фона. И в цикле обработки сообщений отрисовываем нашу сцену.

С наступившим новым годом, друзья!

Updated 01.01.2012

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

В заметке используется слово "лисп", которое означает словосочетание "common lisp" :)

Максима умеет математику решать в символьном виде.

Как я уже говорил, Максиму на данный момент лучше взять в моем репозитарии ветку quicklisp:

git clone http://github.com/filonenko-mikhail/embeddable-maxima
git checkout quicklisp

 git remote add fm_github http://github.com/filonenko-mikhail/embeddable-maxima.git
 git fetch --depth 1 fm_github quicklisp:refs/remotes/quicklisp
 git checkout -b quicklisp --track fm_github/quicklisp

Максима представляет отдельный язык для работы с математическими сущностями. Он очень напоминает то, что вы пишете на бумаге при решении какой-нибудь задачки. Все было бы хорошо, если бы математика содержала только декларативную часть. Например, мы могли использовать квадратный корень (sqrt) без необходимости создания методов вычисления этой функции для конретных чисел. Конечно есть ситуации, когда вычисление значения функции не имеет необходимости, так как она сокращается на одном из шагов решения задачи, однако это всего лишь часть всех случаев использования функции. Поэтому кроме того, что язык Максимы содержит декларативную часть математики, он еще и содержит все конструкции построения программ (или алгоритмов), а именно циклы и условные переходы. Так как максима написана на языке Лисп, то и получившийся язык очень похож на лисп. Я бы даже сказал, что язык Максима - это Лисп с инфиксной нотацией, ну и небольшим синтаксическим сахаром.

Кстати, вот экономический вопрос: что дешевле: научить пользователей предметно-ориентированному языку или подмножеству функций и конструкций хост-языка? Может проще научить математиков префиксной нотации, чем запиливать под них трансляторы, интепретаторы, компиляторы?

Теперь, собственно, код. Все выражение вводимые в Максиму транслируются в AST. AST - это дерево. Дерево в Лиспе представляется списками, элементы которых могут быть списками. Затем данное дерево интерпретируется так, как это реализовано в Максиме. Таким образом, кстати, реализован движок cl-closure-templates, где на основе AST, получаемого при разборе шаблона, генерируется лисповый генератор и с помощью parenscript javascript'овый.

Решение СЛАУ на Лиспе

Запуск окружения, все как обчыно:

emacs
 M+x slime
  (pushnew "/path/to/maxima/" asdf:*central-registry*)
  (ql:quickload :embeddable-maxima)
  ;; переходим в пакет максимы так как из нее ничего не экспортируется
  (in-package :maxima)

Допустим у нас есть список уравнений на языке Максима:

[2*x + y - z = 8, -3*x - y + 2*z = -11, -2*x + y + 2*z = -3]

#$[2*x + y - z = 8, -3*x - y + 2*z = -11, -2*x + y + 2*z = -3]$

((MLIST SIMP)
 ((MEQUAL SIMP) ((MPLUS SIMP) ((MTIMES SIMP) 2 $X) $Y ((MTIMES SIMP) -1 $Z)) 8)
 ((MEQUAL SIMP)
  ((MPLUS SIMP) ((MTIMES SIMP) -3 $X) ((MTIMES SIMP) -1 $Y)
   ((MTIMES SIMP) 2 $Z))
  -11)
 ((MEQUAL SIMP) ((MPLUS SIMP) ((MTIMES SIMP) -2 $X) $Y ((MTIMES SIMP) 2 $Z))
  -3))

($solve #$[2*x + y - z = 8, -3*x - y + 2*z = -11, -2*x + y + 2*z = -3]$)

((MLIST) ((MLIST) ((MEQUAL) $Z -1) ((MEQUAL) $Y 3) ((MEQUAL) $X 2)))

(displa '((MLIST) ((MLIST) ((MEQUAL) $Z -1) ((MEQUAL) $Y 3) ((MEQUAL) $X 2))))

[[z = - 1, y = 3, x = 2]]

MLIST - является списком
SIMP - упрощено. (FIXME?)
MEQUAL - равенство из двух элементов
MPLUS - сумма
MTIMES - произведение
MDEFINE - определение функции
MPROGN - progn
$SOME_FUNCTION - вызов функции SOME_FUNCTION
....

Вызов функции определенной во время работы Максимы рекомендуют делать через mfuncall, однако функция $solve определена в Лиспе в исходниках, поэтому ее можно вызвать, как регулярную.

Теперь вы можете использовать чистый Лисп для символьных вычислений. Один способ, использовать макрос #$expr$ и функцию displa, другой - имитировать максимовскую AST с помощью обычных списков.

Дифференцирование в Лиспе

Давайте найдем производную функции:

1/3*x^3 + 1/2*x^2 + 1

Для этого используется функция diff.

($diff #$1/3*x^3 + 1/2*x^2 + 1$ #$x$)

((MPLUS SIMP) $X ((MEXPT SIMP) $X 2))

Или же в более читабельном виде:

(displa '((MPLUS SIMP) $X ((MEXPT SIMP) $X 2)))

 2
x  + x

Интегрирование в лиспе

Интеграл от предыдущей функции:

x^2 + x

Функция integrate:

($integrate #$x^2 + x$ #$x$)

((MPLUS SIMP) ((MTIMES SIMP) ((RAT SIMP) 1 2) ((MEXPT SIMP) $X 2))
 ((MTIMES SIMP) ((RAT SIMP) 1 3) ((MEXPT SIMP) $X 3)))

Читабельный вид:

(displa '((MPLUS SIMP) ((MTIMES SIMP) ((RAT SIMP) 1 2) ((MEXPT SIMP) $X 2))
 ((MTIMES SIMP) ((RAT SIMP) 1 3) ((MEXPT SIMP) $X 3))))

 3    2
x    x
-- + --
3    2

Кстати не отобразил свободный член (+C). Данная константа появляется при использовании равенства, а не выражения.

(displa ($integrate #$x^2 = - x$ #$x$))

 3          2
x          x
-- = %c2 - --
3          2

Вспомогательные материалы из справки Максима

(msetq $foo #$[x, y]$)
<=>
(%i1) foo: [x, y];

(%i1) :lisp #$[x, y, z]$
((MLIST SIMP) $X $Y $Z)
(%i1) :lisp (displa ’((MLIST SIMP) $X $Y $Z))
[x, y, z]
NIL

(%i1) foo(x,y) := x*y$
(%i2) :lisp (mfuncall ’$foo ’a ’b)
((MTIMES SIMP) A B)

complement   continue    //      
float        functionp   array   
exp          listen      signum  
atan         asin        acos    
asinh        acosh       atanh   
tanh         cosh        sinh    
tan          break       gcd     

Функция solve

solve (expr, x)
solve (expr)
solve ([eqn 1, . . . , eqn n], [x 1, . . . , x n])

Решает алгебраическое уравнение expr для переменной x и возвращает список решений. Если expr не является уравнение, предполагается равенство его нулю expr = 0. x может являтся функцией (например: f(x)) или другим не-атомным выражением, кроме суммы или произведения. x может быть опущен, если expr содержит только одну переменную. expr может быть рациональным выражение и может содержать тригонометрические функции, экспонентциальные и т.п.

solve ([eqn 1, ..., eqn n], [x 1, ..., x n]) решает системы simultaneuos (совместных?) (линейных и нелинейных) полиноминальных уравнений с помощью функций linsolve или algsolve и возвращает список решений. Функция принимает два аргумента. Первый - это список уравнений. Второй - список неизвестных переменных. Если число неизвестных совпадает со числом уравнений, второй аргумент может быть опущен.

Неспешно ищу работу коммонлиспером. Могу всякое незаумное.

За плечами:

• Небольшая учетная система для автошколы (postgresql (plpgsql), Qt/c++, common lisp, windows) (2 года).
• Небольшая система планирования для гражданской авиации (oracle, Qt/c++, windows) (1,5 лет).

Могу работать удаленно, могу приехать.

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

Можно на неполный рабочий день.

filonenko.mikhail at gmail com

Отрефакторил тут намедни максиму. Удалил mk:defsystem, оставил только asdf. Сделал on-fly fortran->cl компиляцию (спасибо, f2cl/packages/*.asd). Добавил внешних зависимостей доступных из quicklisp.

Ссылка: https://github.com/filonenko-mikhail/maxima

Теперь максима доступна так:

git clone --depth 1 https://filonenko-mikhail@github.com/filonenko-mikhail/embeddable-maxima.git
emacs
m+x slime
(pushnew "/path/to/maxima/" asdf:*central-registry*)
(ql:quickload :embeddable-maxima)
(cl-user::run)
  run_testsuite();

Основная цель сделать максиму более встраиваемой.

Для интернационализации будем использовать cl-l10n. Внимание, документация на сайте проекта устарела!

Загрузка:

(ql:quickload '#:cl-l10n)

Создание словарей:

(use-package :cl-l10n)

(defresources "ru_RU" 
  ("Hello" "Привет")
  ("world" "мир"))

(defresources "fr_FR" 
  ("Hello" "Bonjour")
  ("world" "monde"))

Включение макроридера для переводимых строк:

(enable-sharpquote-reader)

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

(with-locale (locale "ru_RU")
  (format nil "~a, ~a" #"Hello" #"world"))
"Привет, мир"

(with-locale (locale "fr_FR")
  (format nil "~a, ~a" #"Hello" #"world"))
"Bonjour, monde"

Для restas

Минимальные словари:

(cl-l10n:defresources "ru_RU"
  ("language" "Русский"))

(cl-l10n:defresources "fr_FR"
  ("language" "Française"))

(cl-l10n:defresources "en_US"
  ("language" "English"))

Роут переключающий локаль: сохраняет ее в сессии, и перенаправляет на предыдущую страницу:

(restas:define-route change-locale ("change-locale")
  (let ((done (hunchentoot:parameter :|done|)))
    (setf (hunchentoot:session-value :locale)
          (hunchentoot:parameter :|locale|))
    (restas:redirect (if done done "/"))))                                    

Генератор меню выбора языка. Список локалей представлен в последней строке:

(defun generate-language-menu ()
  (let ((current-locale (if (hunchentoot:session-value :locale)
                            (hunchentoot:session-value :locale)
                            "en_US")))
    (mapcar (lambda (locale-name)
              (cl-l10n:with-locale (cl-l10n:locale locale-name)
                (if (string= current-locale
                             locale-name)
                    (list
                     :data #"language")
                    (list :href (restas:genurl 'change-locale
                                               :locale locale-name
                                               :done (hunchentoot:request-uri*))
                          :data #"language"))))
            '("ru_RU" "en_US" "fr_FR"))))

Примерный вывод предыдущей функции:

((:HREF "/change-locale?locale=ru_RU&done=/index.html" :DATA "Русский")
 (:DATA "English")
 (:HREF "/change-locale?locale=fr_FR&done=/index.html" :DATA "Française"))

closure-templates шаблон:

<div id=language-menu>
  {foreach $locale in $locales}
    {if $locale.href}
      <a href={$locale.href}>{$locale.data}</a>
    {else}
      {$locale.data}
    {/if}
  {/foreach}
</div>

Декоратор для выполнения роута в контексте некоторой локали, по-умолчанию en_US:

(defclass localize (routes:proxy-route) ())

(defmethod restas:process-route ((route localize) bindings)
  (let ((locale (hunchentoot:session-value :locale)))
    (cl-l10n:with-locale (cl-l10n:locale (if locale locale "en_US"))
      (call-next-method))))

(defun @localize (origin)
  (make-instance 'localize :target origin))

Примерное использование декоратора:

(cl-l10n:enable-sharpquote-reader)
(restas:define-route index ("index.html" :decorators '(@localize))
  "Main page"
  (list :title #"Maxima web interface"
        :execute-title #"Execute"))

В то время, как ребята из остальных тусовок всячески пишут виртуальные машины на javascript, а я, как минимум, помню:

• assembler x86
• erlang
• clojure

• JavaScript
• PostScript
• PDF
• Ассемблер
• Objective-J
• Haskell
• Prolog
• ioctl[123]
• Cat
• Scheme
• BASIC
• Lily
• Forth
• PHP,

Итак Parenscript - это транслятор из расширенного подмножества Common Lisp в JavaScript. Parenscript код может работать почти одинаково в окружении броузера (в JavaScript) и сервера (в Common Lisp).

Parenscript код пишеться также, как и Common Lisp код, тем самым мощь макросов становится доступна и в JavaScript.

Особенности Parenscript.

• Никаких зависимостей сгенерированного JavaScript от других библиотек.
• Использование родных JavaScript типов.
• Сгенерированный код JavaScript можно использовать в другом несгенерированном JavaScript.
• Читабельный код, форматирование.
• Скорость сгенерированного кода почти такая же как и hand-made кода.

Перевел документацию по библиотеке:
http://lisper.ru/wiki/libraries%3Aparenscript

Updated 07.12.12

Появилась у меня задача: вывести простенький отчет на печать. Покалебавшись между Qt (textedit, webkit), cl-gtk2 и cl-pdf/cl-closure-template, restas и cl-closure-template, я выбрал последнее.

Qt удобен и быстр в разработке, но неудобен в размещении на нескольких клиентских компьютерах, быстрой кастомизации приложения. И даже использование QtScript не решает проблем.

cl-gtk2 и cl-pdf - интересно, но также не решают проблем распространения, статическая объектная модель gtk создает препятствия к наследованию в cl, необходимо писать обертку для pdf/html рендера вручную, или через gir.

Самая интересность заключалась в том, что все должно было работать из-под windows.

Подробно о том, как установить cl в windows:http://habrahabr.ru/blogs/lisp/131418/.

Вкратце:

• Скачать sbcl https://github.com/akovalenko/sbcl-win32-threads/wiki и установить
• Скачать quicklisp.lisp.

sbcl
(load "quicklisp.lisp")
(quickstart:install)
(quit)
sbcl
(ql:add-to-init-file)
(ql:quickload :swank)
(ql:quickload :quicklisp-slime-helper)

• Скачать и установить emacs: http://ftp.gnu.org/pub/gnu/emacs/windows/
• Добавить в $HOME/.emacs

    (load (expand-file-name "~/quicklisp/slime-helper.el"))
    ;; Replace "sbcl" with the path to your implementation
    (setq inferior-lisp-program "sbcl")

• Если вы используете utf-8 кодировку в файлах, в $HOME/.sbclrc добавить

  (setf sb-impl::*default-external-format* :utf-8)

restas-directory-publisher использует iolib, однако данная библиотека не работает под windows. Для решения небольшой части проблем есть неофициальный форк для windows: http://src.knowledgetools.de/tomas/winapi/index.html.

Определите переменную среды CL_SOURCE_REGISTRY, и задайте ей следующее значение:

(:source-registry (:tree "your/path/to/lisp/libraries") :inherit-configuration)

Перейдите в директорию с библиотеками и скачайте нужную версию iolib

cd "your/path/to/lisp/libraries"
git clone --depth 1 http://src.knowledgetools.de/tomas/winapi/iolib.git

Осталось проверить минимальную работоспособность restas.

sbcl
(ql:quickload :restas)
(restas:define-module #:restas.hello-world
  (:use :cl))
(in-package #:restas.hello-world)
(restas:define-route main ("")
  "<h1>Hello windows world!</h1>")
(restas:start '#:restas.hello-world :port 8080)

Теперь в windows xp i386, windows 7 x86_64 можно совершать разбойные нападения с целью завладения чужим имуществом, в частности, на караваны.

P.S. Листинг директории в restas-direcory-publisher сейчас не содержит дат и размеров файлов.

А я напоминаю, что для подключения роутов restas сайта к postgresql базе данных служит такой механизм, как декораторы.

Действия такие:
Создаем класс унаследованный от routes:proxy-route.
Переопределяем для него метод restas:process-route, в котором:
  подключаемся к базе, и в этом контексте
    вызываем базовый метод routes:proxy-route.
Создаем функцию, возвращающую экземпляр данного класса.

Например:

• *pgname* Имя БД
• *pguser* Пользователь
• *pgpassword* Пароль
• *pghost* Сервер
• *pgschema* Имя схемы
• *company-name* Будет содержать комментарий для схемы *pgschema*

(defclass pg-connection-route (routes:proxy-route) ())

(defmethod restas:process-route ((route pg-connection-route) bindings)
  (postmodern:with-connection (list *pgname* *pguser* *pgpassword* *pghost*)
    (postmodern:execute (format nil "set search_path=~a,public" *pgschema*))
    (let* ((*company-name* (postmodern:query "select description from pg_description join pg_namespace on objoid = oid and nspname = $1" *pgschema* :single)))
      (call-next-method))))

(defun @pg-connection (route)
  (make-instance 'pg-connection-route :target route))

Здесь кроме подключения, мы устанавливает в sql переменную search_path список тех схем базы данных, в которых в будущем будет производится поиск таблиц.

Использование:

(restas:define-route choose-client ("choose-client"
                                    :decorators '(@pg-connection))
  (list :rows
         (postmodern:query "select 12 'test'")
        :title "select"))

Маленький совет тем, кто сбрасывает вывод postmodern:query в cl-closure-templates. SQL тип NULL postmodern конвертирует в keyword :null, который cl-closure-templates интерпретирует как строку NULL. Для того чтобы вывести вместо NULL пустую строку, достаточно использовать if/then в шаблоне, например так:

....
{if $column}
  {$column}
{/if}
.....

или так

{$column ? $column : ' '}

Вобщем-то :null при исполнении шаблона автоматически вычисляется в false.

Кроме того, если вы передаете (postmodern:query (select 1 as some_column) :alist) в closure-template, то добраться до колонки очень просто. По умолчанию postmodern конвертирует имена столбцов в keyword-ы с преобразованием подчеркивания в дефис, а closure-template в свою очередь camel нотацию преобразует в cl нотацию с дефисами. Итак, если вы используете столбец some_column, то переменная в шаблоне выглядеть будет так: someColumn.

postgres    -> common lisp  -> cl-closure-template
some_column -> :some-column -> someColumn.

Речь сегодня пойдет о том, что CL очень даже автоматизирует "бытовуху".Инфляция в РБ составила не менее 80% за год. Можно долго обсуждать с чем это связано, но лучше от этого не станет. До этого момента все мелко-крупные импортеры и без того все свои цены вычисляли в долларах, а теперь сюда еще и подтягиваются остальные участники белоруского "чуда".

Есть частное предприятие, оказывающее услуги населению и решившее, что цена часа услуги будет стоить 0.2 доллара. И теперь сответственно нужен журнал курсов валют. БД: postgresql, имеется доступ к интернету.

Задача: наладить sql таблицу postgresql, которая будет содержать данные о курсе доллара и автоматически добавлять в нее данные каждый день.

Создание журнала в БД postgresql с помощью postmodern:

(ql:quickload :postmodern)
(postmodern:connect-top-level "school" "user" "user" "localhost")
(postmodern:query "create table if not exists journal_currency_exchange (
                               _date date primary key,
                               _value decimal(10,2))")

S-sql это интересно, но для повседневной разработки визуальное разделение на хост язык и sql запросы благоразумнее.

Теперь необходимо этот журнал заполнить данными об изменениях курсов валют. Мне повезло: nbrb.by предоставляет xml-ку на запрос по некоторому url-у. Подробнее здесь: http://nbrb.by/statistics/Rates/XML/

Получение курсов доллара к белорусскому рублю за последний месяц, с помощью cl http клиента drakma.

Основной url: http://nbrb.by/Services/XmlExRatesDyn.aspx
Параметры:
curId - внутренний идентификатор валюты
fromDate, toDate - период для отчета

(ql:quickload :drakma)
(defvar xml-response (drakma:http-request "http://nbrb.by/Services/XmlExRatesDyn.aspx?curId=145&fromDate=11/1/2011&toDate=11/30/2011"))

Теперь необходимо разобрать полученную строку. Для этого есть cl xml парсер xmls:

CL-USER> (defvar parsed-xml (xmls:parse xml-response))
PARSED-XML 
CL-USER> parsed-xml
("Currency" (("toDate" "11/30/2011") ("fromDate" "11/01/2011") ("Id" "145"))
 ("Record" (("Date" "11/01/2011")) ("Rate" NIL "8450"))
 ("Record" (("Date" "11/02/2011")) ("Rate" NIL "8530"))
 ("Record" (("Date" "11/03/2011")) ("Rate" NIL "8580"))
 ("Record" (("Date" "11/04/2011")) ("Rate" NIL "8650"))
 ("Record" (("Date" "11/05/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/06/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/07/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/08/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/09/2011")) ("Rate" NIL "8700"))
 ("Record" (("Date" "11/10/2011")) ("Rate" NIL "8790"))
 ("Record" (("Date" "11/11/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/12/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/13/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/14/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/15/2011")) ("Rate" NIL "8770"))
 ("Record" (("Date" "11/16/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/17/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/18/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/19/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/20/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/21/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/22/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/23/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/24/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/25/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/26/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/27/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/28/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/29/2011")) ("Rate" NIL "8640"))
 ("Record" (("Date" "11/30/2011")) ("Rate" NIL "8600")))

Теперь надо занятся тем, для чего лисп Маккарти и придумывал - обработкой списков. Фильтруем, оставляя только Record:

CL-USER> (defvar ya-parsed-xml (remove-if-not (lambda (value) (and (listp value) (stringp (car value)) (string= (car value) "Record"))) parsed-xml))
(("Record" (("Date" "11/01/2011")) ("Rate" NIL "8450"))
 ("Record" (("Date" "11/02/2011")) ("Rate" NIL "8530"))
 ("Record" (("Date" "11/03/2011")) ("Rate" NIL "8580"))
 ("Record" (("Date" "11/04/2011")) ("Rate" NIL "8650"))
 ("Record" (("Date" "11/05/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/06/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/07/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/08/2011")) ("Rate" NIL "8750"))
 ("Record" (("Date" "11/09/2011")) ("Rate" NIL "8700"))
 ("Record" (("Date" "11/10/2011")) ("Rate" NIL "8790"))
 ("Record" (("Date" "11/11/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/12/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/13/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/14/2011")) ("Rate" NIL "8850"))
 ("Record" (("Date" "11/15/2011")) ("Rate" NIL "8770"))
 ("Record" (("Date" "11/16/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/17/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/18/2011")) ("Rate" NIL "8760"))
 ("Record" (("Date" "11/19/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/20/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/21/2011")) ("Rate" NIL "8740"))
 ("Record" (("Date" "11/22/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/23/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/24/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/25/2011")) ("Rate" NIL "8720"))
 ("Record" (("Date" "11/26/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/27/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/28/2011")) ("Rate" NIL "8670"))
 ("Record" (("Date" "11/29/2011")) ("Rate" NIL "8640"))
 ("Record" (("Date" "11/30/2011")) ("Rate" NIL "8600")))

Сокращаем полученное дерево до списка с элементами (дата значение):

CL-USER> (defvar data (mapcar (lambda (value) (list (nth 1 (nth 0 (nth 1 value))) (nth 2 (nth 2 value)))) ya-parsed-xml))
(("11/01/2011" "8450") ("11/02/2011" "8530") ("11/03/2011" "8580")
 ("11/04/2011" "8650") ("11/05/2011" "8750") ("11/06/2011" "8750")
 ("11/07/2011" "8750") ("11/08/2011" "8750") ("11/09/2011" "8700")
 ("11/10/2011" "8790") ("11/11/2011" "8850") ("11/12/2011" "8850")
 ("11/13/2011" "8850") ("11/14/2011" "8850") ("11/15/2011" "8770")
 ("11/16/2011" "8760") ("11/17/2011" "8760") ("11/18/2011" "8760")
 ("11/19/2011" "8740") ("11/20/2011" "8740") ("11/21/2011" "8740")
 ("11/22/2011" "8720") ("11/23/2011" "8720") ("11/24/2011" "8720")
 ("11/25/2011" "8720") ("11/26/2011" "8670") ("11/27/2011" "8670")
 ("11/28/2011" "8670") ("11/29/2011" "8640") ("11/30/2011" "8600"))

Записываем в базу данных. Postgresql по умолчанию ожидает дату в формате dmy, функция to_date служит для явного задания формата даты mdy:

(mapcar (lambda (value) (postmodern:query 
                                  "insert into journal_currency_exchange(_date, _value) values (to_date($1, 'mm/dd/yyyy'), $2)" (car value) (cadr value))) data) 

Осталось все это оформить в функции и обернуть потоком. Думаю не стоит на этом заострять внимание.

P.S. Может кто-то уже делал систему построения отчетов на CL?

Я тут в очередной раз мучался с cxml-stp, closure-html, plexippus-xpath, и вдруг обнаружил совершенно другой подход. И почему я раньше не знал про cl-libxml2, как вообще всё может быть проще с парсингом:

LOOT> (ql:quickload '(:cl-libxml2))
To load "cl-libxml2":
  Load 1 ASDF system:
    cl-libxml2
; Loading "cl-libxml2"

(:CL-LIBXML2)
LOOT> (html:with-parse-html (page #u"http://www.sbcl.org/platform-table.html")
  (xpath:find-string page "/html/body/div/pre"))
"git clone git://sbcl.git.sourceforge.net/gitroot/sbcl/sbcl.git"
LOOT> (defun run-many-find-string ()
  (html:with-parse-html (page #u"http://www.sbcl.org/platform-table.html")
    (time
     (dotimes (i 10000)
       (xpath:find-string page "/html/body/div/pre")))))
RUN-MANY-FIND-STRING

И скорость просто фантастика:

LOOT> (run-many-find-string)
Evaluation took:
  0.851 seconds of real time
  0.848053 seconds of total run time (0.816051 user, 0.032002 system)
  [ Run times consist of 0.004 seconds GC time, and 0.845 seconds non-GC time. ]
  99.65% CPU
  1,868,092,138 processor cycles
  22,880,088 bytes consed

В этой небольшой статье я попытаюсь написать граббер, преобразовывая html в списки и выполняя поиск методом обхода списков.

Используем в качестве примера страничку Download - Steel Bank Common Lisp. Для упрощения задачи скачаем её и положим в test.html. Предположим, что нам нужно выдрать со странички строку “git clone git://sbcl.git.sourceforge.net/gitroot/sbcl/sbcl.git”.

(ql:quickload '(:iterate :split-sequence :cl-html-parse))

(defpackage :loot
  (:use :common-lisp
        :iter
        :split-sequence))

(in-package :loot)

(defparameter *all-html* (html-parse:parse-html #p"test.html"))

В переменную *all-html* будет сохранён лиспизированный html-код:

      
((:!DOCTYPE
  " HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\"")
 (:HTML
  (:HEAD (:TITLE "Download - Steel Bank Common Lisp")
   ((:LINK :REL "stylesheet" :TYPE "text/css" :HREF "sbcl.css"))
   ((:META :HTTP-EQUIV "Content-Type" :CONTENT "text/html;charset=utf-8")))
  (:BODY ((:DIV :CLASS "header") (:H1 "Steel Bank Common Lisp"))
   ((:DIV :CLASS "sidebar")
    (:UL (:LI ((:A :HREF "index.html") "About"))
     (:LI ((:A :HREF "news.html") "News"))
     (:LI ((:A :HREF "platform-table.html") "Download"))
     (:LI ((:A :HREF "getting.html") "Getting Started"))
     (:LI ((:A :HREF "history.html") "History and Copyright"))
     (:LI ((:A :HREF "porting.html") "Porting"))
     (:LI ((:A :HREF "keys.html") "Maintainer public keys"))
     (:LI ((:A :HREF "manual/index.html") "Manual"))
...
      

Для упрощения поиска по спискам превратим дерево в список (функция flatten скопирована без изменений из книги On Lisp)

(defun flatten (x)
  (labels ((rec (x acc)
             (cond ((null x) acc)
                   ((atom x) (cons x acc))
                   (t (rec (car x) (rec (cdr x) acc))))))
    (rec x nil)))

А теперь очередь за функцией find-tag, которая ищет необходимый тег:

(defun find-tag (html rules)
  (cond ((null rules) (car html))
        ((eq (car html) (car rules)) (find-tag (cdr html) (cdr rules)))
        (t (find-tag (cdr html) rules))))

Запускаем:

LOOT> (defparameter *rules* '(:html :body :div :pre))
*RULES*
LOOT> (find-tag (flatten *all-html*) *rules*)
"git clone git://sbcl.git.sourceforge.net/gitroot/sbcl/sbcl.git"

На самом деле пример синтетический, и возможно find-tag будет работать не для всех случаев (+ незабываем про некрасивую рекурсию, которая в функции получилась). Добавим пару функций для проверки эффективности работы данного метода:

(defun run-many-find-tag ()
  (time
   (dotimes (i 10000)
     (find-tag (flatten *all-html*) *rules*))))

(defun profile-find-tag ()
  ;; Don't accumulate results between runs.
  (sb-profile:reset)
  ;; Calling this every time through in case any of the user-defined
  ;; functions was recompiled.
  (sb-profile:profile find-tag flatten)
  (run-many-find-tag)
  (sb-profile:report))

А теперь посмотрим насколько оно “оптимально”:

LOOT> (profile-find-tag)

Evaluation took:
  3.701 seconds of real time
  3.672230 seconds of total run time (2.152135 user, 1.520095 system)
  [ Run times consist of 0.188 seconds GC time, and 3.485 seconds non-GC time. ]
  99.22% CPU
  8,120,250,534 processor cycles
  1 page fault
  251,795,280 bytes consed
  
measuring PROFILE overhead..done
  seconds  |     gc     |    consed   |   calls   |  sec/call  |  name  
-------------------------------------------------------------
     0.313 |      0.008 |  73,815,800 |    10,000 |   0.000031 | FLATTEN
     0.000 |      0.180 | 175,403,624 | 1,380,000 |   0.000000 | FIND-TAG
-------------------------------------------------------------
     0.313 |      0.188 | 249,219,424 | 1,390,000 |            | Total

estimated total profiling overhead: 3.19 seconds
overhead estimation parameters:
  8.000001e-9s/call, 2.2959998e-6s total profiling, 1.064e-6s internal profiling
; No value

Но что если мы будем искать тег, которого не существует, чем вынудим find-tag пройтись по всему списку:

LOOT> (let ((*rules* '(:no-tag)))
        (profile-find-tag))
WARNING: FIND-TAG is already profiled, so unprofiling it first.
WARNING: FLATTEN is already profiled, so unprofiling it first.
Evaluation took:
  25.785 seconds of real time
  23.737483 seconds of total run time (13.224826 user, 10.512657 system)
  [ Run times consist of 1.540 seconds GC time, and 22.198 seconds non-GC time. ]
  92.06% CPU
  56,586,611,510 processor cycles
  456 page faults
  1,258,993,224 bytes consed
  
  seconds  |     gc     |     consed    |   calls   |  sec/call  |  name  
---------------------------------------------------------------
     0.309 |      0.000 |    73,819,008 |    10,000 |   0.000031 | FLATTEN
     0.000 |      1.540 | 1,182,643,568 | 9,240,000 |   0.000000 | FIND-TAG
---------------------------------------------------------------
     0.309 |      1.540 | 1,256,462,576 | 9,250,000 |            | Total

estimated total profiling overhead: 21.24 seconds
overhead estimation parameters:
  8.000001e-9s/call, 2.2959998e-6s total profiling, 1.064e-6s internal profiling
; No value

Опа, потребление памяти выросло в 4 раза аж до ~1.2 Gb, а реальное время выполнения с 3 секунд подскочило до 25. И всё это на такой маленькой страничке. Ускорить выполнение кода и уменьшить количество потребляемой памяти можно отказавшись от списков и использовав другие структуры данных. Думаю, если использовать cxml-stp, скорость должна возрости. Вопрос в другом: нужно ли всё это, ведь грабить одну страничку 10 тысяч раз никто не будет, скорее будут грабить 10 тысяч страниц по одному разу, и тогда всё упрётся в скорость ввода-вывода. Если будет время, то попытаюсь в скором времени описать, как я делал тоже самое с помощью cxml-stp.

nponeccop

104.72.221.173,220.57.219.35
16.65.26.150,133.42.154.151
80.241.37.220,93.109.90.13
35.165.212.97,105.166.11.16
122.143.149.115,246.17.13.31
20.44.170.80,144.105.12.169
122.132.114.84,184.165.60.95
102.111.151.45,120.152.236.26
53.252.70.24,171.51.24.110
101.103.12.180,224.55.178.136

(in-package :ip-ranges)
(gen-test-proc
  "104.72.221.173,220.57.219.35"
  "16.65.26.150,133.42.154.151"
  "80.241.37.220,93.109.90.13"
  "35.165.212.97,105.166.11.16"
  "122.143.149.115,246.17.13.31"
  "20.44.170.80,144.105.12.169"
  "122.132.114.84,184.165.60.95"
  "102.111.151.45,120.152.236.26"
  "53.252.70.24,171.51.24.110"
  "101.103.12.180,224.55.178.136"
)

(defun preprocess-ranges-file (filename)
  (let ((lisp-file (format nil "~a.lisp" filename)))
    (with-open-file (f-in filename)
      (with-open-file (f-out lisp-file
                             :direction :output
                             :if-exists :supersede
                             :if-does-not-exist :create
                             :external-format :ascii)
        (format f-out "(in-package :ip-ranges)~%(gen-test-proc~%")
        (iter (for range in-stream f-in using #'read-line)
              (format f-out "  \"~a\"~%" range))
        (format f-out ")~%~%")))
    lisp-file))

(defpackage #:ip-ranges
  (:use :cl :iterate :metatilities)
  (:shadowing-import-from :metatilities #:minimize #:finish)
  (:export #:check))

(in-package :ip-ranges)

(defun extract-values (string)
  (unless (zerop (length string))
    (multiple-value-bind (value rest-index)
        (parse-integer string :junk-allowed t)
      (if value
          (cons value (extract-values (subseq string rest-index)))
          (extract-values (subseq string 1))))))

IP-RANGES> (extract-values "104.72.221.173,220.57.219.35")
(104 72 221 173 220 57 219 35)

(defun ip-range (range-string)
  (let ((values (extract-values range-string))
        (vars '(ip-0 ip-1 ip-2 ip-3)))
    (assert (= (length values) 8))
    (labels ((stairs (cmp values vars)
               (if (null values)
                   t
                   `(or (,cmp ,(car vars) ,(car values))
                        (and (= ,(car vars) ,(car values))
                             ,(stairs cmp (cdr values) (cdr vars)))))))
      `(and ,(stairs '> (subseq values 0 4) vars)
            ,(stairs '< (subseq values 4 8) vars)))))

IP-RANGES> (ip-range "104.72.221.173,220.57.219.35")
(AND
 (OR (> IP-0 104)
     (AND (= IP-0 104)
          (OR (> IP-1 72)
              (AND (= IP-1 72)
                   (OR (> IP-2 221)
                       (AND (= IP-2 221)
                            (OR (> IP-3 173) (AND (= IP-3 173) T))))))))
 (OR (< IP-0 220)
     (AND (= IP-0 220)
          (OR (< IP-1 57)
              (AND (= IP-1 57)
                   (OR (< IP-2 219)
                       (AND (= IP-2 219)
                            (OR (< IP-3 35) (AND (= IP-3 35) T)))))))))

(defmacro gen-test-proc (&rest ranges)
  `(defun ip-check (ip-0 ip-1 ip-2 ip-3)
     (or ,@(mapcar #'ip-range ranges))))

(defun check (ip-string)
  (apply #'ip-check (extract-values ip-string)))

IP-RANGES> (load (compile-file (preprocess-ranges-file #p"ranges.list")))
; compiling file "/home/swizard/devel/lisp/ip-ranges/ranges.list.lisp" (written 03 NOV 2011 11:16:02 PM):
; compiling (IN-PACKAGE :IP-RANGES)
; compiling (GEN-TEST-PROC "104.72.221.173,220.57.219.35" ...)

; /home/swizard/devel/lisp/ip-ranges/ranges.list.fasl written
; compilation finished in 0:00:00.045
T
IP-RANGES> (check "192.168.0.1")
T
IP-RANGES> (check "10.0.0.0")
NIL

• Расставили скобки вокруг списка ip-диапазонов.
• Сгенерировали по описанию функцию ip-check, решающую задачу.
• ...
• Profit!

• Несмотря на константные проверки и восьмибитную сегментацию адреса, у нас получилась последовательная проверка.
• Несмотря на автоматическую генерацию условия по диапазону, это условие генерируется какое-то кривоватое и сильно избыточное.
• Несмотря на то, что какие-то диапазоны проверять нет смысла, так как они "поглощаются" более широкими, все равно проверяются все.
• По условиям задачи диапазонов могут быть сотни: поэтому код надо сегментировать по функциям, чтобы не нагнуть компилятор при стратегии (optimize (speed 3))

1. Собственно наш мусорщик менее технологичный, нежели в JVM. Как минимум, он не параллельный и, вообще, при сборке отважно накладывает глобал-лок на весь процесс.
2. При всех несомненных плюсах GC, мне непонятно, почему в CL нет богатых возможностей по ручному управлению памятью.

* (defparameter *counter* 1)
* (defun inc-counter ()
    (incf *counter*))
* (bordeaux-threads:make-thread (lambda () (inc-counter)))
* *counter*
2

* (bordeaux-threads:make-thread (lambda () (let ((*counter* 0)) (inc-counter))))
* *counter*
2

;; BOGUS
(setf temp a)
(setf a b)
(setf b temp)

(psetf a b b a)

(rotatef a b)

* (with-output-to-string (*standard-output*) 
    (print-marketing-report))
"Source,Hits
twitter,243
google,805
direct,47
"

* (with-open-file (*standard-output* #p"file.txt" :direction :output)
    (print-marketing-report))
NIL

* (/ 22.0 7.0)
3.142857

* (setf *read-default-float-format* 'double-float)
DOUBLE-FLOAT

* (/ 22.0 7.0)
3.142857142857143

;; BOGUS
(close (open "foo.txt" :direction :output 
             :if-does-not-exist :create 
             :if-exists :append))

(open "foo.txt" :direction :probe :if-does-not-exist :create)

* (format t "It was the best of times, ~
             it was the worst of times.")
It was the best of times, it was the worst of times.

(- (char-int char) (char-int #\0))

* (digit-char-p #\7)
7

* (digit-char-p #\a 16)
10

(defun parse-date (string)
  "Parse a date string in the form YYYY-MM-DD and return the
   year, month, and day as multiple values."
  (values (parse-integer string :start 0 :end 4)
          (parse-integer string :start 5 :end 7)
          (parse-integer string :start 8 :end 10)))

(< a b c d)

(apply #'< list)

(every #'string= list (rest list))

* (apply #'/= list)
T

* (every #'/= list (rest list))
T

(dolist (users (get-user-list)) 
  :retry
  ...
  (when some-condition
    (go :retry)
  ...)

1+1;
2+5/0;
wxplot2d(sin(x),[x,0,2]);
sin(x);
12345$
"some string";

^B^W\%o2^W2^E
^C(%i3) ^D
expt: undefined: 0 to a negative exponent.
 -- an error. To debug this try: debugmode(true);
^C(%i4) ^D
^B^W\%t4^W^Gmaxout_1.png^G^E
^B^W\%o4^W^E
^C(%i5) ^D
^B^W\%o5^W\sin x^E
^C(%i6) ^D
^C(%i7) ^D
^B^W\%o7^W\verb|some string|^E
^C(%i8) ^D

^B^W\%o2^W2^E

^C(%i3) ^D

^B^W\%t4^W^Gmaxout_1.png^G^E

expt: undefined: 0 to a negative exponent.
 -- an error. To debug this try: debugmode(true);

Правила

(defrule expressions (* expression)
  (:lambda (list)
    list))

(defrule expression (and (? whitespace) (or out in simpletext))
  (:destructure (w exp)
    (declare (ignore w))
    exp))

(defrule whitespace (+ (or #\space #\tab #\newline))
  (:constant nil))

(defrule startout #\Stx)

(defrule endout #\Enq)

(defrule out (and startout (? outlbl)
              (? outimg)
              (* outtext) endout)
  (:destructure (m1 outlbl outimg expr m2)
    (declare (ignore m1 m2))
    (list (cons :lbl outlbl) (cons :img outimg) (cons :expr (text expr)) (cons :tex t))))

(list (cons :lbl outlbl) (cons :img outimg) (cons :expr (text expr)) (cons :tex t))))

;; Возращаем символ, если он не является маркером конца вывода
(defrule outtext (and (! endout) character)
  (:destructure (m1 ch)
    (declare (ignore m1))
    ch))

;; Определяем маркер для подписи
(defrule outlblbrace #\Etb
  )

;; Возвращаем подпись, игнорируя маркеры
(defrule outlbl (and outlblbrace (* outlbltext) outlblbrace)
  (:destructure (m1 expr m2)
    (declare (ignore m1 m2))
    (text expr)))

;; Возвращаем символ, если не является маркером конца подписи
(defrule outlbltext (and (! outlblbrace) character)
  (:destructure (m1 ch)
    (declare (ignore m1))
    ch))

;; Определяем маркер для имени файла
(defrule outimgbrace #\Bel
  )

;; Возвращаем имя файла, игнорируя маркеры
(defrule outimg (and outimgbrace (* outimgtext) outimgbrace)
  (:destructure (m1 expr m2)
    (declare (ignore m1 m2))
    (text expr)))

;; Возвращаем символ, если он не является маркером конца имени файла
(defrule outimgtext (and (! outimgbrace) character)
  (:destructure (m1 ch)
    (declare (ignore m1))
    ch))

;; маркер начала
(defrule startin #\Etx
  )

;; маркер конца
(defrule endin #\Eot
  )

;; Записываем все что между маркерами
(defrule in (and startin (* intext) endin)
  (:destructure (m1 expr m2)
    (declare (ignore m1 m2))
    (list (cons :expr (text expr)))))

;; Возвращаем символ, если он не является маркером конца
(defrule intext (and (! endin) character)
  (:destructure (m1 ch)
    (declare (ignore m1))
    ch))

;; Записываем текст
(defrule simpletext (+ simpletextcontent)
  (:lambda (list)
    (list (cons :expr (text list)))))

;; Возвращаем символ, если он не является каким-нибудь маркером начала
(defrule simpletextcontent (and (! (or startout startin)) character)
  (:destructure (m1 ch)
    (declare (ignore m1))
    ch))

Парсинг

(defun parse-expression (text)
  "Parsing imaxima output"
  (parse 'expressions text))

CL-USER> (imaxima-esrap:parse-expression "^B^W\%o7^W9^E
^C(%i8) ^D
^B^W\%o8^W9^E
^C(%i9) ^D 
expt: undefined: 0 to a negative exponent.
    -- an error. To debug this try: debugmode(true);
^C(%i10) ^D 
^B\verb|asdfasdf|\verb| |^E 
^B^W\%o10^W\verb|asdfasdf|^E
 ^C(%i11) ^D                 
expt: undefined: 0 to a negative exponent.
     -- an error. To debug this try: debugmode(true);
^C(%i12) ^D 
 ^B^W\%t12^W/home/michael/maxout_1.png^E
 ^B^W\%o12^W^E")
(((:LBL . "%o7") (:IMG) (:EXPR . "9") (:TEX . T)) ((:EXPR . "(%i8) "))
 ((:LBL . "%o8") (:IMG) (:EXPR . "9") (:TEX . T)) ((:EXPR . "(%i9) "))
 ((:EXPR . "expt: undefined: 0 to a negative exponent.
    -- an error. To debug this try: debugmode(true);
"))
 ((:EXPR . "(%i10) "))
 ((:LBL) (:IMG) (:EXPR . "verb|asdfasdf|verb| |") (:TEX . T))
 ((:LBL . "%o10") (:IMG) (:EXPR . "verb|asdfasdf|") (:TEX . T))
 ((:EXPR . "(%i11) "))
 ((:EXPR . "expt: undefined: 0 to a negative exponent.
     -- an error. To debug this try: debugmode(true);
"))
 ((:EXPR . "(%i12) "))
 ((:LBL . "%t12") (:IMG) (:EXPR . "/home/michael/maxout_1.png") (:TEX . T))
 ((:LBL . "%o12") (:IMG) (:EXPR . "") (:TEX . T)))
NIL
CL-USER> 

Работая в компании, которая занимается разработкой на языке Python, сложно удерживать себя и не говорить о том, какой всё-таки неудобный и некрасивый инструмент приходится использовать ежедневно. Поэтому когда я говорю, что в Python всё плохо, то меня обычно спрашивают, а где всё хорошо? Отвечаю, что в Common Lisp (хотя так чтобы совсем всё хорошо, это конечно невозможно).

Попробую ударить в одно из самых болезненных мест. Питон за долгие годы вбирал в себя возможности других языков, одной из таких возможностей является with. Как по мне, прекрасный объект для нападок :)

Рассмотрим код на питоне:

>>> with open("/tmp/workfile", "r") as f:
...     print f.readline()
...
test

И похожий код на лиспе:

CL-USER> (with-open-file (stream "/tmp/workfile" :direction :input)
           (print (read-line stream)))

"test"

Вышел аналогичный по красоте и изяществу код. При этом есть одно “НО” - это то, как внутри выглядит эта красота. Посмотрим что придётся делать на питоне, чтобы создать объект для with:

>>> class SomeContext(object):
...     def __enter__(self):
...         print "Entered context"
...     def __exit__(self, exception_type, exception_value,
...                  exception_traceback):
...         print "Leaving context"
... 
>>> with SomeContext():
...     print "Let's test with"
... 
Entered context
Let's test with
Leaving context

А теперь повторим тоже самое на лиспе:

CL-USER> (defmacro with-some-context (&body body)
           `(unwind-protect (let* ()
                             (print "Entered context")
                             ,@body)
             (print "Leaving context")))
CL-USER> (with-some-context (print "Let's test with"))

"Entered context"
"Let's test with"
"Leaving context"

Но не всякому with нужна обработка исключений, так что вариант на Common Lisp можно упростить до:

CL-USER> (defmacro with-some-context (&body body)
           `(progn
              (print "Entered context")
              ,@body
              (print "Leaving context")))
CL-USER> (with-some-context (print "Let's test with"))

"Entered context"
"Let's test with"
"Leaving context"

Лёгкое движение руки и понятность кода возросла. А в Python так и останутся эти 2 уродства: __enter__ и __exit__, плюс ещё параметры к __exit__. Это то, что называется “приколотить гвоздями”. Проблема в том, что куда не глянь, везде всё реализовано так.

CL-USER> (type-of (make-array 4))
(SIMPLE-VECTOR 4)

CL-USER> (type-of (make-array 4 :adjustable t))
(AND (VECTOR T 4) (NOT SIMPLE-ARRAY))

CL-USER> (type-of (make-array 4 :element-type '(integer 0 128)))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (4))
CL-USER> (type-of (make-array 4 :element-type 'fixnum))
(SIMPLE-ARRAY FIXNUM (4))
CL-USER> (type-of (make-array 4 :element-type 'bit))
(SIMPLE-BIT-VECTOR 4)

• По-возможности, указывайте и размер и интегральный тип элементам на создании массива.
• Если тип все-таки нужен неинтегральный, хотя бы, постарайтесь определиться с размером массива. Даже если точное значение элементов определить нельзя -- не скупитесь, и выделите память по-максимуму, но сразу.
• И только если максимальное значение размера взять неоткуда, либо оно теоретически крайне велико, пользуйтесь :adjustable и :fill-pointer

(defpackage :realloc-test
  (:use :cl :iterate))

(in-package :realloc-test)

(defun realloc (array element-type new-size)
  (let ((new-array (make-array new-size :element-type element-type)))
    (replace new-array array)
    new-array))

(defun read-stream-into-buffer (stream element-type element-reader)
  (iter (with buffer = (make-array 4 :element-type element-type))
        (with buffer-idx = 0)
        (for element in-stream stream using element-reader)
        (when (>= buffer-idx (length buffer))
          (setf buffer (realloc buffer element-type (* 2 buffer-idx))))
        (setf (elt buffer buffer-idx) element)
        (incf buffer-idx)
        (finally (return (realloc buffer element-type buffer-idx)))))

REALLOC-TEST> (with-input-from-string (s "Đây là con mèo của chúng tôi.")
                (read-stream-into-buffer s 'character #'read-char))
"Đây là con mèo của chúng tôi."
REALLOC-TEST> (type-of *)
(SIMPLE-ARRAY CHARACTER (29))

Предыдущий пост, посвящённый этой теме здесь.

Опишу в этом посте свою попытку взглянуть на Caveman поближе.

Первым делом:

CL-USER> (ql:quickload 'caveman)

Весьма странная зависимость, но что поделаешь.

CL-USER> (ql:quickload :clack-middleware-clsql)

Туториал даёт весьма ожидаемый совет для любителей скаффолдинга:

(caveman.skeleton:generate #p"lib/myapp/")

Который заканчивается тем не менее неожиданно:

The path #P"/lib/myapp//.gitignore" does not exist.
   [Condition of type SB-INT:SIMPLE-FILE-ERROR]

Restarts:
 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [*ABORT] Return to SLIME's top level.
 2: [TERMINATE-THREAD] Terminate this thread (#)

Простим этот недостаток и быстро исправим его, как никак проект очень молодой:

CL-USER> (caveman.skeleton:generate
          #p"/home/dym/tmp/proga/caveman-test/lib/myapp/")
writing //home/dym/tmp/proga/caveman-test/lib/myapp//.gitignore
writing //home/dym/tmp/proga/caveman-test/lib/myapp//README.markdown
writing //home/dym/tmp/proga/caveman-test/lib/myapp//myapp-test.asd
writing //home/dym/tmp/proga/caveman-test/lib/myapp//myapp.asd
writing //home/dym/tmp/proga/caveman-test/lib/myapp/src//myapp.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/t//myapp.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/config//dev.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/lib/view//emb.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp//myapp.asd
writing //home/dym/tmp/proga/caveman-test/lib/myapp/src//app.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/src//controller.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/src//myapp.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/static/css//main.css
writing //home/dym/tmp/proga/caveman-test/lib/myapp/t//myapp.lisp
writing //home/dym/tmp/proga/caveman-test/lib/myapp/tmpl//index.tmpl
T

Далее загружаем наш пакет:

CL-USER> (ql:quickload :myapp)
To load "myapp":
  Load 1 ASDF system:
    myapp
; Loading "myapp"
[package myapp]...................................
[package myapp.controller]
(:MYAPP)

Стартуем сервер:

CL-USER> (myapp:start)
Hunchentoot server is started.
Listening on localhost:5000.
# {B3132B1}

Ха, да он прям как Flask, запустился на 5000-ом порту :D

Немного поигравшись с Caveman’ом я пришёл к определённым выводам. Местами мои выводы очень субъективны, особенно если учесть, что данный фреймворк никак не тянет на микро, а замахнулся больше на славу RoR и Django.

Хорошее:

• Конфигурация собрана в одном файле
• Гибкая схема маршрутов (routes), позволяющая воплотить в жизнь любые REST идеи

Плохое (как известно, всегда легче найти недостатки, чем достоинства):

• Жёсткая привязка к clsql
• Желание авторов превратить Common Lisp в Python. Например, чего стоит cl-annot

Вообще, у проекта есть очень большой плюс: активные разработчики. Не проходит и недели, чтобы они не вносили изменений. Но с другой стороны, модель предложенная RESTAS как-то ближе, толи сказывается происхождение автора, толи просто в нём отсутствуют те 2 больших недостатка, что есть у Caveman. Ещё один плюс Caveman’а, который я не указал, это то, что он полностью может быть загружен с помощью quicklisp. RESTAS так не повезло, его код очень сильно зависит от новых возможностей hunchentoot, которые в stable release так и не были включены, ну и вобщем одно за другое и получается, что RESTAS нужно ставить (вместе с другими пакетами, которые ему нужны) из репозитория.

Пример кода указанный ниже был скопирован с главной страницы Flask’а

@app.route("/")
def hello():
    return "Hello World!"

А нижеследующий пример взят со страницы Caveman’а, претендующего на роль микрофреймворка в мире Common Lisp

@url GET "/hi"
(defun say-hi (params)
  "Hello, World!")

Flask начинался как шуточный микрофреймворк, специально написанный к 1-му апреля, но на данный момент под это понятие он не подходит по ряду причин:

• Код находится не в одном единственном файле
• Встроенная поддержка jinja2
• Количество обвесок продолжает увеличиваться

С Caveman’ом всё было не так. Изначально проект создавался с полной серьёзностью на какую только способны потомки самураев.

Под капотом у Flask’а скрывается Werkzeug, в документации которого легко можно найти следующий пример:

def application(environ, start_response):
    start_response('200 OK', [('Content-Type', 'text/plain')])
    return ['Hello World!']

В свою очередь Caveman использует Clack:

(clackup
  (lambda (env)
    '(200
      (:content-type "text/plain")
      ("Hello, Clack!"))))

Не перестаёт удивлять их внешняя схожесть. К счастью авторы этого и не скрывают, на сайте Clack’а чётко написано

Clack is a web application environment for Common Lisp inspired by Python’s WSGI and Ruby’s Rack

Да вобщем и Caveman на микрофреймворк не тянет, чего только стоит его зависимость от clsql

На этом пока и всё, надеюсь в ближайшее время более детально разобраться в том, что из себя представляют Caveman и Clack. Остаётся только надеятся на то, что внешняя схожесть с Flask’ом не отразилась пагубно на возможностях фреймворка.

Продолжение …