Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

The threads on "AI::Perlog Unification help" brought back memories of my days, long long ago, when I developed and coded with Poplog - a lovely multi-language development environment that included Prolog (along with Pop-11, ML & CLOS).

( Poplog's primary language Pop-11 has a quite perlish attitude in some ways (although Pop's originators might be shuddering at the comparison :-). TMTOWTDI is definately part of the Pop culture. All Poplog languages are compiled down to a common stack-based virtual machine (PVM), which is in turn compiled down to an abstract register based virtual machine (PIM) before being compiled to native code. You could access the stack based VM and the parser directly from normal Pop code which was handy if you wanted to write your own syntax. All wrapped into an integrated editing environment with comprehensive hypertext help... ahhh... nice... but I digress. )

Poplog prolog was built on a continuation passing model. Implementing basic Prolog unification functionality in a continuation passing style is trivial. So trivial that I've found myself re-implementing it when I wanted to do something prolog-ish without having a prolog system to hand.

So... here it is in perl...

Continuations (over)simplified

Could anybody reading this who writes in languages like Scheme that treat continuations as first class objects please turn away now. I am about to oversimplify :-)

When you code in a continuation passing style each function gets an extra argument (the continuation) that describes what should be done after the function has successfully completed.

If the function fails it should just return.

So instead of writing

sub foo { bar() or die "we failed"; ni() or die "we failed"; return(1); }; die "it worked" if foo();

we write something like

sub foo { my $c = shift; bar( sub { ni($c) } ); return(0); }; foo( sub {die 'it worked'} ) || die "we failed\";

I'm sure this all seems insane at the moment - but I promise it will make (more) sense soon.

What we're going to implement

We're going to implement the following little Prolog program (I don't have a Prolog compiler to hand so please excuse any minor syntactic boo-boos).

/* 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).

For those who don't know in Prolog variables are anything that Starts_with_a_capital_letter.

A class for our variables

Before we start with the unification algorithm we need a little class to represent our variables. We want a variable that can:

  • be undefined
  • have a value
  • be tested for equality
  • be bound with another variable (so both variables refer to the same value) - only an undefined variable can be bound to anothers value (which might also be undefined).
  • be unbound (so they become undefined again)

So we write the appropriate tests.

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');

which points us towards a nice simple implementation

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; };

And now the sneaky bit...

Now that we have variables we can start re-implementing our prolog in perl.

To do this we need one more function - unify. Unify is passed two Var objects. If they can be unified (i.e. if they are equal, or if one variable can be bound to the other) then the continuation is called. If they cannot be unified, or if the contination fails, then the variables are returned unchanged.

This gives us:

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); };

We make the rest of our code a little easier on the fingers by automatically creating Var objects if necessary.

Now we have unify we can rewrite

male(frank). male(dean).
as
sub male { my ($var, $continuation) = @_; unify("frank", $var, $continuation); unify("dean", $var, $continuation); };
or if you want to save some typing
sub male { unify("frank", @_); unify("dean", @_); };

We can now do things like:

# 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";

Neat eh? We can implement 'female', 'acts', etc. in exactly the same way.

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)}); };

Allowing us to do things like

# 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";

The only thing we've not implemented is

/* frank sang with judy, frank sang with dean */ sang_with(frank, judy). sang_with(frank, dean).

We could implement this with unify

sub sang_with { my ($p1, $p2, $continuation) = @_; unify($p1, 'frank', sub {unify($p2, 'judy', $continuation)}); unify($p1, 'frank', sub {unify($p2, 'dean', $continuation)}); };

but that's probably too much fun with closures even for me. We can make this a lot simpler by writing something than can unify two lists of variables together.

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); };

This allows us to write.

sub sang_with { my ($p1, $p2, $continuation) = @_; unify_all(['frank', 'judy'], [$p1, $p2], $continuation); unify_all(['frank', 'dean'], [$p1, $p2], $continuation); };

Much nicer!

An example

Let's illustrate this with a final query. Let's find out if frank ever sang with an actor

my $x = Var->new; eval { actor( $x, sub { sang_with("frank", $x, sub { Success->throw } ) } ) }; print "frank did sing with an actor\n" if $@;

this can be written as the equivalent

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

Which works like this:

  1. We call actor() with $x and the $sang_with continuation.
  2. actor() then calls male() with $x and its continuation.
  3. male() calls unify with $x and "frank" which succeeds and calls the actor() continuation
  4. the actor() continuation calls acts() with $x (now with a value of "frank") and $sang_with.
  5. acts() calls unify with "frank" and $x ("frank") which succeeds and calls $sang_with.
  6. $sang_with calls sang_with() which returns (aka fails) since frank didn't sing with himself.
  7. acts() returns since there are no other "frank"s who act.
  8. male() then tries the next unification ("dean").
  9. the actor() continuation calls acts() with $x (now with a value of "dean") and $sang_with.
  10. acts() calls unify with "frank" and $x ("dean") which fails.
  11. acts() calls unify with "dean" and $x ("dean") which succeeds and calls $sang_with.
  12. $sang_with calls sang_with() which succeeds and calls $succeed since "frank" did sing with "dean".

Simple!

Exercises for the reader...

  1. Implement prolog's cut function
  2. Implement prolog lists
  3. Compile it down to parrot bytecode using proper continuations :-)

In reply to Perl and Prolog and Continuations... oh my! by adrianh

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (5)
    As of 2014-11-23 09:00 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (129 votes), past polls