Re: rough approximation to pattern matching using local

[BrowserUk]

The only way I can see to getting close to what you want is to eval the subroutines into existence at runtime, something like this:

#! perl -slw
use strict;
use Data::Dump qw[ pp ];

sub same_keys {
    my ($left, $right) = @_;
    return unless ref $left eq 'HASH' and ref $right eq 'HASH';
    return unless keys %$left == keys %$right;
    for my $key (keys %$left) {
        exists $right->{$key} or return;
    }
    return 1;
}

sub match_inner {
    my ($lhs, $rhs, $locals) = @_;
    if (ref $lhs eq '') {
        $locals->{$lhs} = $rhs;
    }
    elsif (ref $lhs eq 'ARRAY') {
        if (@$lhs == @$rhs) {
            for my $i (0 .. $#$lhs) {
                match_inner($lhs->[$i], $rhs->[$i], $locals);
            }
        }
    }
    elsif (ref $lhs eq 'HASH') {
        if (same_keys($lhs,$rhs)) {
            for my $k (keys %$lhs) {
                match_inner($lhs->{$k}, $rhs->{$k}, $locals);
            }
        }
    }
}

sub match ($$$) {
    my ($lhs, $rhs, $fun) = @_;
    my $locals = {};
    # populate locals
    match_inner($lhs, $rhs, $locals);

    my( $code, $k, $v ) = "{\n";
    $code .= "    my \$$k = '$v';\n" while ($k, $v) = each %$locals;
    $code .= $fun . "\n}";
    print $code;
    return eval $code;
}

my $sub = match "bob", 45, q[
    sub {
        print $bob;
    };
];

pp $sub;
$sub->();

my $sub2 = match ['bill','john'], [123, 'jack' ], q[
    sub {
        print $bill, ' ', $john;
    }
];

pp $sub2;
&$sub2;

__END__
C:\test>1114414.pl
{
    my $bob = '45';

    sub {
        print $bob;
    };

}
sub { "???" }

45
{
    my $john = 'jack';
    my $bill = '123';

    sub {
        print $bill, ' ', $john;
    }

}
sub { "???" }

123 jack

But I doubt that actually allows what you're really aiming for.