package Local_Propagation; BEGIN { @EXPORT = (qw(input revoke), map "new_$_", qw(adder multiplier subtractor divider constant io)); } use base 'Exporter'; use Node; use Wire; # Addition component { my $adder = sub { my ($self, %v) = @_; if (defined $v{A1} && defined $v{A2}) { $self->set_wire('S', $v{A1} + $v{A2}); } else { $self->revoke_wire('S'); } if (defined $v{A1} && defined $v{S}) { $self->set_wire('A2', $v{S} - $v{A1}); } else { $self->revoke_wire('A2'); } if (defined $v{A2} && defined $v{S}) { $self->set_wire('A1', $v{S} - $v{A2}); } else { $self->revoke_wire('A1'); } }; sub new_adder { my ($a1, $a2, $s) = @_; Node->new('adder', $adder, { A1 => $a1, A2 => $a2, S => $s }); } } # Multiplication { my $multiplier = sub { my ($self, %v) = @_; if (defined $v{F1} && defined $v{F2}) { $self->set_wire('P', $v{F1} * $v{F2}); } elsif (defined $v{F1} && $v{F1} == 0) { $self->set_wire('P', 0); } elsif (defined $v{F2} && $v{F2} == 0) { $self->set_wire('P', 0); } else { $self->revoke_wire('P'); } if (defined $v{F1} && defined $v{P}) { if ($v{F1} != 0) { $self->set_wire('F2', $v{P} / $v{F1}); } elsif ($v{P} != 0) { warn "Division by zero\n"; } } else { $self->revoke_wire('F2'); } if (defined $v{F2} && defined $v{P}) { if ($v{F2} != 0) { $self->set_wire('F1', $v{P} / $v{F2}); } elsif ($v{P} != 0) { warn "Division by zero\n"; } } else { $self->revoke_wire('F1'); } }; sub new_multiplier { my ($f1, $f2, $p) = @_; Node->new('multiplier', $multiplier, { F1 => $f1, F2 => $f2, P => $p }); } } # Subtraction # S - M = D sub new_subtractor { my ($s, $m, $d) = @_; new_adder($d, $m, $s); } # Division # V / S = Q sub new_divider { my ($v, $s, $q) = @_; new_multiplier($q, $s, $v); } # Constants sub new_constant { my ($val, $w) = @_; my $node = Node->new('constant', sub {}, { 'W' => $w}, ); $w->set($node, $val); $node; } # Input/output components { my $announce = sub { my $name = shift; sub { my ($self, %val) = @_; my $v = $val{W}; if (defined $v) { print "$name : $v\n"; } else { print "$name : no longer defined\n"; } }; }; sub new_io { my ($name, $w) = @_; Node->new('io', $announce->($name), { W => $w }); } sub input { my ($self, $value) = @_; $self->wire('W')->set($self, $value); } sub revoke { my $self = shift; $self->wire('W')->revoke($self); } } 1;