четверг, 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";
};
};

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