Corutinas: El Módulo Coro

El módulo Coro de Marc Lehmann permite la escritura de corutinas en Perl.

Las corutinas se parecen a las subrutinas. El punto de entrada de una corutina es el comienzo del código de la corutina, pero los subsiguientes puntos de entrada son los puntos de yield (cede en Coro). Una corutina retorna cada vez que encuentra una sentencia yield (cede en Coro). Sin embargo, la siguiente vez que la corutina es llamada no empieza en el comienzo de la corutina sino justo después de su último yield.

roduzca de nuevo en la cola de listos (usando la función ready).

pp2@nereida:~/src/perl/coro$ cat -n schedule.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4
 5  use Coro;
 6  use Coro::Event;
 7
 8  async {
 9     print "2\n";
10     cede;
11     print "4\n";
12  };
13
14  sub timer : Coro {
15    my $w = Coro::Event->timer (after => 1);
16    my $e = $w->next; # get the event
17    print "Got: ".$e->got." Hits: ".$e->hits."\n";
18    $Coro::main->ready; # Put $main coroutine in the queue
19  }
20
21  print "1\n";
22  schedule;
23  print "3\n";

La corutina timer crea un vigilante en la clase Coro::Event::timer mediante la llamada:

    my $w = Coro::Event->timer (after => 1, repeat => 0);

Caundo este vigilante detecta el evento la ejecucíón de la corutina/callback vuelve a introducir la corutina $Coro::main en la cola de preparados dandole oportunidad de acabar.

pp2@nereida:~/src/perl/coro$ schedule.pl
1
2
4
Got: 0 Hits: 1
3

A diferencia de Event aquí no se especifica callback: El callback es la propia corutina.

El Atributo Coro

Como hemos visto es posible añadir el atributo Coro a una subrutina, lo que la convierte en corutina.

pp2@nereida:~/src/perl/coro$ cat -n attributes2.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use warnings;
 4
 5  use Coro;
 6
 7  my $p = 2;
 8
 9  sub p1 : Coro {
10     for (0..9) {
11        print "p1: $_\n";
12        cede;
13     }
14     $p--;
15  }
16
17  sub p2 : Coro {
18     for (10..23) {
19        print "p2: $_\n";
20        cede;
21     }
22     $p--;
23  }
24
25  eval {
26     cede while $p;
27  };

Argumentos y Retorno: terminate y cancel

Es posible pasar argumentos a la subrutina

                    async { ... } [ @args ]

y es posible retornar valores usando terminate o cancel:

terminate [arg ... ]
$coroutine->cancel( arg ... )

Los valores retornados pueden ser recuperados con join.

Sin embargo no es posible pasar parámetros a una corutina ni retornar valores cuando se cede el control a una corutina. De hecho cuando múltiples corutinas están activas es difícil sabe cuál tomará el control.

pp2@nereida:~/src/perl/coro$ cat -n isready.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4  use Coro;
 5
 6  my $n = 3;
 7  my $end = 1;
 8  my $p = Coro->new( sub {
 9    my $m = shift;
10
11    for (0..$m) {
12      print "p: $_\n";
13      cede;
14    }
15    $end = 0;
16    terminate map { $_*$_ } 1..$m;
17  }, $n
18  );
19
20  $p->ready;
21  do {
22    cede;
23    print "H\n";
24  } while ($end);
25  my @r = $p->join;
26  print "This is the end:(@r)\n";

Al ejecutar este programa obtenemos la salida:

pp2@nereida:~/src/perl/coro$ isready.pl
p: 0
H
p: 1
H
p: 2
H
p: 3
H
H
This is the end:(1 4 9)

El Método on_destroy

El método on_destroy registra un callback que será llamado cuando la corutina sea destruida, pero antes de que ocurra el join. El ejemplo anterior puede reescribirse como sigue:

pp2@nereida:~/src/perl/coro$ cat -n ondestroy.pl
 1  #!/usr/bin/perl
 2  use warnings;
 3  use strict;
 4  use Coro;
 5
 6  my $n = 3;
 7  my $continue = 1;
 8
 9  my $p = Coro->new( sub {
10    my $m = shift;
11
12    for (0..$m) {
13      print "p: $_\n";
14      cede;
15    }
16    terminate map { $_*$_ } 1..$m;
17  }, $n
18  );
19
20  $p->on_destroy( sub { $continue = 0 } );
21  $p->ready;
22  do {
23    cede;
24    print "H\n";
25  } while ($continue);
26  my @r = $p->join;
27  print "This is the end:(@r)\n";

Cuando se ejecuta se obtiene la siguiente salida:

pp2@nereida:~/src/perl/coro$ ondestroy.pl
p: 0
H
p: 1
H
p: 2
H
p: 3
H
H
This is the end:(1 4 9)

Prioridades

El método prio establece la prioridad de una corutina. Las corutinas con prioridad un número mayor se ejecutan con mas frecuencia que las que tienen un número más pequeño.

Nombre	Valor
PRIO_MAX	3
PRIO_HIGH	1
PRIO_NORMAL	0
PRIO_LOW	-1
PRIO_IDLE	-3
PRIO_MIN	-4

La corutina $Coro::idle tiene menos prioridad que ninguna otra.

Los cambios en la prioridad de la corutina actual tiene lugar inmediatamente. Sin embargo, los cambios efectuados en corutinas que esperan en la cola de preparados solo tiene lugar después de su siguiente planificación.

pp2@nereida:~/src/perl/coro$ cat -n priorities.pl
 1  #!/usr/bin/perl
 2  use strict;
 3  use warnings;
 4  use Coro qw{:prio cede async};
 5
 6  my $prio = shift || PRIO_NORMAL;
 7  my $c = async {
 8     print "2\n";
 9     cede; # yield back to main
10     print "4\n";
11  };
12
13  $c->prio($prio);
14
15  print "1\n";
16  cede; # yield to coroutine
17  print "3\n";
18  cede; # and again

Cuando se ejecuta el programa anterior se obtienen salidas como estas:

pp2@nereida:~/src/perl/coro$ priorities.pl 3 # PRIO_MAX
1
2
4
3
pp2@nereida:~/src/perl/coro$ priorities.pl 1 # PRIO_HIGH
1
2
4
3
pp2@nereida:~/src/perl/coro$ priorities.pl 0 # PRIO_NORMAL
1
2
3
4
pp2@nereida:~/src/perl/coro$ priorities.pl -1 # PRIO_LOW
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -3 # PRIO_IDLE
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -4 # PRIO_MIN
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -5 # No existe
1
2
3
pp2@nereida:~/src/perl/coro$ priorities.pl -300 # No se obtienen errores
1
2
3

El método nice

$newprio = $coroutine->nice($change)

puede ser utilizado para cambiar el valor de la prioridad de $coroutine. En este caso $change es un desplazamiento que se resta a la prioridad actual.

Mientras quecede cede el control a corutinas con prioridad igual o superior, la subrutina Coro::cede_notself cede el control a cualquier corutina, independientemente de cual sea su prioridad.

pp2@nereida:~/src/perl/coro$ cat -n prioidle.pl
     1  #!/usr/bin/perl
     2  use strict;
     3  use warnings;
     4  use Coro qw{:prio async};
     5
     6  my $prio = shift || PRIO_NORMAL;
     7  my $c = async {
     8     print "2\n";
     9     Coro::cede_notself; # yield back to main
    10     print "4\n";
    11  };
    12
    13  $c->prio($prio);
    14
    15  print "1\n";
    16  Coro::cede_notself; # yield to coroutine
    17  print "3\n";
    18  Coro::cede_notself; # and again

Al ejecutarse produce:

pp2@nereida:~/src/perl/coro$ prioidle.pl -1
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -2
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -3
1
2
3
4
pp2@nereida:~/src/perl/coro$ prioidle.pl -4
1
2
3
4