sub foo {
bar() or die "we failed";
ni() or die "we failed";
return(1);
};
die "it worked" if foo();
####
sub foo {
my $c = shift;
bar( sub { ni($c) } );
return(0);
};
foo( sub {die 'it worked'} ) || die "we failed\";
##
##
/* frank and dean are male */
male(frank).
male(dean).
/* ella and judy are female */
female(ella).
female(judy).
/* frank, judy and dean all act */
acts(frank).
acts(judy).
acts(dean).
/* frank, judy, dean and ella all sing */
sings(frank).
sings(judy).
sings(dean).
sings(ella).
/* a person is somebody who is male or female */
person(X) :- male(X).
person(X) :- female(X).
/* an actor is somebody who is male and acts */
actor(X) :- male(X), acts(X).
/* an actress is somebody who is female and acts */
actress(X) :- female(X), acts(X).
/* frank sang with judy, frank sang with dean */
sang_with(frank, judy).
sang_with(frank, dean).
##
##
use Test::More 'no_plan';
my $v1 = Var->new;
my $v2 = Var->new("hello");
my $v3 = Var->new;
my $v4 = Var->new("hello");
isa_ok($v1, 'Var', 'new unbound var');
ok(! $v1->bound, ' is not bound');
is($v1->value, undef, ' and undefined');
isa_ok($v2, 'Var', 'new bound var');
ok($v2->bound, ' is bound');
is($v2->value, "hello", ' to correct value');
ok( $v1->equal($v1), 'var equal to itself');
ok(!$v1->equal($v3), 'unbound var not equal to other unbound var');
ok( $v2->equal($v4), 'bound vars with same content equal');
ok(!$v2->bind($v1), 'cannot bind bound var');
ok( $v1->bind($v2), 'can bind unbound var');
is( $v1->value, "hello", ' to correct value');
##
##
use strict;
use warnings;
package Var;
sub new {
my ($class, $value) = @_;
bless \\$value, $class;
};
sub bound {
my $self = shift;
defined $$$self;
};
sub value {
my $self = shift;
return($$$self);
};
sub equal {
my ($v1, $v2) = @_;
$v1 eq $v2 || $v1->bound && $v2->bound && $v1->value eq $v2->value;
};
sub bind {
my ($v1, $v2) = @_;
return(0) if $v1->bound;
$$v1 = $$v2;
return(1);
};
sub unbind {
my $self = shift;
$$self = \undef;
};
##
##
sub unify {
my ($v1, $v2, $continuation) = @_;
$v1 = Var->new($v1) unless UNIVERSAL::isa($v1, 'Var');
$v2 = Var->new($v2) unless UNIVERSAL::isa($v2, 'Var');
if ($v1->equal($v2)) {
$continuation->();
} elsif ($v1->bind($v2)) {
$continuation->();
$v1->unbind
} elsif ($v2->bind($v1)) {
$continuation->();
$v2->unbind;
};
return(0);
};
##
##
male(frank).
male(dean).
##
##
sub male {
my ($var, $continuation) = @_;
unify("frank", $var, $continuation);
unify("dean", $var, $continuation);
};
##
##
sub male {
unify("frank", @_);
unify("dean", @_);
};
##
##
# print out all the males
my $a = Var->new;
male($a, sub {print $a->value, " is male\n"} );
# is judy male
eval {male("judy", sub {Success->throw})};
print $@ ? "judy is male" : "judy is not male", "\n";
# is dean male
eval {male("dean", sub {Success->throw})};
print $@ ? "dean is male" : "dean is not male", "\n";
##
##
sub female {
unify("ella", @_);
unify("judy", @_);
};
sub acts {
unify("frank", @_);
unify("dean", @_);
unify("judy", @_);
};
sub sings {
unify("frank", @_);
unify("dean", @_);
unify("ella", @_);
unify("judy", @_);
};
sub person {
male(@_);
female(@_);
};
sub actor {
my ($var, $continuation) = @_;
male($var, sub {acts($var, $continuation)});
};
sub actress {
my ($var, $continuation) = @_;
female($var, sub {acts($var, $continuation)});
};
##
##
# print out all of the actors
my $c = Var->new;
actor($c, sub {print $c->value, " is an actor\n"} );
# is ella an actress
eval {actress("ella", sub {Success->throw})};
print $@ ? "ella is an actress" : "ella is not an actress", "\n";
##
##
/* frank sang with judy, frank sang with dean */
sang_with(frank, judy).
sang_with(frank, dean).
##
##
sub sang_with {
my ($p1, $p2, $continuation) = @_;
unify($p1, 'frank', sub {unify($p2, 'judy', $continuation)});
unify($p1, 'frank', sub {unify($p2, 'dean', $continuation)});
};
##
##
sub unify_all {
my ($a, $b, $continuation) = @_;
if (@$a == 0 && @$b==0) {
$continuation->();
} elsif (@$a == @$b) {
my ($v1, $v2) = (shift @$a, shift @$b);
unify($v1, $v2, sub { unify_all($a, $b, $continuation) });
unshift @$a, $v1;
unshift @$b, $v2;
};
return(0);
};
##
##
sub sang_with {
my ($p1, $p2, $continuation) = @_;
unify_all(['frank', 'judy'], [$p1, $p2], $continuation);
unify_all(['frank', 'dean'], [$p1, $p2], $continuation);
};
##
##
my $x = Var->new;
eval {
actor(
$x,
sub { sang_with("frank", $x, sub { Success->throw } ) }
)
};
print "frank did sing with an actor\n" if $@;
##
##
my $x = Var->new;
my $succeed = sub { Success->throw };
my $sang_with = sub { sang_with("frank", $x, $succeed) };
eval { actor($x, $sang_with) };
print "frank did sing with an actor\n" if $@;