Arrows in perl

Arrows in Perl
2011.12.10 hiratara

d.hatena.ne.jp/hiratara

twitter.com/hiratara

Perl

10/18 YAPC::Asia 2011

Monads in Perl
Perl Monad

Future
( JSDeferred)

Data::Monad

my $result = Data::Monad::Base::Sugar::for {
pick my $x => sub { scalar_list 1 .. 100 };
pick my $y => sub { scalar_list $x .. 100 };
pick my $z => sub {
scalar_list $y .. ($x + $y > 100 ? 100 : $x + $y)
};
satisfy { $x**2 + $y**2 == $z**2 };
yield { $x, $y, $z }
};

return >>=

return :: a -> m a
>>= :: m a -> (a -> m b) -> m b
return >>=

ma mb mb mc ma mc

f >=> g == f >=> g
a b b c a c

ma ma mb ma mb
return >=> f == f
a a b a b

(2)

2

fmap return join

fmap :: a -> b -> (m a -> m b)
join :: m (m a) -> m a

η⊗id id⊗η
I⊗M M⊗M M⊗I

μ
λ ρ

M

( )
0×id id×0
(*, n) (0, n) (n, 0) (n, *)

(+)
π’ π

n

( )
fmap return return
id.fmap fmap.fmap fmap.id

join
id id

fmap

Monad Arrow

(Haskell )
mb

f
a
Arrows

f :: m b c b
a

Arrows

arr >>> ﬁrst ↝

arr :: a -> b -> (a ↝ b)

>>> :: (a ↝ b) -> (b ↝ c) -> (a ↝ c)

ﬁrst :: (a ↝ b) -> (a × c ↝ b × c)

Arrow
package Arrow;

sub arr {
my ($class, $code) = @_;
die "not implemented";
}

sub first {
my $self = shift;
}

sub next {
my ($self, $arrow) = @_;
}

ﬁrst
a↝b a b

>>>

arr ↝

a f b a arr f :: a ↝ b
b

g arr arr f >>> arr g :: a ↝ c
arr g :: b ↝ c

g.f
c c

ﬁrst
Arrow ↝

a c a×c

f :: a↝b g :: c↝d f *** g :: a×c↝b×d

b d b×d

(f *** g) >>> (f’ *** g’) (f >>> f’) *** (g >>> g’)

f g f g

f’ g’ f’ g’

premonoidal category

f ⋉ id = ﬁrst f a×b a×b
id ⋊ f = second f
f ⋉ id
a’×b (f>>>f’) ⋉ id

f’ ⋉ id

a’’×b a’’×b

central

f *** g ≡ first f >>> second g
first f >>> second - = second - >>> first f
first - >>> second f = second f >>> first -
f central

arr f central

f |x g ≡ first f >>> second (arr g)
( 10.2)

Freyd category

premonoidal category

(central central )

a -> b Arrow a ↝ b
arr Freyd category

second ***
sub second {
my $self = shift;
my $swap = (ref $self)->arr(sub { $_[1], $_[0] });
$swap->next($self->first)->next($swap);
}

sub parallel {
$self->first->next($arrow->second);
}

fst f >>> snd g
id g
C C D

f id
A B B

&&&
sub split {
(ref $self)->arr(sub {
my $args = [@_];
$args, $args;
})->next($self->parallel($arrow));
}

A A
arr id
arr id
arr <id, id>
f g A arr π
A×A arr π’
A
f &&&g f g
f *** g
arr π arr π’
B
arr π
B×C arr π’
C B B×C C

(1):

ﬁrst :: a × b × c -> d × e
-> (a × b × c × y × z -> d × e × y × z)
5

(1):
f (@v1 )
sub first {
my $self = shift;
my (@v1, @v2) = @_;
$self->(@v1), @v2;
});
}

ﬁrst 2
(A × B) × (C × D)

package Arrow::Subroutine;
use parent qw/Arrow/;

sub arr {
bless $code, $class;
}

sub first {
my $self = shift;
my ($v1, $v2) = @_;
[$self->(@$v1)], $v2;
});
}

sub next {
(ref $self)->arr(sub { $arrow->($self->(@_)) });
}

my $arr3 = Arrow::Subroutine->arr(sub { 3 });
my $arr4 = Arrow::Subroutine->arr(sub { 4 });
my $arrow_add = Arrow::Subroutine->arr(sub {
$_[0]->[0] + $_[1]->[0];
});
my $arr3_plus_4 = $arr3->split($arr4)->next($arrow_add);

print $arr3_plus_4->(), "n";

3
π

()
3 &&& 4 +
Int×Int Int
π’
4

(2):

>>> arr

ﬁrst

ﬁrst
a π a×c π’ c

f f×return return

π π’
mb mb×mc mc
φ

m(b×c)

package Arrow::Kleisli;
use parent qw/Arrow/;

sub _safe_name($) {
my $name = shift;
$name =~ s|::|__|g;
return "__$name";
}

sub new_class {
my $class = shift;
my ($monad) = @_;

my $class_name = "$class::" . _safe_name($monad);
unless ($class_name->isa($class)) {
no strict qw/refs/;
@{"$class_name::ISA"} = ($class);
*{"$class_name::monad"} = sub { $monad };
*{"$class_name::new_class"} = sub {
die "Don't call the new_class() method from sub classes.";
};
}

return $class_name;
}

sub monad { die "Implement this method in sub classes" }
...

sub new {
my ($class, $kleisli) = @_;
bless $kleisli, $class;
}

sub arr {
$class->new(sub {
$class->monad->unit($code->(@_));
});
}

sub next {
(ref $self)->new(sub {
my @v = @_;
$self->(@v)->flat_map($arrow);
});
}

sub first {
my $self = shift;
my $class = (ref $self);
my $monad = $class->monad;

$class->new(sub {
my ($args1, $args2) = @_;
$monad->sequence(
$self->(@$args1)->map(sub {[@_]}),
$monad->unit(@$args2)->map(sub {[@_]}),
);
});
}

arr 10
arr π

()
arr 10 &&& arr 2 div
Int×Int Int
arr π’
arr 2

div :: Int×Int ↝ Int = Int×Int → Maybe Int

my $class = Arrow::Kleisli->new_class('Data::Monad::Maybe');
my $arrow10 = $class->arr(sub { 10 });
my $arrow2 = $class->arr(sub { 2 });
my $arrow_div = $class->new(sub {
$_[1][0] == 0 ? nothing : just ($_[0][0] / $_[1][0]);
});
my $arrow10_div_2 = $arrow10->split($arrow2)-
>next($arrow_div);

my $maybe = $arrow10_div_2->();
print $maybe->is_nothing ? 'NOTHING' : $maybe->value;
print "n";

Arrows

Stream Arrows

:
Arrows

mm join return
m id

>>> arr
↝⊗↝ ↝ Hom

( )

arr⊗id id⊗arr
Hom⊗↝ ↝⊗↝ ↝⊗Hom

>>>
λ ρ

↝

Arrows

ﬁrst

LL Arrows

http://d.hatena.ne.jp/m-hiyama/20111107/1320624410

Arrows in perl

More Related Content

What's hot (20)

Similar to Arrows in perl (20)

More from Masahiro Honma (20)

Recently uploaded (20)

Arrows in perl

Editor's Notes