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