El algoritmo de unificación recibe dos referencias $m
y $n
a los
árboles que van a ser unificados. Retorna verdadero si la unificación puede
tener lugar y falso en caso contrario.
La equivalencia se mantiene utilizando un atributo cuyo nombre es $set
.
Todos los nodos en una clase de equivalencia tienen un único representante.
Los atributos $set
de los nodos
en una misma clase referencian al representante
(posiblemente de forma indirecta, via los campos $set
de otros nodos).
El atributo $set
del representante canónico apunta a si mismo.
Inicialmente cada nodo esta en una clase única.
99 sub unify { 100 my ($m, $n) = @_; 101 102 my $s = representative($m); 103 my $t = representative($n); 104 105 return 1 if ($s == $t); 106 107 return 1 if $samebasic->($s, $t); 108 109 print "Unifying ".representative($s)->str." and ".representative($t)->str."\n" if $debug; 110 return 1 if (mergevar($s, $t)); 111 112 if (ref($s) eq ref($t)) { 113 $s->{$set} = representative($t); 114 my $i = 0; 115 for ($s->children) { 116 my $tc = $t->child($i++); 117 return 0 unless unify($_, $tc); 118 } 119 return 1; 120 } 121 122 return 0; 123 }
Nótese que unificar $m
y $n
es unificar sus representantes canónicos
$s
y $t
. Los representantes serán iguales si $m
y $n
ya están en la misma clase de equivalencia.
El algoritmo de unificación usa las siguientes funciones auxiliares:
representative
retorna una referencia al representante ccanónico
de la clase:
83 sub representative { 84 my $t = shift; 85 86 if (@_) { 87 $t->{$set} = shift; 88 return $t; 89 } 90 $t = $t->{$set} while defined($t->{set}) && ($t != $t->{$set}); 91 die "Representative ($set) not defined!".Dumper($t) unless defined($t->{set}); 92 return $t; 93 }También permite cambiar el representante.
$s
y $t
representan el mismo tipo básico la función
referenciada por $samebasic
devolverá verdadero. La función
$samebasic
es definida por medio de la función set
junto con los otros parámetros del algoritmode unificación.
203 Aho::Unify->set( 204 key => 'set', 205 isvar => sub { $_[0] =~ /^Parse::Eyapp::Node::TYPEVAR/ }, 206 samebasic => sub { 207 my ($s, $t) = @_; 208 209 return (((ref($s) eq 'INT') || (ref($s) eq'STRING')) && (ref($s) eq ref($t))); 210 }, 211 debug => $debug, 212 );
$s
o $t
es una variable la introducimos en la clase de
equivalencia de la otra. Puesto que cada variable fresca es un único nodo (estamos trabajando con un DAG)
la actualización de la clase de equivalencia será visible en todas las apariciones de esta variable.
Además representative
recorre la lista de enlaces de unificación retornando
el tipo básico o constructor con el que la variable se ha unificado.
La función mergevar
mezcla las clases de equivalencia cuando uno de los
representantes es una variable:
67 sub mergevar { 68 my ($s, $t) = @_; 69 70 if (isvar($s)) { 71 $s->{$set} = representative($t); 72 print $s->str." = ".representative($t)->str."\n" if $debug; 73 return 1; 74 } 75 if (isvar($t)) { 76 $t->{$set} = representative($s); 77 print $t->str." = ".representative($s)->str."\n" if $debug; 78 return 1; 79 } 80 return 0; 81 }
set
una función $isvar
que permite añadir variables adicionales:
23 sub isvar { 24 my $x = $isvar->(@_); 25 return $x if $x; 26 return 1 if $_[0] =~ /^Parse::Eyapp::Node::TYPEVAR::[\w:]+$/; 27 }El espacio de nombres
Parse::Eyapp::Node::TYPEVAR
se usa para las variables.
pl@nereida:~/doc/casiano/PLBOOK/PLBOOK/code/Aho-Polymorphism/lib/Aho$ cat -n Unify.pm 1 package Aho::Unify; 2 use Data::Dumper; 3 use Parse::Eyapp::Node; 4 use base qw (Exporter); 5 our @EXPORT_OK = qw( 6 unify 7 new_var 8 fresh 9 representative 10 strunifiedtree 11 hnewunifiedtree 12 newunifiedtree 13 selfrep 14 ); 15 our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] ); 16 17 my $count = 0; 18 my $set = 'representative'; 19 my $isvar = sub { }; 20 my $samebasic = sub { }; 21 my $debug = 0;
29 sub set { 30 my $class = shift if @_ %2; 31 $class = __PACKAGE__ unless defined($class); 32 33 my %handler = @_; 34 35 $set = 'representative'; 36 $set = $handler{key} if exists($handler{key}); 37 $isvar = $handler{isvar} if exists($handler{isvar}); 38 $samebasic = $handler{samebasic} if exists($handler{samebasic}); 39 $debug = $handler{debug} if exists($handler{debug}); 40 $count = 0; 41 42 bless { key => $set, isvar => $isvar, samebasic => $samebasic, count => $count }, $class; 43 }