¿Cómo creo un gráfico cíclico de objetos inmutables en Perl y Moose?

Question

Esto podría parecer un caso obviamente sin esperanza, pero ¿hay algún truco para crear un gráfico cíclico de objetos inmutables en Perl? Algo como esto:

package Node; 
use Moose; 
has [qw/parent child/] => (is => 'ro', isa => 'Node'); 

package main; 
my $a = Node->new; 
my $b = Node->new(parent => $a); 

Ahora si quería $a->child para apuntar a $b, ¿qué puedo hacer?

Answer 1

Tuve que ir y ver cómo los lenguajes realmente inmutables hacen algo como esto, y creo que el siguiente es probablemente un intento razonable.

use 5.10.0; 
{ 

    package Node; 
    use Moose; 
    has [qw(parent child)] => (isa => 'Node', is => 'ro'); 

    sub BUILD { 
     my ($self, $p) = @_; 
     return unless exists $p->{_child}; 
     my $child = Node->new(parent => $self, %{ delete $p->{_child} },); 
     $self->meta->get_attribute('child')->set_value($self, $child); 
    } 
} 

say Node->new(_child => {})->dump 

Básicamente en lugar de tratar de construir los objetos por separado, tiene el padre de auto-vivificar el hijo basándose en lo que pasa en sus argumentos. La salida para esto es, que creo que es la estructura que quería.

$VAR1 = bless({ 
       'child' => bless({ 
            'parent' => $VAR1 
            }, 'Node') 
       }, 'Node'); 

Answer 2

Todavía soy muy nuevo para Moose, pero ¿funcionaría un disparador?

use Modern::Perl; 

package Node; 
use Moose; 
has 'parent' => (
    is => 'ro', 
    isa => 'Node', 
    trigger => sub{ 
     my ($self, $parent) = @_; 
     $parent->{child} = $self unless defined $parent->child; 
    } 
); 

has 'child' => (
    is => 'ro', 
    isa => 'Node', 
    trigger => sub{ 
     my ($self, $child) = @_; 
     $child->{parent} = $self unless defined $child->parent; 
    } 
); 

package main; 
my $p = Node->new; 
my $c = Node->new(parent => $p); 

say $p, ' == ', $c->parent; 
say $c, ' == ', $p->child; 

Answer 3

Se podía jugar con la inicialización perezosa:

package Node; 
use Moose; 

has parent => (
    is => 'ro', 
    isa => 'Node', 
    lazy => 1, 
    init_arg => undef, 
    builder => '_build_parent', 
); 

has _parent => (
    is => 'ro', 
    init_arg => 'parent', 
); 

has child => (
    is => 'ro', 
    isa => 'Node', 
    lazy => 1, 
    init_arg => undef, 
    builder => '_build_child', 
); 

has _child => (
    is => 'ro', 
    init_arg => 'child', 
    predicate => undef, 
); 

has name => is => 'ro', isa => 'Str'; 

generar los constructores y los predicados sobre la marcha:

BEGIN { 
    for (qw/ parent child /) { 
    no strict 'refs'; 

    my $squirreled = "_" . $_; 

    *{"_build" . $squirreled} = sub { 
     my($self) = @_; 
     my $proto = $self->$squirreled; 
     ref $proto eq "REF" ? $$proto : $proto; 
    }; 

    *{"has" . $squirreled} = sub { 
     my($self) = @_; 
     defined $self->$squirreled; 
    }; 
    } 
} 

Esto permite

my $a = Node->new(parent => \my $b, name => "A"); 
    $b = Node->new(child =>  $a, name => "B"); 

for ($a, $b) { 
    print $_->name, ":\n"; 
    if ($_->has_parent) { 
    print " - parent: ", $_->parent->name, "\n"; 
    } 
    elsif ($_->has_child) { 
    print " - child: ", $_->child->name, "\n"; 
    } 
} 

Su salida es

A: 
    - parent: B 
B: 
    - child: A 

El código podría ser más elegante, con η-conversion‎, pero Moose no va a pasar parámetros a los métodos constructor.