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

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

2. Послание закодировано двумя символами (битами). Для того чтобы понять, действительно ли это сигнал от братьев-по-разуму, или просто всплеск радиоактивности близлежащего пульсара, необходимо применить понятие информационной энтропии. Если энтропия сообщения находится в некотором интересном интервале, то есть некоторая уверенность в том, что сигнал имеет искусственное происхождение.

3. Если послание прошло энтропийный тест, то его необходимо проверить на тест простых чисел, а именно количество символов в сообщении (в данном случае бит) должно представлять собой число, у которого ровно 2 простых делителя. Это значит, что все символы сообщения можно расположить в прямоугольную матрицу двумя способами (x * y или y * x, где x и y — простые делители длины последовательности сигналов). Далее получившиеся матрицы рассматриваются на предмет наличия в них осмысленных изображений.


Все эти пункты достаточно легко автоматизировать. Для этого можно написать программу на функциональном языке высокого уровня Haskell (а вы думали, на каком языке программирования я бы ещё ог написать программу). Что ж, это сделать несложно. Всё данное сообщение и представляет собой такую программу. Его можно полностью скопировать в файл LHS и выполнить в каком-нибудь GHCi.

Для начала необходимо объявить начало модуля. Это просто, как обычно:

> module Main where

Теперь надо подключить пару модулей, из которых будут взяты некоторые полезные для проекта функции (чтобы не писать их самостоятельно). Во-первых, это функция intercalate из модуля Data.List. Она сшивает списки из заданного списка, разделяя их заданным списком (другими словами, она будет использоваться для отображения прямоугольных матриц). Ещё одна полезная функция — primeFactors из модуля Data.Numbers.Primes, которая предназначена для факторизации заданного числа. Подключение просто:

> import Data.List (intercalate)
> import Data.Numbers.Primes (primeFactors)

Последний модуль не входит в стандартную поставку. Однако его можно легко скачать и установить с помощью утилиты Cabal, которая входит в состав поставки Haskell Platform. Для этого в консоли необходимо последовательно выполнить:

cabal update

cabal install primes-0.2.0.0

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

> data Bit = O | I

> instance Show Bit where
>   show O = "."
>   show I = "O"

После этого сами функции, которые выводят матрицу в строку и на экран. Функции полиморфны, им безразлично, какого типа будут элементы матриц. Главное, чтобы эти элементы могли бы быть отображены в виде строк. Первая функция получает на вход матрицу в виде списка списков и преобразует её в строку как раз при помощи функции intercalate, которая прореживает элементы входного списка символом '\n. Вторая функция предназначена для преобразования входной последовательности бит в матрицу и вывода её уже на экран (то есть в монаде IO):

> showMatrix :: Show a => [[a]] -> String
> showMatrix = (intercalate "\n") . map (concatMap show)

> putMatrix :: Show a => Int -> [a] -> IO ()
> putMatrix x l = (putStrLn $ showMatrix $ divideList x l) >> putStrLn ""
>   where
>     divideList _ [] = []
>     divideList i ls = let (y, ls') = splitAt i ls
>                       in  y : divideList i ls'

Теперь пришло время вычислительных функций. Для начала функции, которые вычисляют информационную энтропию сообщения. Функция entropy получает на вход последовательность сигналов и возвращает значение энтропии для неё. Функция maxEntropy возвращает максимальное значение энтропии для алфавита из заданного количества символов (такое максимальное значение получается тогда, когда на вход функции entropy подаётся сообщение, состоящее из одинакового количества сигналов каждого возможного типа). Функция maxEntropy предназначена для проверки первого критерия.

> entropy :: Eq a => [a] -> Double
> entropy l = (0 -) $ sum $ map (pLog $ length l) $ frequency l
>   where
>     pLog s (x, n) = p * logBase 2 p
>       where
>         p = fromIntegral n / fromIntegral s

> maxEntropy :: Int -> Double
> maxEntropy n = entropy [1..n]

Вспомогательной функцией является следующая. Для заданного списка она возвращает список пар, первым элементом которых являются символы исходного списка, а вторым — количества проявлений соответствующих символов в исходном списке. Предназначена для расчёта частных вероятностей при вычислении энтропии сообщения.

> frequency :: Eq a => [a] -> [(a, Int)]
> frequency = frequency' []
>   where
>     frequency' l []     = l
>     frequency' l (x:xs) = frequency' (corrector x l) xs
> 
>     corrector x []           = [(x, 1)]
>     corrector x ((x', n):xs) = if x == x'
>                                  then (x, n + 1):xs
>                                  else (x', n):(corrector x xs)

Ещё одна вспомогательная функция, вернее даже предикат. Предназначен для понимания того, входит ли заданное число в заданный же интервал. Легко полиморфно:

> inRange :: Ord a => a -> (a, a) -> Bool
> inRange i (x, y) = (i >= x) && (i <= y)

Наконец, кодирование входного сигнала и пара функций для его обработки:

> inputData :: [String]
> inputData = ["(((((()()()()(((((((((((()()((((()()((((((()(()((()((()((()(()())(()()()()()()()",
>              "()()(()(()((((((((((((((((((((((((((((((((((((())((((((((((((((((((())()((((((((",
>              "((((((((((())()(((((((((((((((((()()()(((((((((((((((((()))))(((((((((((((((((((",
>              "((((((((((((())(((()))((())(((())((()((((((((((((())(()(((())()((())((())(((())(",
>              ")()))))()))))()))))()))))(((((((((((((((((((((((((()((((((((((((((((()((((((((((",
>              "(((((((((((((((((()((((((((((((((((())))))((((((((((((()))))((((((((((((((((((((",
>              "((())(((())(((()))((())((()((((((()((((((((()(((())()(((())((()))(())()()))))())",
>              ")))()))))()))))(((((((((((((((((((((((((()(((((())((((((((()((((((((((())(((((((",
>              "(((((((()((((())(((((((((())))))((((())(((((()))))(((((((((())((((((((((((()((((",
>              "(((()(((((((()((((()(((((())((((((()((((((())(((())(((((()(((((((((())((()(((())",
>              "((((((((((((((())(())((((((((((((())((()(((())((((((((())(((())(((((()((((((()((",
>              "(((()(((((((()((((()((((((())(((((((()((()(((((((())(((((((()((()((((((((()(((((",
>              "(()((((()((((((()((((((()((((((()(((((((((((())((((((((())(((((((())((((((((()((",
>              "()))()())((((((((((()((((((()(((((((((((((()((((()))))(((((((((((()(((()()))()((",
>              ")())())(((((()(()))(()(()))))))()))(((()))((((())()))((((((((()()((((()))())(()(",
>              "((((()()((((())))))(()(((((()()((((())(((((()((((())())(((((((((((((((((((((((((",
>              "(((((((((()))((((()(((((((((((((()))()()((()()()()()()(()))((((((((()()()()(((((",
>              "((((((((((()()(((((((((((((()))))(((((((((((((((()))))))))(((((((((((()))(((((((",
>              ")))((((((((())((((((((((())((((((())()((((((((()())((((())(())((((((())(())(((()",
>              "((()()((((()()((()(((()((()(()((()(()((()(((((((()((()()((()(((((((((((()(((()((",
>              "(()(((((((((((()((((((((()(((((((((((((()(()()((((((((((())))(()))))()(())))((("]

> decodeBits :: (Char -> Bit) -> String -> [Bit]
> decodeBits = map

> mapping :: Char -> Bit
> mapping '(' = O
> mapping ')' = I
> mapping _   = error "Illegal character in input sequence."

Функция decodeBits является синонимом прекрасной функции map для специального случая, который рассматривается в этой заметке. Она будет работать с функциями типа mapping, которая преобразует символы входной строки в определённый ранее тип битов. Последняя функция написано несколько грязно (использование функции error), но для целей исследования сойдёт, ибо во входной последовательности имеются только обрабатываемые символы. Шумов нет.

И, наконец, главная функция main. Она тестирует входной сигнал двумя тестами и выводит два возможных результата на экран, если оба теста успешно пройдены. Тоже не очень сложно:

> main :: IO ()
> main = do let iData  = concat inputData
>               ntr    = entropy iData
>               maxNtr = maxEntropy $ length $ frequency iData
>           if ntr `inRange` (0.2 * maxNtr, 0.8 * maxNtr)
>             then do let pf = primeFactors $ length $ iData
>                     if length pf == 2
>                       then do let x:y:_ = pf
>                                   bits  = decodeBits mapping iData
>                               putMatrix x bits
>                               putMatrix y bits
>                       else putStrLn "FIASCO: Input sequence doesn't pass the primes test."
>             else putStrLn "FIASCO: Input sequence doesn't pass the entropy test."
>           return ()

В результате на экране консоли будут получены два изображения:

......O.O.O.O..........
..O.O.....O.O.......O..
O...O...O...O..O.OO..O.
O.O.O.O.O.O.O.O..O..O..
.......................
............OO.........
..........OO.O.........
..........OO.O.........
.........O.O.O.........
.........OOOOO.........
.......................
OO....OOO...OO....OO...
O.............OO..O....
OO.O...OO...OO....OO.O.
OOOOO.OOOOO.OOOOO.OOOOO
.......................
...O.................O.
.......................
....O.................O
OOOOO.............OOOOO
.......................
OO....OO....OOO...OO...
O.......O.........O....
OO.O....OO...OOO..OO.O.
OOOOO.OOOOO.OOOOO.OOOOO
.......................
...O......OO.........O.
..........OO...........
....O.....OO..........O
OOOOO.....OO......OOOOO
..........OO...........
..O........O........O..
...O......OO.......O...
....OO....OO......O....
......OO...O....OO.....
..........OO..OO.......
......OO...O....OO.....
....OO....OO......O....
...O......O........O...
..O.......OO........O..
.O........OO........O..
.O.........O.......O...
..O.......O.......O....
...O............OO.....
....OO........OO.......
..O...OOO.O.OO.........
..O.......O............
..O.....OOOOO..........
..O....O.OOO.O..O.OO.OO
......O..OOO..O..OOOOOO
O.OOO....OOO.....OO.OOO
.........O.O.....OOO.OO
..O......O.O.....OOOOOO
..O......O.O.....OO....
..O.....OO.OO..........
.......................
..OOO.....O............
..OOO.O.O...O.O.O.O.O.O
..OOO.........O.O.O.O..
..............O.O......
........OOOOO..........
......OOOOOOOOO........
....OOO.......OOO......
...OO...........OO.....
..OO.O.........O.OO....
.OO..OO.......OO..OO...
.O...O.O.....O.O...O...
.O...O..O...O..O...O...
.....O...O.O...O.......
.....O....O....O.......
.....O.........O.......
.......O..O.O..........
.OOOO..OOOOO.O..OOOO...

и

......O.O.O.O............O.O.....O.O.......O..O...O...O...O..O.OO..O.O.O.
O.O.O.O.O.O..O..O.....................................OO.................
..OO.O...................OO.O..................O.O.O..................OOO
OO................................OO....OOO...OO....OO...O.............OO
..O....OO.O...OO...OO....OO.O.OOOOO.OOOOO.OOOOO.OOOOO....................
......O.................O............................O.................OO
OOOO.............OOOOO.......................OO....OO....OOO...OO...O....
...O.........O....OO.O....OO...OOO..OO.O.OOOOO.OOOOO.OOOOO.OOOOO.........
.................O......OO.........O...........OO...............O.....OO.
.........OOOOOO.....OO......OOOOO..........OO.............O........O.....
...O.....O......OO.......O.......OO....OO......O..........OO...O....OO...
............OO..OO.............OO...O....OO.........OO....OO......O......
.O......O........O.....O.......OO........O...O........OO........O...O....
.....O.......O.....O.......O.......O.......O............OO.........OO....
....OO.........O...OOO.O.OO...........O.......O..............O.....OOOOO.
...........O....O.OOO.O..O.OO.OO......O..OOO..O..OOOOOOO.OOO....OOO.....O
O.OOO.........O.O.....OOO.OO..O......O.O.....OOOOOO..O......O.O.....OO...
...O.....OO.OO...................................OOO.....O..............O
OO.O.O...O.O.O.O.O.O..OOO.........O.O.O.O................O.O.............
.OOOOO................OOOOOOOOO............OOO.......OOO.........OO......
.....OO.......OO.O.........O.OO.....OO..OO.......OO..OO....O...O.O.....O.
O...O....O...O..O...O..O...O........O...O.O...O............O....O....O...
.........O.........O..............O..O.O...........OOOO..OOOOO.O..OOOO...

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

1. С технической точки зрения функцию main можно переписать так, чтобы она получала входную последовательность сигналов из некоторого файла. Это несложно (пара строк). Другое дело, что в ней же можно вставить третий тест, который будет выбирать из двух прямоугольников только тот, в котором есть нечто осмысленное (если такой вообще имеется). Какими могут быть формальные критерии такого отбора?

2. И методологическая проблема. Вот мы выбрали первое изображение, на котором, вроде бы, что-то даже изображено (кстати, это послание с телескопа Аресибо, которое ушло в космос с Земли ещё в 1974 году в направлении звёздного скопления М13). Как теперь проинтерпретировать это сообщение? Как быть, какую методологию расшифровки принять к действию? Что дальше?

Вот такая история была опубликована в своё время на anekdot.ru:

"Работал я в одной фирме. Мы отправляли богатеньких буратин учиться в Англию и Штаты. Причем до этого я был твердо уверен, что в Оксфорде могут учиться только особо одаренные люди...

... В наш офис приезжает безумно крутой кавказец с двумя телохранителями и сыном.
Сыну 15 лет. Папа хочет, чтобы он учился "в Оксфорде на адвоката".
Нахожу в компьютере все материалы по оксфордским учебным заведениям, называю приблизительную цену. Папу все устраивает. Отправляю факс, получаю ответ с точной суммой. Причем оплачивать можно частями, за каждый семестр.
Папа говорит, что лучше он оплатит сразу весь курс обучения, потому что завтра его могут убить, а сыну надо учиться.

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

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

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

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

"...2. Ваш клиент Манучар успешно прошел тестирование по физике и математике.
К сожалению выяснилось..."
И т. д. Вообще-то, на этот факс нужно было что-то ответить, но в голове почему-то крутилась одна-единственная мысль, что я понятия не имею, как писать завещание... Да и есть ли смысл завещать кому-то мой ржавый "жигуль"?

Совершенно автоматически читаю дальше. Последним пунктом значится, что и русского языка Манучар не знает, а того языка, на котором он говорит, не знают в Оксфорде.
Через час обещал заехать отец Манучара - справиться об успехах сына и отпраздновать их с нами в хорошем ресторане. Вы когда-нибудь задумывались, как красиво прожить последний час своей жизни? Нетвердой походкой иду к секретарше.
Вид у меня такой, что она от страха забирается на стол и кричит: "Что случилось?". Протягиваю ей факс. Она читает.
- Ну, - говорит, - а где второй лист?
- Какой еще второй лист?
- Ну, тут же написано, что сообщение - на двух листах...
- Где? Гм... Действительно... Наверное, второй не прошел.
- Я перезвоню, пусть еще раз отправят...
Второй лист? Должно быть, их специалисты установили, что наш клиент Манучар успешно убил учительницу, угнал ее машину, врезался в стену Вестминстерского аббатства, где и торгует наркотиками по настоящее время.

Пищит факс. Вот он, этот второй лист:
"На основании вышеизложенного, с глубоким сожалением вынуждены сообщить, что дальнейшая учеба Манучара в нашем учебном заведении невозможна" (Все.
Я труп.)
"... поэтому мы берем на себя смелость предложить Вам связаться с родителями Манучара..." (Нет! Нееет!!!)
"... и известить их о небольших дополнительных материальных издержках, которые им, к сожалению, придется понести в связи с отсутствием у нас предварительной информации об образовательном уровне Манучара" (Это они о чем?)

"1. Мы нашли и наняли специального преподавателя, который прочтет Манучару специальный ускоренный трехнедельный курс английского языка.
2. Мы нашли и наняли... который... математики для младших классов.
3.... математики для старших классов.
4. Мы нашли и наняли...
5.... нашли...
6.... наняли...
19. Мы нашли и наняли специального человека, который будет повсюду сопровождать Манучара и помогать ему объясняться в магазинах, в транспорте, с домохозяйкой и проч.
На основании вышеизложенного не будете ли Вы столь любезны сообщить родителям Манучара о необходимости перевести на наш счет дополнительно 1275 фнтов и извиниться от нашего имени за причиненное беспокойство?"

У вас есть деньги, но вы не знаете, как их потратить? Возьмите своего кота и отправьте его в Оксфорд! Через несколько лет он обязательно получит ученую степень!

В догонку к предыдущему жалобному посту.

На этот раз о cl-magick. Блядь, ну казалось бы: тупейший же враппер вокруг ImageMagick. Лежит на common-lisp.net. Анонсирован как официальный биндинг на офсайте ImageMagick.

И все равно привет: путь до .so-шки захардкожен (по-луниксячьи, разумеется, да и вместо libMagickWand.so какой-то libWand.so), функции тупо замапплены (причем не лисп-стайл) и, главное, НИХРЕНА НЕ РАБОТАЕТ. Потому что типы проставлены неверно, а местами вообще от балды.

Ну вот зачем так делать-то, а? Это же тупо невоспитано. А потом люди боятся даже смотреть в сторону CL из-за подобного шлака.

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

Upd: вместо позорного cl-magick следует использовать lisp-magick, там все грамотно.

В статье приведён один из возможных подходов к организации разбора JSON-данных на языке F#. Используется механизм известный как парсер-комбинаторы.

“f x = x. I don’t do very much but at least I’m unique.”

- James Chapman (via annayudi)

Никак не могу понять одной вещи про extended loop -- прямо мозги вытекают :(

Допускается ли стандартом использование termination test clauses (e.g. while) *между* for? Так, чтобы если условие завершения наступило, stepping от «нижних» for бы не выполнялся (у меня довольно часто многоэтажный loop построен так, что «нижние» for не способны сделать stepping без ошибки, если вовремя не вывалиться).

Если начать исследовать CLHS с того места, где расписан как-бы-BNF extended loop, кажется, что такого делать просто нельзя. Если закопаться внутрь, однако, попадаются (или, возможно, приглючиваются) намёки, что так делать можно. SBCL и CCL такое проглатывают и работают ожидаемым образом, но мне вспоминается печальный опыт с чем-то вроде ECL, который (если я правильно помню) потребовал подвинуть while вниз, а это уже потащило за собой переписывание всего подряд. В общем, совершенно нехарактерная для Common Lisp засада -- когда можно пользоваться нестандартным расширением несколько лет, и внезапно об этом узнать. Такая перспектива мне не нравится. (Взбрык ECL, опять же, совершенно не показатель -- дело было давно, он был моложе и глупее и вполне мог быть non-conforming в этом плане. Проверять заново не тянет: сейчас хочется выяснить, как оно *должно* быть, а тут такие проверки не помогут)

Ну и такой вопрос -- если я сделаю вместо WHILE какой-нибудь FOR () = (WHEN кирдык (LOOP-FINISH)) -- оно-то уж точно предотвратит stepping в последующих FOR? (тогда, с одной стороны, становится непонятно, на фига не разрешили там WHILE (если и вправду нельзя), но зато понятно, на что его менять, чтобы обойтись без революций).

Вот есть "БД" на основе гиперграфа.

У нас в этой БД есть узлы с наборами (HList) атрибутов и гипердуги с ролями-концами. Роли требуют наличия определённых наборов атрибутов у включаемых узлов, например, роль "файл" гипердуги "первая строка файла" содержит требование, чтобы узел содержал атрибут "Имя файла" со строковым значением. У той же гипердуги вторая роль называется "первая строка файла" и требует, чтобы подсоединяемый узел имел атрибут "строка файла".

Как бы спроектировать язычок запросов?

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

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

Оператор альтернативы (например, +++) позволит нам пройтись по нескольким ролям одновременно.

Оператор many выполнит навигацию по его аргументу до упора - пока будут узлы, что мы ещё не обошли.

Получится обход в ширину графа по определённым связям.

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

В конце мы можем получить как все пройдённые узлы, так и интересные нам.

По идее, на это можно будет навесить оптимизацию.

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

И даже можно сделать подсветку синтаксиса. ;)

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

Подумаю.

Есть известные правила программирования в Unix. Мы решили обратить внимание на схожие правила, помогающие создавать краткий программный код:

1. Код должен быть читаемым текстом, но не на естественном языке
2. Абстракции должны браться из спеки, а не из воздуха
3. Плохо абстрагировать пост-фактум повторяющиеся куски
4. Много строк — плохо, но много обозначений — тоже плохо
5. Зло кроется в особых случаях
6. Нужно локализовывать оптимизации любого уровня
7. Не знаешь точно, пригодится ли код, — не пиши

Tsung — это распределенная система для нагрузочного тестирования.

Tsung симулирует запросы от многих пользователей с целью выяснить устойчивость и отзывчивость той или иной системы (сервер MySQL, Apache, SOAP, LDAP и т.п.) под нагрузкой.

Tsung сейчас доступен в версии 1.3.3. В этой версии в основном багфиксы:

• Tsung корректно использует сессии с малой вероятностью
• Исправлена поддержка cookie при использовании прокси-сервера
• и т.п.

Tsung можно скачать с официального сайта.

 
Ссылки
 

• Tsung на erlang-projects

 
См. также
 

• Tsung 1.2.2

Дамиен Катц (Damien Katz), автор CouchDB, дал большое интервью сайту "How Software is Built".

В интервью обсуждается:

• Проблемы, возникающие при создании масштабируемой базы данных
• Сравнение документоориентированных и реляционных баз данных
• Компромиссы, на которые приходится идти, по сравнению с реляционными базами данных
• и многое другое

Интервью доступно на сайте "How Software is Built": http://howsoftwareisbuilt.com/2010/06/18/interview-with-damien-katz-apache-couchdb/

 
Ссылки
 

• CouchDB

 
См. также
 

• CouchDB + IBM

Сеттинг.

class ArrowTrans t where
  arrLift :: (Arrow a, Arrow (t a ) ) => a b c -> t a b c
  arrTMap :: ( Arrow a , Arrow (t a ) ) => ( forall b c . a b c -> a b c ) -> t a b c -> t a b c

class Arrow a => ArrowApply a where
 app :: a ( a b c , b ) c

class Arrow a => ArrowChoice a where
  left :: a b c -> a (Either b d) (Either c d)
  ....

Вопросы
Можно ли написать
instance ( ArrowTrans t, Arrow (t a) , ArrowChoise a, ArrowApply a) => ArrowChoice (t a )
instance ( ArrowTrans t, Arrow (t a), ArrowApply a) => ArrowApply ( t a )
и почему.
можно ли и если да, то как аккуратно поднять операции

class Arrow a => ArrowReader a e where
 ...
 local :: a b c -> a (b,e) c

class Arrow a => ArrowException a e where
 ...
handle :: arr e c -> arr b c -> arr b c

и откуда это следует.

Прочитав первые двадцать страниц статьи Шульмана, я понял, что у него есть всё то, что было у меня (но и намного больше). И, конечно, сделано всё круче и красивей. Самое главное, что я предчувствовал, но не смог показать: операции ∇ и Δ выражаются с точностью до изоморфизма друг через друга. А показать это, как выяснилось, совсем не сложно.

Я не увидел, однако, такой теории двойственности, которая бы меня удовлетворила, хотя Майк эту тему затрагивает, в том числе и инволюции. Но в любом случае становится ясно, что vertically thin framed bicategory - это правильная основа для категорной теории онтологий, если мы хотим сохранить все логические удобства.

Эта-редексы могут порождать новые эта-редексы, например x: y (_z: x z_) = _x: y x_. Бета-редексы могут порождать эта-редексы, например x: y (_I x_) = _x: y x_. Обратное последнему утверждение, однако, неверно. Покажем это.

Пусть H = x: M x есть эта-редекс, то есть M не содержит свободных вхождений переменной x. Возьмем произвольный контекст C[ ] и рассмотрим три исчерпывающих взаимоисключающих варианта (C'[ ] — некоторый контекст, и N — произвольный терм):

1) C[ ] = C'[[ ] N];
2) C[ ] = C'[N [ ]];
3) C[ ] = C'[x: [ ]].

Очевидно, что для случаев (2) и (3) эта-редукция H к M в выражении C[H] = C[M] не приводит к появлению новых редексов. В случае (1) M N может оказаться бета-редексом, однако выражение H N являлось бета-редексом еще до эта-редукции H к M.

Из этого факта следует, что безопасно откладывать эта-редукцию сколь угодно долго без угрозы нормализующему свойству. Таким образом, оказывается приемлемым решение обнаруживать новые эта-редексы при процедуре удаления нод, отвечающих использованиям переменной, то есть в общем случае к концу работы сборщика мусора [подразумевается, что в случае завершения обработки списка редексов, «сборщик мусора» начинает выделять свободные блоки памяти, тем самым выполняя требуемую проверку переменных, очищать их, и включать обратно в список свободных нод, проходя по нему полностью, пока не останется никаких деревьев подвыражения, подлежащих удалению]. Проверка на редекс показывает положительный результат тогда и только тогда, когда удаляется использование переменной, и остается еще два, причем оба они укладываются в форму эта-редекса. Это можно определить в реальном времени благодаря ссылкам на родительские ноды в элементах списков использований.

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

Решительно непонятно, как можно программировать на языке без dependent types. Такие костыли, знаете ли, получаются.

Я работаю со всякими финансовыми штуками. Есть такое понятие «инструмент», т.е. то, чем мы в данный момент торгуем. Выкинем пока из головы всякие фьючерсы и опционы, и сосредоточимся на обычном спотовом рынке. Допустим, мы можем торговать только валютами и металлами.

Соответственно, есть тип Instrument(primary: Asset, secondary: Asset), где Asset — названный так за неимением лучшего слова тип ценности. Инструмент выражает одну ценность в другой, например, мы торгуем нефтью за доллары. Или долларами за франки. Или меняем золото на нефть. Таким образом, Asset может быть Currency или Commodity (Metal, в нашем случае). Всё бы хорошо.

Но если оба Asset в Instrument являются Currency, этот инструмент автоматически должен становиться типа CurrencyPair, с разными дополнительными доступными штуками (типа подсчёта количества пипсов etc). Увы, так просто это в скале, например, не выразить, поэтому приходится использовать pattern matching и прочие костыли.

Или вот например денежный тип. Казалось бы, всё просто: это Money(amount: Decimal, asset: Asset) (тех, кто использует там Double, в 99% случаев нужно кастрировать). Но в контексте работы с портфелем позиций гораздо удобнее рассматривать скалярную сумму денег тоже как некоторую позицию, т.е. Position(primary: Money, secondary: Money), где primary всегда равен нулю. При этом с точки зрения финансовой математики, если количество денег равно нулю, не имеет значения, в какой валюте они выражены (и действительно, совершенно без разницы, ноль евро у вас или ноль франков), и ноль всегда можно сложить с любым количеством денег в любой другой валюте, в то время как ненулевые суммы денег в разных валютах складывать нельзя. В этом случае можно, наверное, вывернуться с Either, но это неудобно — в идеале нужны именно зависимые типы.

Если вы ничего не поняли, то это потому, что я ненастоящий сварщик и плохо объясняю. И ещё потому, что без бутылки тут в принципе не разберёшься. А под алкоголем нельзя программировать. В общем, бида, бида.

Spbalt.net Unplugged

Участники

• Дмитрий Нестерук (блог, twitter)
• Антон Оникийчук (подкасты)

Что обсуждали

• Плюсы и .Net: Managed C++, P/Invoke (пример), COM interop, SIMD/OpenMP
• ФП в .Net: real-world FP, F#, C# monads/fluent syntax
• ФП за пределами .Net: Lisp, Erlang, Haskell

Наш подкаст на POD.FM (RSS)

Обнаружил при работе со структурой данных типа Map удобное сочетание.
Пример из реальной жизни:

module V =
  Map.Make(struct type t = filename let compare = compare end);;

 (* ... *)

  let collect = V.fold V.add in
  
  if master then
    let result = 
      List.fold_left 
	(fun acc filename -> 
	  V.add filename (V.find filename v') acc)
	result new_filenames 
    in collect result (collect !defvals !curvals)      
  else result

--
То есть как видим функция add у мапов подходит в качестве
первого аргумента функции fold. Что позволяет довольно
компактно объединять мапы.

Вероятно все читали замечательное эссе Пола Грэма "Хакеры и художники", но очень хочется привести из него один фрагмент, который мне нравится особенно сильно:

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

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

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

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

Осознание этого факта реально влияет на разработку ПО. Язык программирования прежде всего должен быть гибким. Язык программирования - чтобы думать о программах, а не формулировать программы, которые уже обдуманы. Карандаш, а не ручка. Статический контроль типов - неплохая штука, если б программировали и впрямь так, как учат в колледже. Но ни один известный мне хакер так не работает. Нам требуется язык, что позволит карябать, сажать кляксы и стирать, а не вроде как сидишь с чашкой типов данных и вежливо беседуешь со строгой престарелой тетушкой-компилятором.

Раз уж мы заговорили о статическом контроле, то вот что. Назвавшись творцами, мы избавимся еще от одной проблемы, что терзает науки: от зависти к математике. Любой ученый втайне верит, что математики всех умнее. Кажется, математики в это верят не меньше остальных. А в итоге ученые стараются, чтобы их работа на вид получалась математической до предела. Может, в какой-нибудь физике это и не беда, но чем дальше от естественных наук, тем больше усугубляется проблема.

Ну, разумеется - страница формул впечатляет. (Совет: для особой выразительности вводите греческие переменные.) И потому так соблазнительно заняться проблемами, к которым можно подойти формально, а не над теми, что, скажем так, важны.

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

Это еще один пост с обзором книг, но в этот раз «с изюминкой» – будем обсуждать книги издательства Manning. По сравнению с Apress (см. предыдущий обзор), издательство Manning Publications публикует книги совсем другого уровня. У них, например, печатаются такие люди как Джон Скит или Айенде. Впрочем, как показывает практика, громкое имя не гарантирует высокое качество материала.

Задача. Дано: циркуль, линейка, полное нежелание выходить из дома, айфон и карточка Альфа-банка с долларовым счётом. Требуется получить: карточку американского банка с американским же billing address и хотя бы двадцаткой на счету. Дополнительное у...

Read and post comments | Send to a friend

Подскажите пожалуйста, какой из JavaScript framework'ов (или библиотек) по своей идеологии ближе всего к функциональному программированию? У меня сейчас нет "чувства языка", сам судить не могу, и все эти prototype, mootools, jQuery, MochiKit -- почти пустой звук.
В идеале хочется относительно-честные лямбды, классические комбинаторы (поверх функций, массивов), а если будут индуктивные типы данных (хоть и с рантайм-проверками типов) -- так вообще супер.

Всем, кто до сих пор считает, что деление знакового числа на степень двойки — это арифметический сдвиг вправо, срочно читать заметку №378 “Arithmetic Shifting Considered Harmful” by Guy Steele Jr. датированную сентябрём 1976 года. Он там всё на пальцах объясняет.

Для примера: -5 >> 1 = -3, -4 >> 1 = -2, -3 >> 1 = -2.

Кстати, именно поэтому компиляторы, если они не могут доказать, что делимое неотрицательное, вставляют менее эффективный код для деления, например, для ARM'а я недавно писал генератор чего-то вроде такого:

mov temp, dividend, ASR #31                   ; temp = dividend >> 31
add result, dividend, temp, LSR #(32-power)   ; result = dividend + (dividend < 0 ? 2^power-1 : 0)
mov result, result, ASR #power                ; result = result >> power

В ARM'овском ассемблере destination register идет сразу после названия инструкции, потом идут аргументы. ASR #31 — арифметический сдвиг вправо последнего аргумента на 31 бит.

Cмысл кода примерно такой: если мы делим на 2power, где power — известная константа в момент компиляции операции деления, то, в случае положительного делителя, нам достаточно сдвинуть его вправо на power бит. Иначе, нам сначала надо добавить к делимому 2power-1, то есть число, имеющее нижние power бит равных 1. Чтоб получить такое число, мы сначала делаем арифметический сдвиг делимого на 31 бит вправа, т.е. распространяем знак на все 32 бита (для отрицательного делимого, temp = -1, для положительного — 0), а потом сдвигаем temp ещё на (32-power) бит вправа, но в этот раз без знакового заполнения — логический сдвиг (LSR, logical shift right), тем самым получая 2power-1. Ну а дальше просто: добавляем это к делимому, сдвигаем результат арифметическим сдвигом.

Можно конечно сделать по-рабоче-крестьянски, со сравнением с нулём и условным добавлением константы, или, со сравнением с нулём, условным negation делимого, сдвигом, и ещё одним условным negation, но тогда получается уже 4 инструкции.

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

В процессе плановой отработки умения реализовывать простые алгоритмы написал топологическую сортировку на Haskell. Оказалось совсем просто, большую часть времени заняло скучное описание того, что такое граф, и что с ним я хочу делать. Выбор между использованием fold'а совместно с явным протаскиванием состояния и использованием монады State был разрешён моими ленью и здравым смыслом: нечего там городить кучу нечитаемого кода.

import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S
import Data.Set(Set)
import Data.Maybe
import Control.Monad
import Control.Monad.State

data Graph a = Graph (Map a [a]) deriving Show

adj :: Ord a => Graph a -> a -> [a]
adj (Graph m) n = concat $ maybeToList $ n `M.lookup` m

nodes :: Graph a -> [a]
nodes (Graph m) = M.keys m

data TopoSearchState a = TSS { visited :: Set a, sorted :: [a] }

topoSort :: Ord a => Graph a -> [a]
topoSort g@(Graph m) = sorted $ execState topoSort' initState
  where
    initState = TSS { visited = S.empty, sorted = [] }
    --topoSort' :: State (TopoSearchState a) ()
    topoSort' = mapM_ dfs (nodes g)
    --dfs :: a -> State (TopoSearchState a) ()
    dfs n = do
      tss <- get
      let vs = visited tss
      unless (n `S.member` vs) $ do
        put $ tss { visited = n `S.insert` vs }
        mapM_ dfs $ adj g n
        newTss <- get
        put $ newTss { sorted = n : (sorted newTss) }

      
testGraph = Graph $ M.fromList
  [
    ("undershorts", ["shoes", "pants"]),
    ("pants", ["shoes", "belt"]),
    ("shirt", ["belt", "tie"]),
    ("tie", ["jacket"]),
    ("belt", ["jacket"]),
    ("socks", ["shoes"]),
    ("watch", [])
  ]

main = print $ topoSort testGraph

PS: кто-нибудь помнит, как там можно было объяснить компилятору, что a в объявлении типа в where — это то же самое a, что и в объявлении типа самой функции? Я помню, что когда-то сталкивался и как-то это решал, но как — совсем не помню.

Пока писал всякие глупости на Хаскелле, понадобилась функция, которая разбивает заданный список на много списков, «разрезая» между теми парами элементов, которые удовлетворяют некоторому отношению (заданному функцией типа a -> a -> Bool).

На удивление, я протупил над этой задачкой дольше, чем преполагал. Получилось терпимо, но не сверх-красиво. Посему объявляю code golf: хочу видеть красивые, элегантные решения. Можно и не на Хаскелле.

Желаемая функция такова: splitBetween :: (a -> a -> Bool) -> [a] -> [[a]]

Тест 1 (корректность): splitBetween (\a b -> b-a > 10) [1,3,4,5,16,27,29,34,59,60]
Результат: [[1,3,4,5],[16],[27,29,34],[59,60]]

Тест 2 (ленивость): take 5 $ splitBetween (\a b -> b-a > 10) $ cycle [1,5,16,27,29,34,60]
Результат: [[1,5],[16],[27,29,34],[60,1,5],[16]]

Моё решение:

splitBetween :: (a -> a -> Bool) -> [a] -> [[a]]
splitBetween p as = map (map fst) $ spanAll (not.snd) $ zip as (False : zipWith p as (tail as))

spanAll :: (a -> Bool) -> [a] -> [[a]]
spanAll _ [] = []
spanAll _ [a] = [[a]]
spanAll pred (l:ls@(_:_)) = let (as, bs) = span pred ls
                              in (l:as) : spanAll pred bs

Update: добавил тест на ленивость.
Update': мой пост в Bay Area HUG mailing list, завтра там могут появиться чьи-то решения.

Есть ли макрос, аналогичный letrec их scheme или аналог declare, но работающий внутри let?
Через def рекурсивное определение работает нормально:

(declare z)
(def x (cons 1 (lazy-seq (map + x z))))
(def z (cons 1 x))

А через let не компилируется: (let [a (cons 1 (lazy-seq (map + a (cons 0 a))))] (take 17 a))

В ходе обсуждения я нашёл одно простое соотношение между алгебрами и коалгебрами. Раньше его нигде не видел, поэтому надо выложить. Вообще объявляется розыск учебника по F-алгебрам, F-коалгебрам и (F,G)-диалгебрам. По всем темам есть сносные учебники, по этой как-то глухо.

Для начала вспомним, что такое гомоморфизм.



a0 a1 : F-алгебра
h является гомоморфизмом из a0 в a1 := диаграмма слева коммутирует
ca0 ca1 : G-коалгебра
h является гомоморфизмом из ca0 в ca1 := диаграмма справа коммутирует

Предположим, что G и F сопряжены. Для конкретности можно взять декартову замкнутую категорию, некоторый объект I и
G A := I⇒A
F A := I×A
Среди нескольких эквивалентных определений сопряжения мне понадобится то, которое опирается на естественный изоморфизм hom-множеств ⟨curry,uncurry⟩ (смотри определение в Википедии). curry я буду использовать как абстрактный естественный изоморфизм, но его для конкретности можно понимать и как функцию языка программирования Haskell. Я буду говорить, что x и y связаны, если y = curry x или эквивалентно uncurry y = x, и обозначать это x~y.

Предположим, что алгебры и коалгебры связаны: a0~ca0 и a1~ca1. В конкретном случае это значит, что алгебра и коалгебра связаны каррингом, то есть заданы по сути одной и той же функцией.

⟨curry,uncurry⟩ должен быть естественным, и его естественность эквивалентна коммутации диаграммы из Википедии. Изоморфизмы вверху и внизу диаграммы есть не что иное, как «связь» (~). Диаграмму другими словами можно описать так: если некоторые элементы
a ∈ hom (F Y) X
ca ∈ hom Y (G X)
связаны (a~ca), то их образы вниз (по правому и левому морфизмам) тоже связаны. Остаётся разобраться, что делают правый и левый морфизмы. Определение hom-функтора:
(hom (F g) f) := λa. f∘a∘(F g)
(hom g (G f)) := λa. (G f)∘a∘g
Если a~ca, то:

• если принять f:=id и g:=h, получим a∘(F h) ~ ca∘h;
• если принять f:=h и g:=id, получим h∘a ~ (G h)∘ca.

Это верно для обеих алгебр и коалгебр:
a0∘(F h) ~ ca0∘h
h∘a0 ~ (G h)∘ca0
a1∘(F h) ~ ca1∘h
h∘a1 ~ (G h)∘ca1

Заметно, что перечисленные выше морфизмы являются кусочками диаграмм (*). Если диаграмма слева коммутирует, то h∘a0 = a1∘(F h), то (исходя из того, что (~) есть биекция) (G h)∘ca0 = ca1∘h, то диаграмма справа коммутирует. Импликация наоборот доказывается симметрично. Таким образом:
h является гомоморфизмом из a0 в a1 ↔ h является гомоморфизмом из ca0 в ca1

Факт пожалуй элементарен и поэтому не очень интересен. (Слава Богу, и доказательство элементарно.) Факт говорит о некоторой эквивалентности: что можно выразить F-алгебрами, то можно выразить и F-коалгебрами.

Чето походу статья про DSL особо никому не приглянулась: комментариев нет, реакция в инете нулевая (за исключением недовольного ворчания archimag'a в своем блоге. Ну да архимаг известный брюзга: continuations в вебе архаизм, DSL застрял в середине 80-ых, и так далее :))

Ладно, в таком случае я попытаюсь поменять формат подачи информации. Вместо длинных статей, которые нужно "осиливать", буду регулярно прямо в блог постить удачные (на мой взгляд) примеры применения DSL и микро-DSL в CL. Как говорится, пусть код говорит сам за себя :)

Начнем с недавней задачки.

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

(defun move-valid-p (field row col value) (flet ((find-in-rect (y h x w) (iter (for i from y below (+ y h)) (iter (for j from x below (+ x w)) (for v = (aref field i j)) (when (and (or (/= i row) (/= j col)) (/= v 0) (= v value)) (return-from find-in-rect t)))) nil)) (not (or (find-in-rect row 1 0 9) (find-in-rect 0 9 col 1) (find-in-rect (- row (mod row 3)) 3 (- col (mod col 3)) 3)))))

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

(defvalidator sudoku-valid-p ((field 9 9) r c v) (no-value v in row) (no-value v in column) (no-value v in ninth))

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

(defvalidator queens-valid-p ((field 8 8) r c v) (value 0 in row) (value 0 in column) (value 0 in lt-diagonal) (value 0 in lb-diagonal))

В данном случае, на поле у нас "1" -- стоит ферзь, "0" -- ферзя не стоит. Проверка queens-valid-p проверяет, что данный ферзь в клетке (r, c) никому не угрожает.

А теперь, комфортно описав правила для проверок на DSL, давайте сбрутфорсим соответствующие поля.

Вот судоку:

DSL-TEST> (bruteforce-field (fld (9 9) sudoku-valid-p) (iter (for i from 1 to 9) (try i))) #2A((1 2 3 4 5 6 7 8 9) (4 5 6 7 8 9 1 2 3) (7 8 9 1 2 3 4 5 6) (2 1 4 3 6 5 8 9 7) (3 6 5 8 9 7 2 1 4) (8 9 7 2 1 4 3 6 5) (5 3 1 6 4 2 9 7 8) (6 4 2 9 7 8 5 3 1) (9 7 8 5 3 1 6 4 2))

Вот ферзи:

DSL-TEST> (let ((queens 8)) (bruteforce-field (fld (8 8) queens-valid-p) (decf queens) (try 1) (incf queens) (and (next) (zerop queens)))) #2A((1 0 0 0 0 0 0 0) (0 0 0 0 1 0 0 0) (0 0 0 0 0 0 0 1) (0 0 0 0 0 1 0 0) (0 0 1 0 0 0 0 0) (0 0 0 0 0 0 1 0) (0 1 0 0 0 0 0 0) (0 0 0 1 0 0 0 0))

Просто, понятно, красиво. Как работает? По описанию DSL генерируется лукап-таблица размером с поле, в каждой клетке которой строится подобного вида функция:

(LAMBDA (FIELD R C V) (DECLARE (IGNORABLE FIELD R C V) (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)) (TYPE (SIMPLE-ARRAY FIXNUM (8 8)) FIELD) (TYPE FIXNUM V)) (AND (ZEROP (AREF FIELD 0 1)) (ZEROP (AREF FIELD 0 2)) (ZEROP (AREF FIELD 0 3)) (ZEROP (AREF FIELD 0 4)) (ZEROP (AREF FIELD 0 5)) (ZEROP (AREF FIELD 0 6)) (ZEROP (AREF FIELD 0 7)) (ZEROP (AREF FIELD 1 0)) (ZEROP (AREF FIELD 1 1)) (ZEROP (AREF FIELD 2 0)) (ZEROP (AREF FIELD 2 2)) (ZEROP (AREF FIELD 3 0)) (ZEROP (AREF FIELD 3 3)) (ZEROP (AREF FIELD 4 0)) (ZEROP (AREF FIELD 4 4)) (ZEROP (AREF FIELD 5 0)) (ZEROP (AREF FIELD 5 5)) (ZEROP (AREF FIELD 6 0)) (ZEROP (AREF FIELD 6 6)) (ZEROP (AREF FIELD 7 0)) (ZEROP (AREF FIELD 7 7))))

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

(DEFUN QUEENS-VALID-P (FIELD R C V) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)) (TYPE (SIMPLE-ARRAY FIXNUM (8 8)) FIELD) (TYPE (INTEGER 0 7) R) (TYPE (INTEGER 0 7) C) (TYPE FIXNUM V)) (FUNCALL (ELT #:G21743 (+ (* R 8) C)) FIELD R C V)))

g21743 -- это таблица.

Заметьте: все типы аккуратно промаркированы размерностями. Это оно само так получилось, мы же задали ширину/высоту поля в defvalidator ;) Любители зависимых типов должны оценить. Все что на этапе компиляции мы знаем, все можно совершенно свободно использовать во благо.

Ну и код компилятора:

(defmacro defvalidator (name ((field width height) row col value) &rest clauses) (with-gensyms (lookup-table) ;; build lookup table (multiple-value-bind (lookup-rules table) (validator-clauses->rules field width height clauses) (flet ((lookup-builder (r c) (clrhash table) (iter (for rule in lookup-rules) (funcall rule r c)) (iter (for (cnd (cnd-r cnd-c)) in-hashtable table) (unless (and (= r cnd-r) (= c cnd-c)) (collect (list (+ (* cnd-r width) cnd-c) cnd) into cnds)) (finally (return `(lambda (,field ,row ,col ,value) (declare (ignorable ,field ,row ,col ,value) (optimize (speed 3) (safety 0) (debug 0)) (type (simple-array fixnum (,height ,width)) ,field) (type fixnum ,value)) (and ,@(mapcar #'second (sort cnds #'< :key #'first))))))))) ;; declare function `(let ((,lookup-table ,(validator-build-lookup-table width height #'lookup-builder))) (declare (type (simple-vector ,(* height width)) ,lookup-table)) (defun ,name (,field ,row ,col ,value) (declare (optimize (speed 3) (safety 0) (debug 0)) (type (simple-array fixnum (,height ,width)) ,field) (type (integer 0 ,(1- height)) ,row) (type (integer 0 ,(1- width)) ,col) (type fixnum ,value)) (funcall (elt ,lookup-table (+ (* ,row ,width) ,col)) ,field ,row ,col ,value))))))) (defun validator-clauses->rules (field width height clauses) (iter (with table = (make-hash-table :test 'equal)) (for (op op-value in-kw where) in clauses) (assert (eq in-kw 'in)) (for builder = (validator-builder op op-value field)) (collect (validator-where where width height (lambda (r c) (setf (gethash (funcall builder r c) table) (list r c)))) into rules) (finally (return (values rules table))))) (defun validator-builder (op op-value field) (lambda (row col) (ecase op (no-value `(/= (aref ,field ,row ,col) ,op-value)) (value (if (eql op-value 0) `(zerop (aref ,field ,row ,col)) `(= (aref ,field ,row ,col) ,op-value)))))) (defmacro-driver (FOR var AS-SEGMENT start - end &sequence) (declare(with-gensyms (step from to i) (let ((kwd (if generate 'generate 'for))) `(progn (with ,from = ,start) (with ,to = ,end) (with ,step = (if (<= ,from ,to) ,iterate::by (- ,iterate::by))) (with ,i = (- ,from ,step)) (,kwd ,var next (progn (incf ,i ,step) (when (= ,i (+ ,to ,step)) (terminate)) ,i)))))) (defun validator-where (where width height builder) (flet ((rect (y h x w) (iter (for i from y below (+ y h)) (iter (for j from x below (+ x w)) (funcall builder i j)))) (diag (x-0 y-0 x-1 y-1) (iter (for i as-segment y-0 - y-1) (for j as-segment x-0 - x-1) (when (and (<= 0 i (1- height)) (<= 0 j (1- width))) (funcall builder i j))))) (lambda (row col) (ecase where (row (rect row 1 0 width)) (column (rect 0 height col 1)) (ninth (let ((w (/ width 3)) (h (/ height 3))) (rect (- row (mod row h)) h (- col (mod col w)) w))) (lt-diagonal (diag (- 0 row height) (- 0 col width) (+ row height) (+ col width))) (lb-diagonal (diag (+ row height) (- col width) (- row height) (+ col width))))))) (defun validator-build-lookup-table (width height where-collector) `(coerce (list ,@(iter main (for i from 0 below height) (iter (for j from 0 below width) (in main (collect (funcall where-collector i j)))))) 'simple-vector)) (defmacro bruteforce-field ((field (width height) valid-checker) &body body) (with-gensyms (bruteforce r c) `(let ((,field (make-array '(,height ,width) :initial-element 0))) (labels ((,bruteforce (,r ,c) (macrolet ((next () `(,',bruteforce (+ ,',r (truncate (/ (1+ ,',c) ,',width))) (mod (1+ ,',c) ,',width))) (try (value) `(progn (setf (aref ,',field ,',r ,',c) ,value) (when (and (,',valid-checker ,',field ,',r ,',c ,value) (next)) (return-from ,',bruteforce t)) (setf (aref ,',field ,',r ,',c) 0)))) (if (>= ,r ,height) t (progn ,@body))))) (,bruteforce 0 0) ,field))))

Получено подтверждение от Майка Шульмана:

What you call an “f-category” looks like essentially the same as a vertically-chaotic double category which is a proarrow equipment / framed bicategory.

Теперь, если следовать логике его статьи, получается, что отношения в онтологиях это не совсем стрелки, а скорее объекты, притворившиеся стрелками :) Конечно, с моей стороны это спекуляция, но интересно.

Месяц бьюсь с железкой, выжимаю такты. Любимое дело - переписать кусок на ассемблере, понаставить rdtsc, собрать тайминги, строить gnuplot'ом графики и любоваться.

Накопил забавного экспириенса...

Например, жила-была структура размером 32 байта. Ради ускорения добавил 8 байт, в которые при инициализации структуры пишу предварительно посчитанные коэффициенты, чтобы в основной логике не считать их каждый раз. Ну, стандартный, в общем, подход. Профит? Нифига! Количество попаданий в первый наносекундный интервал упало в... Нет! Просто рухнуло, в 2.5 раза. Попадание во второй, правда, подросло, но в 2.5 хуже в первом - это катастрофа. Выравнивание до 64 байт и префетч в нужном месте дела значительно улучшили, но до исходного варианта всё равно сильно не дотягивает.

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

Другой случай: одна боевая итерация обработки данных безбожно жрёт такты. Все выделяемые куски логики обмеренны отдельно, сложены, сумма в 10 раз меньше, чем имеем на деле для всего. Тестовая итерация жрёт нормально, мало. В тестовом варианте данные сосутся из файла, в боевом - те же данные, но из raw-сокета, всего одно отличие. Только на каждое чтение из сокета каждый пакет протаскивается через все кишки ядра, которые нагло и беспардонно выбрасывают из кэша заботливо префетченные руками данные. А при чтении из файла libc делает буферизацию, уменьшая общее число сисколлов. Ну и сам код файловой системы, судя по всему, попроще, чем сетевой.

Самое паршивое, что такая фигня чисто аналитически понимается. Полдня и целый вечер мучался, думал.

Третий случай: у меня ноут со стареньким Core2Duo T5600, одна удалённая машина какой-то Феном, другая i7 (Nehalem). На всех трёх результаты микрооптимизаций часто дают противоположный эффект :)


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

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

Оказывается, операции ∇ и Δ отсюда - это действительно proarrow equipment (см. "definition as a double category"). И опять я обязан поблагодарить ghbdtn, он подсказал.

А ведь я про equipments уже писал. Где были мои глаза?

Пусть у нас есть хорошая (как минимум с прямыми произведениями) категория C. Назовем морфизм A*S -> B*S автоматом (для C == Fin получаются конечные автоматы). Эта конструкция напоминает монаду State, но в данном случае мы не фиксируем S.
Из автоматов можно получить две новые категории.
В первой (пуст она называется CA) объектами будут обекты C, а автоматы - морфизмами. Композикия морфизмов A*S1 -> B*S1 и B*S2 -> С*S2 будет в C выражена морфизмом A*(S1*S2) -> C*(S1*S2). Правда эта категория перестает быть малой - Hom(A,B) уже могут не образовывать множество.
Во второй (CF) объекты будут автоматами, а морфизмами - тройки морфизмов A1 -> A2, S1 -> S2 и B1 -> B2, для которых соответственная диаграмма будет коммутативной.
Интересно, есть ли связь между этими категориями?
В этих категориях можно попробовать "упростить" автомат. В CA разделить его на два последовательно выполняющихся, а в CF - рассмотреть факторавтомат, который моделирует работу исходного, забывая некоторые подробности.
То есть для автомата X (A -> B) особенно интересны эпиморфизмы CF из X в композиции морфизмов из CA с одной стороны и мономорфизмы CF из X с другой. Возможно, что у этих конструкций есть что-то объщее. В частности, они похоже описывают параллельно работающий автоматы (соединение A1*S1 -> B1*S1 и A2*S2 -> B2*S2 в (A1*A1)*(S1*S2) -> (B1*B2)*(S1*S2) ).

Создадим проект со следующим деревом каталогов по классическому шаблону для Maven проектов:


Мавеновский pom.xml выглядит следующим образом:

    4.0.0

    test.clojure
    TestClojure
    1.0-SNAPSHOT

    
                    
            
                com.theoryinpractise
                clojure-maven-plugin
                1.1
                
                    
                        src/main/clojure
                    
                    
                        !telchat.app
                    
                    


                
            
        
    

    
        
            org.clojure
            clojure
            1.2.0
        
    

    
        
          clojure-releases
          http://build.clojure.org/releases
        
        
          clojars
          http://clojars.org/repo/
        
        

Далее наполняем Hello.clj следующим содержанием:

(ns example.clojure.hello.Hello
  (:gen-class
    :methods [[sayHello[] void]
               [sayHello[String] void]
               [callFunction[clojure.lang.IFn] String]]))

(defn -sayHello
  ([this] (println "Hello, stranger!"))
  ([this name] (println (str "Hello, " name "!"))))

(defn -callFunction [this javaFunction]
  (javaFunction (str "Vasya" "!")))

Класс Function - абстрактный. Он реализует интерфейс clojure.lang.IFn следующим образом:

import clojure.lang.IFn;
import clojure.lang.ISeq;

public abstract class Function implements IFn {

    @Override
    public Object invoke() throws Exception {
        return doInvoke();
    }

    @Override
    public Object invoke(Object o) throws Exception {
        return doInvoke(o);
    }

    @Override
    public Object invoke(Object o, Object o1) throws Exception {
        return doInvoke(o, o1);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2) throws Exception {
        return doInvoke(o, o1, o2);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3) throws Exception {
        return doInvoke(o, o1, o2, o3);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4) throws Exception {
        return doInvoke(o, o1, o2, o3, o4);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15, Object o16) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15, Object o16, Object o17) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16, o17);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15, Object o16, Object o17, Object o18) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16, o17, o18);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15, Object o16, Object o17, Object o18, Object o19) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16, o17, o18, o19);
    }

    @Override
    public Object invoke(Object o, Object o1, Object o2, Object o3, Object o4, Object o5, Object o6, Object o7, Object o8, Object o9, Object o10, Object o11, Object o12, Object o13, Object o14, Object o15, Object o16, Object o17, Object o18, Object o19, Object... objects) throws Exception {
        return doInvoke(o, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16, o17, o18, o19, objects);
    }

    @Override
    public Object applyTo(ISeq iSeq) throws Exception {
        return null;
    }

    @Override
    public Object call() throws Exception {
        return doInvoke();
    }

    @Override
    public void run() {
        doInvoke();
    }

    public abstract Object doInvoke(Object... obj);
}

public class MyJavaFunction extends Function {

    @Override
    public Object doInvoke(Object... obj) {
        System.out.println("Function call from Java!");
        System.out.println(String.format("Hello, %s", obj[0]));
        return "JAVA FUNCTION WORK SUCCESS!";
    }
    
}

Отлично. Теперь собираем все воедино в классе Greeting:

import example.clojure.hello.Hello;

public class Greeting {

    public static void main(String[] args) {
        Hello hello = new Hello();
        if(args.length == 0) {
            hello.sayHello();
        } else {
            hello.sayHello(args[0]);
        }

        Function fun = new MyJavaFunction();
        String result = hello.callFunction(fun);
        System.out.println(result);
    }
}

Для того, чтобы собрать проект и упаковать его в jar нужно выполнить следующую команду:

mvn clean clojure:compile install

Чтобы запустить класс Greeting нужно выполнить команду:

java -cp target/TestClojure-1.0-SNAPSHOT.jar:lib/clojure-1.2.0.jar Greeting

или

java -cp target/TestClojure-1.0-SNAPSHOT.jar:lib/clojure-1.2.0.jar Greeting Vasya

(Я запускал под Linux. Символ разделения ':' в Windows другой - ';')

После выполнения вы должны увидеть что-то наподобие такого:


Hello, stranger!
Function call from Java!
Hello, Vasya!
JAVA FUNCTION WORK SUCCESS!

Коллеги,

А нет ли у нас страндартного способа пропустить некоторое значение через список(ну или любой Seq) функций? То есть что-бы на выходе было f1(f2(f3(..(x)..))).

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

Обновил документацию на RESTAS - добавил API Reference. Теперь все упоминания каких-либо функций или макросов превратились ссылки на соответствующее описание в API Reference. А что бы документация не отличалась от текущий возможностей сделал версию 0.0.10.

Ну и пара слов о cl-sphinx, с помощью которой я делаю документацию. Немного допилил её для обеспечения ссылок на определения, теперь можно в одном месте вставить, например, описание функции:

.. defun:: restas:reconnect-all-routes
  :args:

  Реинициализирует диспетчер запросов. и т.п.

а в других ссылаться на это определение с помощью

:fun:`restas:reconnect-all-routes`

Получается очень удобно и просто.

Вот так в emacs'е можно закрыть все буфера tramp'а. Чтобы не искать руками в ibuffer, просто набираем M-x kill-tramp-buffers. Иногда мне это нужно, чтобы не путаться, на какой машине я редактирую сейчас файлы, переходя от одной машине к другой.

;;; a shortcut to kill all tramp buffers at once
;;;
(require 'ibuffer)

(defun tramp-buffer-p (buf)
  "is this buffer tramp's one"
  (or (string-match "^\\*tramp" (buffer-name buf))
      (tramp-tramp-file-p (with-current-buffer buf
                            (ibuffer-buffer-file-name)))))

(defun kill-tramp-buffers ()
  "kill all TRAMP buffers"
  (interactive)
  (dolist (buf (buffer-list))
    (when (tramp-buffer-p buf)
      (kill-buffer buf))))

http://github.com/Lovesan/pastebin.com-api
не спрашивайте, зачем

{-# LANGUAGE FlexibleContexts,TypeSynonymInstances,FlexibleInstances,MultiParamTypeClasses #-}
module LiveJournal.GetEvents where

import LiveJournal.Transport
import LiveJournal.ResponseParser
import LiveJournal.Session
import LiveJournal.Entity
import LiveJournal.Error
import LiveJournal.Request

import Data.DateTime
import Data.Maybe
import Data.Map as DM
import Data.Array as DA
import Data.Word

import Control.Monad

import Codec.Binary.Url as U
import Codec.Binary.UTF8.String as SU

data SelectType = Day { year, month, day :: Int } |
                  Sync { lastSync :: String } |
                  LastN { howMany :: Int, 
                          beforeDate :: Maybe String } |
                  One { itemId :: String }

data LJLineEndings = Unix | PC | Mac | Space | Dots deriving ( Show, Eq, Ord, Enum, Bounded, Ix )
lineEndingMapping = listArray ( minBound, maxBound ) ["unix", "pc", "mac", "space", "dots"] :: Array LJLineEndings String

data LJEventSecurity = Public | Private | UserMask { userMask :: Int } deriving ( Show )

data LJEventProperty = EventProperty { eventPropName, eventPropValue :: String } deriving ( Show )

data LJEvent = Event {  eventId :: String, 
                        eventTime :: DateTime,
                        eventText :: String,
                        eventSecurity :: LJEventSecurity,
                        eventSubject :: String,
                        eventPoster :: String,
                        eventANum :: String,
                        eventUrl :: String, 
                        eventProperties :: [LJEventProperty]
                      } |
                PropertyContainer { pItemId, pName, pValue :: String } deriving ( Show )

epoch = fromSeconds 0

eventObjectFactory :: ObjectFactory LJEvent
eventObjectFactory "events" = Just $ Event "" epoch "" Public "" "" "" "" []
eventObjectFactory "prop" = Just $ PropertyContainer "" "" ""
eventObjectFactory _ = Nothing

eventObjectUpdater :: ObjectUpdater LJEvent
eventObjectUpdater "events" "itemid" value obj = Just $ obj { eventId = value }
eventObjectUpdater "events" "eventtime" value obj = Just $ obj { eventTime = fromMaybe epoch (parseDateTime "" value) }
eventObjectUpdater "events" "event" value obj = Just $ obj { eventText = decodeUTF8 value }
eventObjectUpdater "events" "security" "private" obj = Just $ obj { eventSecurity = Private }
eventObjectUpdater "events" "security" "public" obj = Just $ obj { eventSecurity = Public }
eventObjectUpdater "events" "security" _ obj = Just obj
eventObjectUpdater "events" "allowmask" value obj = Just $ obj { eventSecurity = UserMask $ read value }
eventObjectUpdater "events" "subject" value obj = Just $ obj { eventSubject = decodeUTF8 value }
eventObjectUpdater "events" "poster" value obj = Just $ obj { eventPoster = value }
eventObjectUpdater "events" "anum" value obj = Just $ obj { eventANum = value }
eventObjectUpdater "events" "url" value obj = Just $ obj { eventUrl = value }

eventObjectUpdater "prop" "itemid" value obj = Just $ obj { pItemId = value }
eventObjectUpdater "prop" "name" value obj = Just $ obj { pName = value }
eventObjectUpdater "prop" "value" value obj = Just $ obj { pValue = value }


decodeUTF8 :: String -> String
decodeUTF8 = maybe "Encoding error" SU.decode . U.decode

instance ResponseTransformer LJEvent [LJEvent] where
    transform (simpleMap, enumMap, objectMap) = makeResult $ maybe [] createList (DM.lookup "events" objectMap)
        where
            propsMap = DM.fold makeProps DM.empty $ fromMaybe DM.empty $ DM.lookup "prop" objectMap
            makeProps propItem = DM.alter ( alterProp propItem ) ( pItemId propItem )
            alterProp propItem Nothing = Just [ makeLJEventProperty propItem ]
            alterProp propItem (Just arr) = Just $ makeLJEventProperty propItem : arr
            makeLJEventProperty ( PropertyContainer pId pName pValue ) = EventProperty pName pValue
            createList = DM.fold traverse []
            traverse ljEvt res = update ljEvt : res
            update ljEvt = fromMaybe ljEvt $ do 
                                let ljEvtItemId = eventId ljEvt
                                props <- DM.lookup ljEvtItemId propsMap
                                return $ ljEvt { eventProperties = props }

getEvents :: Session -> String -> Maybe Int -> Bool -> Bool -> SelectType -> LJLineEndings -> IOResult [LJEvent]
getEvents session username truncate preferSubject noMetadata selectType lineEndings = 
    runRequestSession session request (CRP eventObjectFactory eventObjectUpdater)
    where
        request = makeRequest $ [ ("mode", "getevents") ] ++
                    [ ("user", username ) ] ++
                    [ ("ver", "1") ] ++
                    maybe [] ( (:[]) . (,) "truncate" . show ) truncate ++
                    [   makeBool "prefersubject" preferSubject,
                        makeBool "noprops" noMetadata ] ++ 
                    makeSelectType selectType ++
                    [ ("lineendings", lineEndingMapping DA.! lineEndings) ] ++
                    [ ("usejournal", username) ]
        makeBool name True = ("name","1")
        makeBool name False = ("name","0")
        makeSelectType (Day yy mm dd) = [ ("selecttype","day") ,
                                          ("year", show yy) ,
                                          ("month", show mm) ,
                                          ("day", show dd)
                                        ]
        makeSelectType ( LastN howMany beforeDate ) = [ ("selecttype", "lastn") ,
                                                        ("howmany", show howMany ) ] `mplus` 
                                                      maybe [] ( (:[]) . (,) "beforedate" ) beforeDate
        makeSelectType ( One itemId ) = [ ("selecttype", "one") ,
                                        ("itemid", itemId ) ]
        makeSelectType ( Sync lastSyncP ) = [ ("selecttype","syncitems") ,
                                              ("lastsync", lastSyncP)
                                            ]


Хочется критики и комментариев, где что сделать покороче и поправильнее.

Председатель програмного коммитета Стас Фомин позвал меня выступить 23-24 сентября в Ярославле на Application Developer Days 2010. Если соберетесь съездить туда, то от 6000 р цены за участие вам скинут 5% по кодовому слову «maxidoors»


Я буду рассказывать про то, что на erlang писать гораздо удобнее и эффективнее, чем на … Приходите, послушаете.

Выгода от «неизменяемости данных по умолчанию» очевидна — не надо бояться передавать сложные структуры данных «вниз» в функции. Можно собирать данные в коллекции, модифицировать нещадно, не боясь сайд-эффектов; упрощается чтение кода и его peer-review. Кстати, я не сказал явно об этом в своём отчёте о выступлении на MarginCon, так что сейчас скажу. Едва ли не самая главная выгода в использовании Erlang в командной разработке в том, что неизменяемость данных упрощает код-ревью: программисты эту выгоду ясно видят и приветствуют. Ошибки, связанные с тем, что где-то там какую-то структуру изменили тихой сапой, а в другом месте про это не узнали, не появляются. Отладка появления «тонких» эффектов в коде не представляет проблемы, ибо тонкие эффекты не отсвечивают.

Но тут мы налетели на совершенно глупую вещь, связанную с неизменяемыми структурами данных. Была у нас некая структура развесистая: скажем, репрезентация пользователя. Обычный A[lgebraic]DT. И ещё было дерево, по которому нужно было «протаскивать» эту структуру в качестве образца и стричь с листьев этого дерева некие данные. Особенностью хождения по дереву было то, что в узлах могли содержаться инструкции, модифицирующие репрезентацию юзера локально, для подветвей дерева.

Пока репрезентация юзера была выражена в ADT, проблем не возникало — в каждом узле, требующем той или иной модификации, мы нужную модификацию производили, а затем рекурсивно шли в поддерево уже с новым значением. И главный цимес был в персистентности структуры: при модификации некоторой небольшой части структуры ADT остальное мясо структуры не меняется, а значит из-за отсутствия глубокого копирования лишней нагрузки на CPU и сборщик мусора не происходит. Персистентность и неизменяемость данных — замечательные вещи. По большому счёту, именно из-за них мы перешли с C++ на OCaml, и именно из-за них OCaml код для наших задач работает быстрее.

На C++ (или на Питоне, скажем) можно такую задачу решать двумя способами: медленным и грязным. Медленный способ заключается в том, что мы в узле копируем объект, новую копию изменяем, и передаём рекурсивно алгоритму поиска в глубину. Эдак дороже чем на счётах посчитать получится: изнашиваются cache lines, аллокатор, копируется большой объём данных. Структура-то развесистая, а дерево-то тоже не маленькое — сотни тысяч узлов. Грязный способ заключается в том, что модификатор развесистой структуры не просто делает модификацию объекта, но и умеет запоминать предыдущее значение, и восстанавливать его после обработки поддерева. Как-то так:

modify_and_traverse_further(User *user, Tree *subtree, enum modification) {
  switch (modification) {
  case OverrideName:
    Name *old_name = get_user_name(user);
    set_user_name(user, new_name);
    result = traverse(subtree, user);
    set_user_name(user, old_name);
    return result;
  }
}

Казалось бы, неплохой выход, но представим, что

• traverse может выкинуть исключение,
  
• модификация может заключаться в установке и изменении многих полей единовременно,
  
• пользователь может быть уже в какой-то структуре данных (хэше?) с позицией (ключём), зависящей от модифицируемого поля,
  
• таких функций с разными modification может быть очень много, и абстрагируются они неважнецки (можно попробовать сделать генеральный интерфейс типа set_field_and_return_lambda4undo, для иронии, но упрёмся в upwards funarg problem),

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

Так вот, пока пользовательская структура была представлена ADT, мы с успехом и удовольствием использовали персистентность и неизменяемость данных для получения лаконичного и краткого кода (скобки после функции даны для тех, кто не привык считать пробел оператором):

modify_and_traverse (user, subtree) = function
    OverrideName new_name →
        let new_user = set_user_name (user, new_name) in
        traverse (subtree, new_user)

Гром грянул неожиданно: нам необходимо стало особым образом сериализовать этого пользователя. Заменили репрезентацию пользователя с вручную написанной ADT на иерархию классов, порождённую Трифтовым компилятором. А интерфейс окамлового кода, который генерируется Thrift'овым компилятором, был слизан с сишного, то есть оперировал развесистыми классами с изменяемыми полями. Про Thrift я уже недовольно бурчал, но этот фактоид не упоминал ещё.

Ну и, в качестве гвоздя в крышку гроба, от недостаточного знания окамла у нас кто-то решил, что Oo.copy хватит для порождения производного объекта, который можно форвардить вниз по дереву. О боже, что тут было. Нет, ничего не сломалось сразу, потому что неправильное поведение можно было выловить только при определённой конфигурации дерева. И нет, на это не было юнит-тестов, потому что до перевода структуры на Thrift рельсы подразумевалось, что в этой части кода ошибок быть не может по построению. В итоге, проблема пару недель жила незамеченной в продакшне. Голова серая от пепла, да.

Пришлось срочно писать генератор deep-copy методов в Thrift, потому что их там тупо не было. Ну вот как, скажите мне, изначальному автору OCaml-генератора в Трифте можно было быть пользователем функционального языка OCaml, и, во-первых, не сделать генератора иммутабельных интерфейсов, породя вместо этого какую-то имперосятину, а во-вторых, не настрогать deep-copy методов, жизненно важных для имплементации в подобном стиле?!

Что можно вынести из этого эпоса — использование такого мощнейшего и перспективного™ инструмента функционального программирования, как неизменяемость данных, расслабляет настолько, что сложно становится потом жить в зубастом реальном мире, полном императивной каши и лапши. Инстинкты теряются. Всё-таки, программирование в чисто функциональном стиле расслабляет!

Патч здесь: https://issues.apache.org/jira/browse/THRIFT-860

data Property = Prop { name, value :: String }

data Object = Obj { nameProperty :: Property }

и вот простого и красивого способа обновить nameProperty с новым value для Prop - нет, есть через жопу или через вуду fclabels, которое выштыривает весь API для работы с ним, да еще и Template Haskell докучи

грусть и тоска

(эпиграфом к посту служит цитата из ильфа и петрова, упомянутая plumqqz при обсуждении системы типов F#)

Так вот, по мотивам того обсуждения - как соотносятся метапрограммирование и зависимые типы? Мне что-то с ходу мерещится что зависимые типы можно имитировать, имея развитые средства метапрограммирования. Скорее всего, это будет адский закат солнца вручную (во всяком случае, у меня кодогенератор C# из модели БД выглядит именно так) но тем не менее, это должно быть возможно.

Написал каркас для всех будущих компрессоров и декомпрессоров в своей новой библиотеке.
А именно, обобщенную функцию process-data.
http://paste.lisp.org/display/113729

Выглядит она, в общем виде, так:

process-data (data-processor input output &rest keys &key)
  => n-bytes-read, n-bytes-written

Несмотря на то, что все алгоритмы внутри библиотеки будут работать только с битовыми потоками, в input и output функции могут поставляться не только они, но также и обычные потоки, которые работают с данными типа (unsigned-byte 8), и последовательности - в случае input - любая последовательность, которая может быть преобразована(COERCE) в (simple-array (unsigned-byte 8) (*)), а в случае output - любая, которая может (unsigned-byte 8) в себе хранить.

В таких случаях, внутри методов process-data, input и output сначала магическим образом превращаются в битовые потоки.

Но, тут есть такой нюанс. Дело в том, что, так как внутри библиотеки все алгоритмы работают с потоковыми данными, они совершенно не заботятся о случае когда в output поставляется последовательность.
Нюанс в том, что последовательность(в границах :start2 и :end2) может переполниться.

В этом случае process-data(а точнее, коллбэк битового потока-обертки) сигнализирует data-processor-output-sequence-overflow. В этом, в принципе, ничего страшного нет, потому что, во-первых, в слоты сигнала data-processor-output-sequence-overflow кладутся старая последовательность и границы записанных данных в ней, а во-вторых, в этом месте пользователю предлагается на выбор два рестарта - записать данные в новые границы выходной последовательности, или же поставить алгоритму новую.

В общем случае, функция будет работать до тех пор, пока один из ее методов знает, как из входных или выходных данных соответствующий битовый поток получить(если никакой метод не знает - сигнализируются data-processor-invalid-input/data-processor-invalid-output). И пользователь библиотеки в этом ей сможет помогать, например так:

(defmethod process-data (processor (input string) output
                         &rest keys &key (start1 0) end1)
  (check-type input base-string)
  (unless end1 (setf end1 (length input)))
  (let* ((stream-callback (lambda (buff)
                            (if (>= start1 end1)
                              0
                              (let ((n (min (- end1 start1)
                                            (length buff))))
                                (dotimes (i n)
                                  (setf (aref buff i)
                                        (char-code (aref input (+ start1 i)))))
                                (incf start1 n)
                                n))))
         (stream (make-input-bit-stream stream-callback)))
    (apply #'process-data processor stream output
           (remove-keys keys '(:start1 :end1)))))

Кстати, о количестве обработанных байт пользовательским методам беспокоиться не надо, об этом заботится :around метод, специализированный на (t input-bit-stream output-bit-stream).



Ну и чтоб два раза не вставать:
придумал для библиотеки некий аналог именованных каналов(named pipes) на битовых потоках:
http://paste.lisp.org/display/113730
Но, чувствую, это не вершина инженерной мысли, буду дальше над этим думать.

читаю вот книжку про Scala, понимаю - большинство вещей там читать неинтересно, после RWH. Ну разве что чтобы понимать всякие аналогии.

А вот кодить на Хаскеле почему-то удобнее, он более лаконичен, чтоли. И обычного vim+haskellmode вполне достаточно, особенно учитывая скорость комплияции scala и haskell

Пример из книги BeginningScala

def toInt(in: String): Option[Int] =
try {
Some(Integer.parseInt(in.trim))
} catch {
case e: NumberFormatException => None
}

def sum(in: Seq[String]) = {
val ints = in.flatMap(s => toInt(s))
ints.foldLeft(0)((a, b) => a + b)
}

println("Enter some numbers and press ctrl-D (Unix/Mac) ctrl-C (Windows)")
val input = Source.fromInputStream(System.in)
val lines = input.getLines.collect
println("Sum "+sum(lines))

Пробую запустить на scala 2.8

C:\>C:\DevTools\Scala-2.8.0\bin\scala Test.scala
(fragment of Test.scala):21: error: missing arguments for method getLines in class Source;
follow this method with `_' if you want to treat it as a partially applied function
val lines = input.getLines.collect
^

Пробовал вариант
val lines = input.getLines().collect() но я толком не могу понять какой параметр нужно указывать методу collect()

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

Обоснование будет состоять из нескольких частей:

1) предлагаемая реализация правил дистрибутивного лямбда-исчисления, которые заменяют бета-редукцию;
2) метод обнаружения новых эта-редексов;
3) доказательство достаточности начального состояния списка редексов для экстенсиональной нормализации вычисляемого выражения (при достаточной памяти и существованием бета-эта-н.ф.).

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

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

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

Напомним, какие ноды заносятся в список редексов до начала работы системы. Это все эта-редексы в произвольном порядке, все бета-редексы в порядке, диктуемом нормальной стратегией, но сразу после каждого бета-редекса R заносятся также ноды R M1, R M1 M2, … , R M, где M — вектор наибольшей длины n (возможно, нулевой), который удовлетворяет структуре контекста C[ ] редекса R. Подразумевается, что для R и всех элементов вектора M ноды, подлежащие занесению в список редексов, были или будут обработаны отдельно от цепочки аппликаций R M. Покажем, что начальное состояние списка редексов, подготовленное таким образом, достаточно для сохранения нормализующего свойства в реальном времени машиной с описанными ранее структурой и механизмами работы.

Так как вектор M имеет наибольшую длину, то контекст C[ ] может иметь лишь одну из следующих форм, где L есть некоторый терм, а C'[ ] — более внешний контекст:

1) C[ ] = C'[v: [ ]];
2) C[ ] = C'[L [ ]];
3) C[ ] = [ ].

При этом форма C'[[ ] L] невозможна, так как длина вектора M выбрана максимальной, а случай (3) тривиален.

Следует также отметить, что остальные ноды, кроме цепочки аппликаций R M, в контексте C'[ ] также обрабатываются отдельно. Этого достаточно потому, что редексом R могут порождаться новые бета-редексы лишь в подвыражении R M ввиду ограничения области создания новых бета-редексов телом абстракции в случае (1) и правой частью аппликации в (2).

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

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

1) (x: x) M = M (тождество);
2) (x: y) M = y (константа);
3) (x: y: M) N = y: (x: M) N (абстракция);
4) (x: M1 M2) N = (x: M1) N ((x: M2) N) (аппликация) [дублирование переменной может привести к потере эта-редексов и невозможности их нахождения по количеству использований переменной — требует отдельного рассмотрения; возможно, корректность обеспечивается тем, что переменная x уже не будет участвовать в эта-редексах, которые бы оставались после достижения бета-н.ф.].

Также напомним, что нормальная стратегия не является нормализующей для дистрибутивного лямбда-исчисления. Тем не менее, существует по крайней мере одна эффективная (рекурсивная) нормализующая стратегия для такой редукции — это так называемая внутренняя спиновая стратегия, которая отличается от нормальной лишь в выборе внутренней абстракции (x: M) N после редукции (3), даже если внешняя абстракция y: ((x: M) N) участвует в новом бета-редексе. Машина будет реализовывать некоторую вариацию этой стратегии, не слабее, чем теоретический прототип.

Итак, перейдем к описанию реализации каждого из правил. Возможные новые бета-редексы, появляющиеся в контекстах, использующих редуцируемую ноду, будут рассмотрены позднее. Следует иметь в виду, что замена ноды редекса на другую ноду сопровождается созданием дополнительного элемента списка ее использований. В каждом случае редекс как подвыражение удаляется. Под «созданием» ноды или (соответствующего) подвыражения подразумевается выделение не больше некоторого постоянного числа блоков памяти с увеличением количества использований участвующих подвыражений.

1. Нода редекса заменяется на ноду M. Текущий элемент списка редексов удаляется. Новых редексов в редуцируемом подвыражении не создается.

2. Нода редекса заменяется на ноду y. Текущий элемент списка редексов удаляется. Новых редексов в редуцируемом подвыражении не создается.

3. Создаются ноды x: M, (x: M) N и y: ((x: M) N), и нода редекса заменяется на последнюю. Текущий элемент списка редексов заменяется на (x: M) N, что диктуется внутренней спиновой стратегией. Больше новых редексов в получившемся подвыражении не создается.

4. Создаются ноды x: M1, x: M2, (x: M1) N, (x: M2) N и (x: M1) N ((x: M2) N), и нода редекса заменяется на последнюю. Перед текущим элементом списка редексов вставляется (x: M1) N [возможно, стратегия нарушится, если M1 является аппликацией], а в конец списка (что возможно из-за цикличности списка) редексов — (x: M2) N [недостает доказательства того, что последнее сохраняет нормализующее свойство получившейся стратегии]. Больше новых редексов в получившемся подвыражении не создается.

swizard опубликовал статью о Common Lisp и DSL, в которой достаточно ясно изложил мнение, что наиболее эффективное использование Common Lisp заключается в разработке DSL. Мало того, он предлагает начинающим начинать именно с этого. Позвольте не согласится.

Кратко - DSL не нужны кроме тех редких случаев, когда они очень хороши и реально упрощают решение задачи. Это не имеет отношения к Common Lisp, либо к какому либо другому языку. Например, Эрик Раймонд писал о DSL как о классической традиции программирования под UNIX и всяческих расхваливал преимущества данного подхода. Однако на практике лишь малая часть Unix-программ используют какие-либо DSL. Это однозначно свидетельствует о том, что разработчики, несмотря на все разрекламированные свойства DSL, стараются избегать их использования (да, я действительно считаю, что "миллионы мух не могут ошибаться", поскольку речь идёт не о мухах, а о, по большей части, талантливых разработчиках).

Если говорить о Common Lisp, то мне совершенно не понятно на чём основано мнение, что "common lisp и заслужил себе славу мета-языка " (с). В реальной практике программирования на Common Lisp использование DSL встречается редко. Связано это с тем, что, на мой взгляд, использование DSL просто противоречит духу Common Lisp, по крайней мере, в его современном виде.

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

Использование DSL возможно и целесообразно лишь в некоторых областях, но не для широкого круга задач. ИМХО, мнение о том, что при программировании на Common Lisp следует широко использовать DSL основано на позиции старой "lisp-гвардии", представители которой застряли где-то в начале 80-ых.

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

(cons "A1" (cons "B" (cons "C" 0)))
(cons "A2" (cons "B" (cons "C" 0)))
(cons "A3" (cons "B" (cons "C" 0)))
(cons "A4" (cons "B" (cons "C" 0)))

в нем подвыражение

(cons "B" (cons "C" 0))

Является общим для всех четырех вычисляемых выражений. Если считать, что кортежи у нас немутабельные, и сразу предполагать иммутабельность по умолчанию (т.е. явная декларация мутабельности), то можно сразу же заменять вычисление последующих вхождений (cons "B" (cons "C" 0)) ссылкой на первое вычисленное выражение. Это экономия и памяти тоже, в общем-то. Поправьте меня, но в мутабельном языке это вроде бы невозможно (или делается не так. copy-on-write?).

Это на самом деле к вопросу о том, на каком уровне делать ФЯ-специфичные оптимизации. Аппель их делает на самом верхнем уровне --- в его модели ФЯ и императивные языки различаются незначительно.

Итого, что бы хоть как-то потестировать точный gc, в компиляторе пришлось:

dmz@x200 ~/prj/hop/src/hopc $ git diff --stat HEAD^
 src/hopc/c_print.ml      |    9 ++-
 src/hopc/environment.ml  |   10 +++
 src/hopc/hop_builtins.ml |    5 ++
 src/hopc/hop_tree.ml     |   20 ++++++
 src/hopc/hop_types.ml    |   67 ++++++++++++++++++++
 src/hopc/hopc.ml         |   23 ++++++-
 src/hopc/infering.ml     |   23 +++++++
 src/hopc/test_nil.ss     |    2 +
 src/hopc/tree.ml         |  155 ++++++++++++++++++++++++++++++----------------
 src/hopc/typing.ml       |   10 +++
 src/tests/test_cons_1.c  |    3 +
 11 files changed, 270 insertions(+), 57 deletions(-)

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

Получается что-то вроде такого:

dmz@x200 ~/prj/hop/src/hopc $ ./hopc.byte ./test_cons_1.ss 
Compiling ./test_cons_1.ss
(AST (( cons   1 2) ( cons   3 4) ))
Constr. length: 10
var(6) <-> (var(9),var(10))
var(4) <-> var(9)
var(5) <-> var(10)
var(5) <-> int
var(4) <-> int
var(3) <-> (var(7),var(8))
var(1) <-> var(7)
var(2) <-> var(8)
var(2) <-> int
var(1) <-> int
after unification
var(6) <-> (int,int)
var(4) <-> int
var(5) <-> int
var(10) <-> int
var(9) <-> int
var(3) <-> (int,int)
var(1) <-> int
var(2) <-> int
var(8) <-> int
var(7) <-> int

TMP(1) <- ICONST(1)
TMP(2) <- ICONST(2)
TMP(3) <- CCALL(cons TMP(1) TMP(2) )
TMP(4) <- ICONST(3)
TMP(5) <- ICONST(4)
TMP(6) <- CCALL(cons TMP(4) TMP(5) )
/* ---------- begin c code ---------- */
CSTRINGS_BEGIN

CSTRINGS_END;

TMPINIT(6);
SETTMP(1, ICONST(1));
SETTMP(2, ICONST(2));
SETTMP(3, CCALL(cons, TMP(1), TMP(2)));
SETTMP(4, ICONST(3));
SETTMP(5, ICONST(4));
SETTMP(6, CCALL(cons, TMP(4), TMP(5)));

надо теперь карты указателей нагенерировать, но это уже легко.

Все, карта регистров готова.

let pointer_map tree types =
    let gettype = function (Tree.TMP(i), _) -> List.assoc (T.TVar(i)) types
    in let ptr_mask = function
       | T.TInt | T.TBool  -> 0 
       | T.TString         -> 1 
       | T.TTuple _        -> 1 
       | T.TFun _          -> 1 
       | x                 -> failwith "unknown type"  (* FIXME *)
    in List.fold_left (fun acc ((Tree.TMP(i), _) as t) -> acc lor (ptr_mask (gettype t)) lsl i) 0 tree 

TMP(1) <- ICONST(1)
TMP(2) <- ICONST(2)
TMP(3) <- CCALL(cons TMP(1) TMP(2) )
TMP(4) <- ICONST(3)
TMP(5) <- ICONST(4)
TMP(6) <- CCALL(cons TMP(4) TMP(5) )
Register map: 0x00000048UL [00000000000000000000000001001000b]
/* ---------- begin c code ---------- */
CSTRINGS_BEGIN

CSTRINGS_END;

TMPINIT(6);
SETTMP(1, ICONST(1));
SETTMP(2, ICONST(2));
SETTMP(3, CCALL(cons, TMP(1), TMP(2)));
SETTMP(4, ICONST(3));
SETTMP(5, ICONST(4));
SETTMP(6, CCALL(cons, TMP(4), TMP(5)));

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

Надо сказать, что регистровая модель + отсутствие синтаксиса мне очень нравятся. получается очень удобный AST и очень мало кода для его обработки. Ожидания оправдываются.