вторник, 14 сентября 2021 г.

Об unicode в Perl

В очередной раз задумался о том, какие строки оптимальней использовать в основном коде: characters или octets.

Обычно мне очень редко приходиться работать непосредственно с unicode. Когда нужно, я преобразовываю octets в characters, а затем обратно.

Но HTML::Parser требует на вход unicode, и JSON::XS корректно работает только с unicode. Поэтому хоть непосредственно я сам не использую characters, приходиться перекодировать при помощи модуля Encode.

Кроме этих модулей, обычно все работают с octets.

А вот при работе над магазинчиком вышивки бисером и нитками Embroidery Kits выяснилось, что остальные используемый модули могут работать как с octets, так и с characters (кроме Digest::SHA).

HTML::Parser и JSON::XS перетянули одеяло на себя. Задумался.

P.S.
Utf8 флаг в сложных структурах данных расставляю, сбрасываю при помощи нижеприведенного кода.

use Encode;
use Scalar::Util qw(looks_like_number);


sub data_walk($$);
sub data_walk($$) {
  my ($d,$s) = @_;
  if (ref $d eq "ARRAY") {
    $d = [ map { data_walk($_, $s) } @$d ];
  } elsif (ref $d eq "HASH") {
    $d = { map { $s->($_) => data_walk($$d{$_}, $s) } keys %$d };
  } elsif (not ref $d) {
    $d = $s->($d)
  }
  return $d;
}


sub data_encode_utf8 { data_walk(shift,
    sub {
      my $data = shift;
      if ($data and not looks_like_number($data)) {
        $data = Encode::encode_utf8($data) if Encode::is_utf8($data);
      }
      return $data;
    }
  )
}


sub data_decode_utf8 { data_walk(shift,
    sub {
      my $data = shift;
      if ($data and not looks_like_number($data)) {
        $data = Encode::decode_utf8($data, Encode::FB_QUIET) unless Encode::is_utf8($data);
        $data ||= "ERROR: FOR SOME REASON, TEXT CONVERSION TO UTF8 FAILED";
      }
      return $data;
    }
  )
}

пятница, 31 мая 2019 г.

HTML::Parser vs HTML::TreeBuilder vs HTML::Gumbo

Benchmark для http://perl.org/ страницы.
Извлекаем текс и ссылки.

             Rate       Tree    Gumbo pure    Gumbo   Gumbo cb       SAX
Tree         46/s         --       -63%       -72%       -80%       -87%
Gumbo pure  122/s       167%         --       -24%       -47%       -64%
Gumbo       161/s       252%        32%         --       -30%       -53%
Gumbo cb    230/s       403%        89%        43%         --       -32%
SAX         339/s       642%       178%       111%        47%         --

где:
SAX       - это HTML::Parser
Tree      - HTML::TreeBuilder 
Gumbo     - HTML::Gumbo with tree output format
Gumbo cb  - HTML::Gumbo with callback output format

Обнако обнаружил, что HTML::Gumbo with tree output format на некоторых HTML страничах течет.
https://rt.cpan.org/Public/Bug/Display.html?id=128667

HTML::Gumbo строит DOM при помощи HTML::Elements со стороны XSUB.

Поэтому решил попробовал строить DOM при помощи HTML::Elements с стороны pure perl, а не XSUB.
Это вариант обозначен как "Gumbo pure" в таблице результата Benchmark.

четверг, 26 ноября 2015 г.

Упрощаем работу с многоуровневыми структурами данных из внешних источников

В Perl, благодаря "самооживлению" ссылок, очень удобна работа с многоуровневыми структурами данных. Например:
 my %foo = ();
 
 my $k = "k";
 $foo{$k}{a} = "b";
 $foo{$k}{c} = "d";
Однако, если %foo - это внешняя база данных, например BerkeleyDB, то значения необходимо запаковать тем же Storable или JSON.
При этом удобство работы с многоуровневыми структурами данных снижается.

Необходимо извлечь значение, распаковать его, а если значения не было, то создать. Затем после изменения - запаковать и поместить обратно.
 my %foo = ();

 my $k = "k";

 my $f;
 if (my $_f = $foo{$k}) {
  $f = decode_json $_f;
 } else {
  $f = {};
 }

 $$f{a} = "b";
 $$f{c} = "d";

 $foo{$k} = encode_json $f;
Теперь представим, что это необходимо делать в разных местах программы.
Проще написать функцию для внесения изменений, которая будет вызываться примерно вот как:
 $foo->($k, sub {
  my ($v) = @_;
  $$v{a} = "b";
  $$v{c} = "d";
  return $v;
 } );
Немножко многословно. Но в Perl есть "магическая" переменная $_, которая позволяет сделать следующие:
 $foo->($k, sub {
  $$_{a} = "b";
  $$_{c} = "d";
 } );
Соответственно, сама функция будет выглядеть так:
 my %foo = ();
 
 my $foo = sub {
  my ($k, $sub) = @_;

  local $_;

  if (my $_f = $foo{$k}) {
   $_ = decode_json $_f;
  } else {
   $_ = {};
  }

  $sub->();

  $foo{$k} = encode_json $_;
 };
Хотя можно и так:
 sub foo(&$);

 my %foo = ();

 local *foo = sub {
  my ($sub, $k) = @_;

  local $_;

  if (my $_f = $foo{$k}) {
   $_ = decode_json $_f;
  } else {
   $_ = {};
  }

  $sub->();

  $foo{$k} = encode_json $_;
 };

 foo {
  $$_{a} = "b";
  $$_{c} = "d";
 } "k";
Даже не знаю как лучше... :-)

среда, 24 декабря 2014 г.

HTTP content encoding

Решил прикрутить к AnyEvent::HTTP Accept-Encoding и к LWP в response_data handler, но перед этим выяснить какой процент серверов понимает gzip и deflate.

deflate кодирование реализовано в серверах двумя способами и поэтому авторы nginx отказались от его реализации и используют только gzip
(http://sysoev.ru/mod_deflate/readme.html#mehtods).

Под рукой оказался файл с 53587 доменами со следующим распределением по зонам:
  29244 com    1000 de      627 it
   3102 org     935 info    553 ca
   2786 uk      861 nl      504 si
   2734 net     853 au      467 fr
   1315 ru      682 br      368 ua

Для каждого домена запрашивал HTTP содержимое с указанием "Accept-Encoding" в трех различных вариантах: "gzip, deflate" (приоритет gzip), "deflate, gzip" (приоретет deflate) и "deflate". Результаты как закодировал ответ сервер представлены в нижеприведенной таблице (прочерк означает, что сервер вернул не закодированное содержимое):
             | "gzip, deflate" | "deflate, gzip" | "deflate"
 ------------|-----------------|-----------------|----------
 -           |     22888       |     22764       |  50462
 gzip        |     30612       |     30442       |    145
 deflate     |        67       |       361       |   2959
 iso-8859-1  |         1       |         1       |      1
 none        |        16       |        16       |     16
 none;       |         1       |         1       |      1
 UTF-8       |         2       |         2       |      2

Как видим, можно ограничиться поддержкой лишь одного gzip.

Заодно узнал популярность серверов:
                Все зоны | ru зона | ua зона
 ------------------------|---------|--------
 Apache            27327 |     978 |    443 
 nginx              6924 |     922 |    332
 Microsoft-IIS      6886 |     323 |    148
 -                  6116 |     212 |    103

пятница, 13 июня 2014 г.

COW in perl-5.20

В perl-5.20 реализовали механизм копирования при записи (copy-on-write) для строк. Теперь при присвоении одному скаляру значения другого, копирования буфера строки сразу не происходит. Это значительно повышает производительность и снимает необходимость передачи аргументов функций по ссылке (если они не будут изменяться).

Сравним скорость вызова подпрограмм с различными комбинация передачи параметра и возвращения результата для предыдущей версии perl и для версии с COW:
> perlbrew use perl-5.18.2
> perl ref_and_val.pl
                  Rate val -> val   val -> ref   ref -> val   ref -> ref  
val -> val     68213/s           --         -51%         -51%         -97%
val -> ref    138122/s         102%           --          -1%         -93%
ref -> val    139276/s         104%           1%           --         -93%
ref -> ref   2000000/s        2832%        1348%        1336%           --

> perlbrew use perl-5.20.0
> perl ref_and_val.pl
            (warning: too few iterations for a reliable count)
            (warning: too few iterations for a reliable count)
            (warning: too few iterations for a reliable count)
                  Rate ref -> val   val -> val   ref -> ref   val -> ref  
ref -> val   2083333/s           --         -17%         -21%         -29%
val -> val   2500000/s          20%           --          -5%         -15%
ref -> ref   2631579/s          26%           5%           --         -11%
val -> ref   2941176/s          41%          18%          12%           --
Результаты впечатляют, так как длина тестируемой строки 100000 символов!

А теперь возьмем реальное приложение. Оно сетевое, занимается "перекладыванием байтиков" с одного источника в 4 на основе srs32.
Ниже приведены количество запрос в секунду для 3 различных типов запросов в простом и pipeline режимах. Уточнение: сеть не является узким местом.
                 1     2     3
perl-5.14.4   7272  6134  3886
perl-5.18.2   7610  6439  4139
perl-5.20.0   7581  6459  4338

pipeline mode:
perl-5.14.4  21141 13869  5998
perl-5.18.2  21367 14025  6269
perl-5.20.0  21598 14367  6518
Как видим, в реальном приложении выигрыш от COW не заметен.

понедельник, 12 ноября 2012 г.

Деструкторы для замыканий, часть 2

Первая часть.

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

 use Carp;

 sub with_foo {
  my $foo = shift;
  my $sub = shift;
  print "INIT\n";
  my $destroyed = 0;
  my $closure = sub {
   unless ($destroyed) {
    $foo += shift;
    print $foo, "\n";
   } else {
    carp "Already destroyed";
   } 
  };
  my $destructor = sub {
   unless ($destroyed) {
    $destroyed = 1;
    print "DESTROY\n";
   } else {
    carp "Already destroyed";
   }
  };
  eval { $sub->($closure, $destructor) };
  $destructor->() unless $destroyed;
 }
 
 {
  with_foo(3, sub {
   my ($foo, $_foo) = @_;
   $foo->(1);
   $foo->(1);
   $foo->(2);
   $foo->(2);
   $_foo->();
   print "END\n"
  });
 }

четверг, 27 сентября 2012 г.

Very simple Multithreading with Continuation-passing style

{
 my @cc = ();

 sub cc(&) {
  my ($sub) = @_;
  push @cc, $sub;
 }

 sub cc_run() {
  while (my $sub = shift @cc) {
   $sub->();
   sleep 1;
  }
 }
}


sub first {
 my ($thread) = @_;
 print "$thread: 1 first\n";
 cc { third($thread) };
}

sub second {
 my ($thread) = @_;
 print "$thread: 2 second\n";
 cc { fourth($thread) };
}

sub third {
 my ($thread) = @_;
 print "$thread: 3 third\n";
 cc { first($thread) };
}

sub fourth {
 my ($thread) = @_;
 print "$thread: 4 fourth\n\n";
 cc { second($thread) };
}


cc { first("+") };
cc { second("*") };
cc_run;

понедельник, 24 сентября 2012 г.

Добавил quit в IPC::MPS

Очень плотно и давно использую модуль IPC::MPS для распараллеливания задач, но только сейчас понадобился выход из receive блока (из вложенного receive). Поэтому добавил подпрограмму quit.

пятница, 22 июня 2012 г.

Сравниваем MongoDB с MySql как Key-Value

Уговорили меня включить MongoDB в сравнение баз данных для Key-Value (смотрите PostgreSQL, MySql and MariaDB as Key-Value storage).

Оказалось, что MongoDB использует для хранения данных отображение памяти в файлы, поэтому для баз больше 2G, надо использовать 64-bit архитектуру.
После того как узнал это, надо было сразу выкинуть MongoDB, но все таки решил проложить. Поставил FreeBSD 9.0 amd64 и для чистоты эксперимента прогнал некоторые тесты для MySql и PostgreSql.

Решил тестировать только на коротких ключах (подробности смотрите тут BerkeleyDB и TokyoCabinet).

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

Результаты:
Чтение где-то в 2 раза медленней, чем у MySql.
Вставка также медленней, но периодически скорость вставки настолько замедляется, что даже не удается вставить запись в течении 30 секунд!

Поиск информации интернете показал, что это проблеме не связана с FreeBSD и наблюдается и под Linux.
А может это такой Perl модуль? Но ведь автор его является также разработчиком ядра MongoDB!

Некоторые значения полей отличаются после извлечения из базы. Может MongoDB чудит, считая, что это utf8.

Выводы.
MongoDB, с диском надо работать как с диском, а не как с памятью!
MySql и PostgreSql - фавориты. А в PostgreSql 9.2 появился index only scan, - так что PostgreSql еще повысил свою привлекательность.

Как люди работают с MongoDB? Или у них базы маленьких относительно оперативной памяти?

пятница, 8 июня 2012 г.

Одна история с Perl, Coro и IPC::MPS

Где-то два года назад была сделана некоторая система обработки получаемой из Web информации. Так как была сделана грамотно, то легким движением руки превращалась либо в многопроцессный, либо в основанный на сопрограммах вариант. В первом случае использовался модуль межпроцессного взаимодействия на основе сообщений IPC::MPS и EV, а во втором - Coro и EV.

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

Долгие выяснения, что не так с Coro вариантам ни к чему не привели. И лишь сегодня на рассвете я понял, что "ларчик просто открывался"! Я просто перегрузил Coro вариант, посчитав, что раз сопрограммы легкие, то можно одновременно обрабатывать задание побольше.

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

У меня интернет медленный, поэтому 100 сопрограмм показывали отличный результат.
У хостера интернет быстрый, поэтому у него Coro вариант выполнял заданий лишь в 2 раза больше, чем однопоточный. Но при этом время выполнения заданий было больше раз в 50. Перегрузил.

То есть, вариант с сопрограммами оптимален для медленных каналов связи или неторопливой второй стороны.

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

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

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

вторник, 5 июня 2012 г.

IPC::MPS was updated for Multiplicative Agent

IPC::MPS was updated for Multiplicative Agent.

Changes:
- connected flag in NODE_CLOSED
- your own pack and unpack functions, instead of Storable

First change is need to distinguish "Cannot connect to node" and "Node closed" states.

пятница, 25 мая 2012 г.

Деструкторы для замыканий

Периодически ловил себя на мысли, что хорошо бы, чтобы у замыканий были дестркторы. И лишь вчера осознал, что это можно легко организовать "вывернув" замыкания на изнанку. Рассмотрим в качестве примера следующий код:
 sub make_foo {
  my $foo = shift;
  print "INIT\n";
  return sub {
   $foo += shift;
   print $foo, "\n";
  };
 }
 
 {
  my $foo = make_foo(3);
  $foo->(1);
  $foo->(1);
  $foo->(2);
  $foo->(2);
 }
А теперь сделаем так, что замыкание не возвращается в функцию с действием, а передается ей в качестве аргумента. Это позволяет добавить деструктор сразу после вызова этой функции:
 sub with_foo {
  my $foo = shift;
  my $sub = shift;
  print "INIT\n";
  $sub->(sub {
   $foo += shift;
   print $foo, "\n";
  });
  print "DESTROY\n";
 }
 
 {
  with_foo(3, sub {
   my $foo = shift;
   $foo->(1);
   $foo->(1);
   $foo->(2);
   $foo->(2);
  });
 }

вторник, 15 мая 2012 г.

PostgreSQL, MySql and MariaDB as Key-Value storage

После сравнения BerkeleyDB и TokyoCabinet настало время посмотреть на PostgreSQL, MySql и MariaDB как на хранилища ключ-значения.

Использовался тот же  маленких сервачек.

PostgreSQL


postgresql-server v9.1.2

SET synchronous_commit TO OFF
commit_delay = 1

Во всех вариантах PostgreSQL заметно быстрей чем BerkeleyDB и TokyoCabinet! Разумеется это, когда объем базы превышал размер оперативной памяти.

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


MySql and MariaDB


Для perl модуля DBD::mysql используется патч https://rt.cpan.org/Public/Bug/Display.html?id=76462,
чтобы при mysql_server_prepare не было утечки памяти.

mysql-server-5.1.61
mariadb-server-5.2.10

У сравнении участвовали:
MyISAM
ARIA
XtraDB (Innodb_flush_log_at_trx_commit=0)

HandlerSocket не использовался.

На маленьких базах и длинных ключах TokyoCabinet hash (не btree) быстрей в 3-5 раз чем MyISAM, ARIA и XtraDB.
На коротких ключах MyISAM быстрей в 5 раз.

Когда базы большие, то MySql and MariaDB вырываются вперед, даже XtraDB быстрей, чем TokyoCabinet.

Как и у PostgreSQL, с ростом базы замечено существенное снижение производительности, когда используется btree индекс.
Преимущества hash индекса (XtraDB) не сказалось, в отличие от PostgreSQL.


Выводы


Когда базы маленькие можно использовать TokyoCabinet или BerkeleyDB.
Когда данных больше, то стоить посмотреть в сторону MyISAM, ARIA (MariaDB) или PostgreSQL.
Когда базы огромные, то лучше использовать PostgreSQL с HASH индексами.

понедельник, 26 марта 2012 г.

BerkeleyDB и TokyoCabinet

Результаты двух недельноего стравнения BerkeleyDB и TokyoCabinet на стареньком компьютере.

BerkeleyDB::Recno, которые, кстати, сделаны поверх Btree, можно заменить "ручными очередями", сделаными на основе BerkeleyDB::Btree или TokyoCabinet::BDB, без потери производительности.

Настройками по умолчанию TokyoCabinet предназначены для маленьких баз. BerkeleyDB - для средних.

Для больших баз с соответствующими настройками BerkeleyDB::Btree и TokyoCabinet::BDB примерно одинаковы по производительности и размеру. Большие базы 5000000 записей, key 1040 - байт, value - 1000 байт.

Тестовый сервер:
CPU: AMD Sempron(tm) Processor 2800+ (1608.27-MHz 686-class CPU)
real memory = 8589934592 (8192 MB)
ada0: ATA-6 device
ada0: 100.000MB/s transfers (UDMA5, PIO 8192bytes)
ada0: 76318MB (156299375 512 byte sectors: 16H 63S/T 16383C)

А вот TokyoCabinet::HDB выигрывает в скорости и в размене у BerkeleyDB::Hash почти в два раза.

четверг, 23 июня 2011 г.

Закорючки, продолжение

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

Perl:
send $sock, $msg1;
send $sock, $msgN;

OZ:
{send Sock Msg1}
{send Sock MsgN}

Haskell:
send sock msg1
send sock msgN

Много раз повторяется "send sock" - попробуем избавиться от дублирования.

Perl:
my $snd = sub { send $sock, @_ };
$snd->($msg1);
$snd->($msgN);
# или &$send($msgN);

OZ:
local Snd = fun {$ M} send Sock M end
{Snd Msg1}
{Snd MsgN}

Haskell:
let snd = send sock
snd msg1
snd msgN

Как видим, Perl закорючки (@#$%&) путаются под ногами.

четверг, 2 июня 2011 г.

Закорючки

В Perl 5.14 можно передавать функциям, ожидающим в качестве аргументов хеши и массивы, не только их, а и ссылки на них.

1. |----------------------------+---------------------------|
2. | Traditional syntax | Terse syntax |
3. |----------------------------+---------------------------|
4. | push @$arrayref, @stuff | push $arrayref, @stuff |
5. | unshift @$arrayref, @stuff | unshift $arrayref, @stuff |
6. | pop @$arrayref | pop $arrayref |
7. | shift @$arrayref | shift $arrayref |
8. | splice @$arrayref, 0, 2 | splice $arrayref, 0, 2 |
9. | keys %$hashref | keys $hashref |
10. | keys @$arrayref | keys $arrayref |
11. | values %$hashref | values $hashref |
12. | values @$arrayref | values $arrayref |
13. | ($k,$v) = each %$hashref | ($k,$v) = each $hashref |
14. | ($k,$v) = each @$arrayref | ($k,$v) = each $arrayref |
15. |----------------------------+---------------------------|

То есть, все идет к тому, что скоро закорючки (@#$%&) станут не нужны.
Если честно, раньше думал, что их наличии упрощает код. Меньше надо выдумывать имен и идентификаторов.
Однако, пописав на еще более высоком уровне (OZ, Haskell), понял, что иногда без них проще.

P.S.
А может просто руки болят?

среда, 23 марта 2011 г.

не-Perl

На прошлой неделе мне сразу два человека сказало (кажется даже в один день), что я пишу на Perl как не на Perl.
Забавно, но я использую обычно очень маленькое подмножество многоликого языка Perl.

P.S.
http://github.com/kni/redis-sharding/tree/v0.2
http://search.cpan.org/perldoc?IPC::MPS

понедельник, 14 марта 2011 г.

Redis Sharding

http://github.com/kni/redis-sharding/tree/v0.2

Redis Sharding is a multiplexed proxy-server, designed to work with the database divided to several servers.
It's a temporary substitution of Redis Cluster (http://redis.io) that is under development.

Redis Sharding is used for horizontal Redis database scaling (with connecting of additional servers) as long as load distribution between the cores on the multiprocessor servers (as Redis server is single-threaded, several copies of the server can be run, one for each free core).

/- Redis (node 1)
Client 1 --- /-- Redis (node 2)
Redis Sharding --- Redis (node 3)
Client 2 --- \-- Redis (node 4)
\- Redis (node 5)

Sharding is done based on the CRC32 checksum of a key or key tag ("key{key_tag}").

четверг, 2 декабря 2010 г.

Стиль передачи продолжений и связывание

Оператор связывания как синтаксический сахар

По мотивам цикла заметок "Сегодня без...", а именно заметки "Сегодня без return".

Возьмем пример кода из вышеупомянутой заметки и сразу лишим его магии Perl прототипов: все равно в последующем коде они работать не будут:

sub mul {
my ($sub, $x, $y) = @_;
my @r = map { $$x[$_] * $$y[$_] } 0 .. $#$x;
$sub->(@r);
}

sub minus {
my ($sub, $x, $y) = @_;
my @r = map { $$x[$_] - $$y[$_] } 0 .. $#$x;
$sub->(@r);
}

sub say {
my $sub = shift;
print join(" ", @_), "\n";
$sub->();
}

my @i = (1, 2, 3);
my @j = (2, 3, 4);
my @k = (3, 4, 5);

mul sub {
minus sub {
say sub {}, @_
}, \@_, \@k
}, \@i, \@j;

Результат работы это программы - вывод на печать строки "-1 2 7".

А теперь представим, что подпрограмма minus не вызывает продолжение, а возвращает результат:

sub minus {
my ($x, $y) = @_;
map { $$x[$_] - $$y[$_] } 0 .. $#$x;
}

Поэтому напишем для обертку:

sub bind_minus {
my ($sub, $x, $y) = @_;
my @r = minus($x, $y);
$sub->(@r);
}

Которую и будем использовать:

mul sub {
bind_minus sub {
say sub {}, @_
}, \@_, \@k
}, \@i, \@j;

Затем сделаем подпрограмму bind_minus ленивой, чтобы только связывала, но ничего не вычисляла сразу (это пригодиться потом):

sub bind_minus {
my ($sub) = @_;
sub {
my ($x, $y) = @_;
my @r = minus($x, $y);
$sub->(@r);
}
}

# ...

mul sub {
bind_minus(sub {
say sub {}, @_
})->(\@_, \@k)
}, \@i, \@j;

Ленивость bind_minus позволяет по ее образу сделать универсальную подпрограмму Bind для связывания функции и продолжения:

sub Bind {
my ($sub, $cont) = @_;
sub {
my @r = $sub->(@_);
$cont->(@r);
}
}

# ...

mul sub {
Bind(\&minus, sub {
say sub {}, @_
})->(\@_, \@k)
}, \@i, \@j

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

sub mul {
my ($x, $y) = @_;
map { $$x[$_] * $$y[$_] } 0 .. $#$x;
}

sub minus {
my ($x, $y) = @_;
map { $$x[$_] - $$y[$_] } 0 .. $#$x;
}

sub say {
print join(" ", @_), "\n";
}

my @i = (1, 2, 3);
my @j = (2, 3, 4);
my @k = (3, 4, 5);

sub Bind {
my ($sub, $cont) = @_;
sub {
my @r = $sub->(@_);
$cont->(@r);
}
}

Bind(\&mul, sub {
Bind(\&minus, sub {
Bind(\&say, sub {})->(@_)
})->(\@_, \@k)
})->(\@i, \@j)

Кстати, можно даже сделать маленькую tailcall оптимизацию:

sub Bind {
my ($sub, $cont) = @_;
sub {
@_ = $sub->(@_);
goto &$cont;
}
}

А если превратить подпрограмму Bind в оператор, то это становиться на что-то очень-очень похоже... Неужели на Haskell?

Стиль передачи продолжений позволяет симулировать состояния, то есть писать код без изменяемых переменных: лишь абсолютная чистота.
Уж не являются операторы связывания и, соответственно, монады Haskell своеобразными обертками для более простого использования стиля передачи продолжений?

Если да, то bind и монады в Haskell - это не кусочек императивного мира, а его иллюзия.
То есть Haskell един, а не состоит из двух частей: чистой и грязной. Он чист, абсолютно чист, также как и Clean!

А как же быть с ленивость? Ведь Haskell не только чист, но и ленив. Что-ж рассуждаем дальше.

Порядок для ленивых

Оператор связывания

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

my @numbers = (3, 6);
sub get_number() {
shift @numbers;
}

my $x1 = get_number();
my $x2 = get_number();

sub div($$) {
my ($x2, $x1) = @_;
$x2 / $x1;
}

print div($x2, $x1);

Результат работы вышеприведенного кода - деление 6 (второе число) на 3 (первое число).
Подпрограмма get_number имитирует получение чисел из внешнего источника.

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

my @numbers = (3, 6);
sub get_number() {
sub { shift @numbers };
}

my $x1 = get_number(); # метка 1
my $x2 = get_number(); # метка 2

sub div($$) {
my ($x2, $x1) = @_;
$x2->() / $x1->(); # метка 4
}

print div($x2, $x1); # метка 3

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

В нашем примере, добавив ленивость, мы сделали, что при выполнении программы в метке 1 почти ничего не происходит, и в метка 2 также. А вот в метке 3 требуется все таки вывести результат - программа осознает, что хватит лениться и вызывает функцию div, передав ей ленивые x2 и x1. В функции div (метка 4), уже нужны реальные результаты x2 и x1 - происходит получение данных из внешнего источника. Но поскольку нужен сначала x2, а лишь потом x1, то первое число попадает в x2, а не в x1.

Чтобы задать порядок вычисления можно воспользоваться Стилем передачи продолжений -
для простоты сразу возьмем вышеупомянутую функцию Bind:

my @numbers = (3, 6);
sub get_number() {
sub { shift @numbers };
}

sub div($$) {
my ($x2, $x1) = @_;
$x2->() / $x1->();
}

sub Bind {
my ($sub, $cont) = @_;
sub {
@_ = $sub->(@_);
goto &$cont;
}
}

Bind(get_number(), sub {
my $x1 = shift;
Bind(get_number(), sub {
my $x2 = shift;
Bind(\&div, sub {
print @_;
# print "$x2/$x1=$_[0]\n"
})->(sub {$x2}, sub {$x1})
})->();
})->();

Конечно выглядит ужасно!

Но если подпрограммы Bind сделать оператором и упростить запись для анонимных подпрограмм, то все намного лучше:

get_number >>= \x1 -> (get_number >>= \x2 -> (div x2 x1 >>= print))

А при использовании do нотации - все просто замечательно:

do x1 <- get_number
x2 <- get_number
r <- div x2 x1
print r

Примечание: Haskell не знаю - так что эти две записи наверняка с ошибками.


Dataflow переменные

Альтернативный способ задания порядка - это использование unborned dataflow переменных.

Они используется для управления порядком в Mozart-OZ потоках.

Им подобны "Уникальные типы" в Clean.

В Haskell они просматриваются в руководствах посвещенных монадам:

getChar :: RealWorld -> (Char, RealWorld)

main :: RealWorld -> ((), RealWorld)
main world0 = let (a, world1) = getChar world0
(b, world2) = getChar world1
in ((), world2)

Хотя мне не понятно зачем они тут, ведь все красиво делается при помощи связывания?
Конечно, можно предположит, что getChar и прочии IO функции настолько ленивы, что им надо передавать всегда новый RealWorld,
но ведь это можно делать за кулисами.

Выводы

Время от времени читал о Haskell, о монадах - никак не мог понять их. Казалось, что одни руководства противоречат другим.
И только, недавно, когда плюнул на все эти монады, а просто представил чистый и ленивый язык, сразу стало все на свои места.
Нашлось там место и оператору bind, и самим монадам, но не как ключевым фигурам...
Остался один вопрос: зачем так все путанном объясняется в Haskell?


P.S.
После того как была написана эта заметка решил посмотреть подробней на Clean и нашел там подтвержение вышесказаному.
Может тем, кто хочет понять Haskell монады, следует рекомендовать сначала почитать как в Clean обходятся без них.

среда, 1 декабря 2010 г.

IPS::MPS, AnyEvent::HTTPD, AnyEvent::HTTP and DBI

Игрался на perl связкой IPS::MPS, AnyEvent::HTTPD, AnyEvent::HTTP и DBI.
Сделал четыре процесса: главный (управляющий), HTTP сервер, HTTP клиент, DBI клиент.
Хотя блокируемый процесс тут один: DBI, но этого поиграться с межпроцессным взаимодействием в стиле передачи сообщений хватит:

use IPC::MPS::Event;
use AnyEvent::HTTPD;
use AnyEvent::HTTP;
use DBI;

my $port = 9090;

print "Please contact me at: http://127.0.0.1:$port/?q=foo\n";

my $vpid_server = spawn {

my %url2req; # $url => [$req, ...]

my $httpd = AnyEvent::HTTPD->new(port => $port);

$httpd->reg_cb (
'' => sub {
my ($httpd, $req) = @_;
my $q = $req->parm('q');
if ($q) {
my $url = "http://www.google.com/search?q=$q";
snd(0, "req", $url);
push @{$url2req{$url}}, $req;
} else {
$req->respond([404, 'NOT FOUND']);
}
},
);

receive {
msg res => sub {
my ($from, $url, $data, $headers) = @_;
for my $req (@{$url2req{$url}}) {
$req->respond([200, 'OK', {'Content-Type' => 'text/html'}, $data]);
}
delete $url2req{$url};
};
};

};


my $vpid_client = spawn {
receive {
msg req => sub {
my ($from, $url) = @_;
http_get $url, sub {
my ($data, $headers) = @_;
snd($from, "res", $url, $data, $headers);
};
};
}
};


my $vpid_dbi = spawn {

# CREATE DATABASE nick OWNER nick ENCODING 'UTF8';
# CREATE TABLE urls (id_url SERIAL, datetime TIMESTAMP DEFAULT now(), url text, PRIMARY KEY (id_url));
# DROP TABLE urls;
my $data_sourse = "DBI:Pg:dbname=nick;host=localhost";
my $dbh = DBI->connect($data_sourse, "nick", "") or die $DBI::errstr;
my $sth = $dbh->prepare("INSERT INTO urls (url) VALUES (?)") or die $dbh->errstr();

receive {
msg res => sub {
my ($from, $url) = @_;
$sth->execute($url) or die $dbh->errstr();
};
}
};


receive {
msg req => sub {
my ($from, $url) = @_;
snd($vpid_client, "req", $url);
warn "Q; $url";
};
msg res => sub {
my ($from, $url, $data, $headers) = @_;
snd($vpid_server, "res", $url, $data, $headers);
snd($vpid_dbi, "res", $url);
warn "R; $url";
};
};

Забавно получается.