Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Backtracking.pm

by Joost (Canon)
on May 10, 2002 at 14:57 UTC ( #165657=sourcecode: print w/ replies, xml ) Need Help??

Category: Code
Author/Contact Info Joost Diepenmaat / joost@hortus-mechanicus.net
Description: I was thinking about prolog yesterday, and how I still kinda like backtracking, so I implemented this simple module to add some kind of backtracking mechanism to perl.

Please let me know what you think

Update 1.2:
Added source filter (thanks for the tip educated_foo)

Update 1.3:
Switched Filter::Simple for Filter::Util::Call, to enable optional filtering... You can now choose between filter or import syntax (or mix both).

--
Joost.

package Backtracking;

$VERSION = 0.03;

use strict;
use Carp;

sub import {
    while (my $arg = shift) {  # process args
        if ($arg eq 'filter') {
            croak "'filter' option to Backtracking must be specified l
+ast!\n" if @_;

            require Filter::Util::Call;
            import Filter::Util::Call;

            filter_add(
                sub {
                    my ($status, $no_seen, $data);
                    my $count = 0;
                    while ($status = filter_read()) {
                        return $status if $status < 0;
                        if (/\bno\s+Backtracking\s+'filter'\s*;\s*$/) 
+{
                            $no_seen=1;
                            last;
                        }
                        $data .= $_;
                        $_ = "";
                        $count++;
                    }
                    $_ = $data;
                    s/\bgoal([\r\n\s]+)(\w+)([\r\n\s]*\{)/Backtracking
+::goal $1 '$2' => sub $3/g unless $status < 0;
                    $_ .= "no Backtracking 'filter';\n" if $no_seen;

                    $count;
                }
            );
        }
        elsif ($arg eq 'goal') {
            my ($package) = caller;
            no strict 'refs';
            *{$package."::goal"} = \&goal;
        }
    }
}

sub unimport {
     filter_del() if $_[0] eq 'filter';
}


sub goal($&) {
    my ($name,$code) = @_;
    my ($package) = caller;

    no strict 'refs';
    my $btarray = $package.'::BACKTRACK_'.$name;
    push @{$btarray},$code;
    if (@{$btarray} == 2) {
        eval "
sub $package".'::'."$name {
    for (@".$btarray.") {
        my \$rv = \$_->(\@_);
        return \$rv if \$rv;
    }
    return;
}

1;
" or croak $@;
    }
}



1;


__END__

=pod

=head1 NAME

Backtracking

=head1 DESCRIPTION

A very simple backtracking mechanism.

=head1 SYNOPSIS

    use Backtracking qw(goal filter);

    goal is_member {                # filter syntax
        my ($x,$y,@list) = @_;
        return $x eq $y;
    };

    goal is_member => sub {         # goal syntax
        my ($x,undef,@list) = @_;
        return unless @list;
        return is_member($x,@list);
    };


    for (qw(a b c d e f)) {
        if (is_member($_,qw(a b c d e))) {
            print "$_ is a member\n";
        }
        else {
            print "$_ is not a member\n";
        }
    }


    # That should print

    a is a member
    b is a member
    c is a member
    d is a member
    e is a member
    f is not a member

=head1 KNOWN BUGS / CAVEATS

=over 4

=item *

All goals are run in SCALAR context. This might be changed in the futu
+re.

=item *

There is no statement to express a 'cut'.

=item *

If you have the C<Filter> package installed, you can
C<use Backtracking 'filter'> to turn something like:

    goal goal1 {
        ...
    };

into

    goal 'goal1' => sub {
        ....
    };

using the following regex:

    s/\bgoal([\r\n\s]+)(\w+)([\r\n\s]*\{)/Backtracking::goal $1 '$2' =
+> sub $3/g

This might mismatch sometimes.

=back

=head1 SEE ALSO

L<Filter::Util::Call>, L<Filter::Simple>

=head1 AUTHOR

Joost Diepenmaat - joost@hortus-mechanicus.net

Comment on Backtracking.pm
Download Code
Replies are listed 'Best First'.
Re: Backtracking.pm
by educated_foo (Vicar) on May 10, 2002 at 15:17 UTC
    If the code is the first argument, you can use a prototype starting with '&', like this:
    sub mymap(&@) { ... }
    /s
      Damn, i want to use it as the second argument....

      guess i'm out of luck then ?

      -- Joost downtime n. The period during which a system is error-free and immune from user input.
        Yeah. This one has bothered me, too. I suppose you could do something like this (untested):
        sub is(&) { return $_[0] } sub goal { ... } # ... goal 'foo' is { ... }
        but it's not quite as nice. Option 2: write a source filter that takes
        goal mygoal
        and replaces it with
        goal 'mygoal', sub
        That might be a good way to go.

        /s

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://165657]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (15)
As of 2015-07-07 19:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls