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 $@;