in reply to Rebinding closures

Nifty! But why all of that business with grep to get the odd and even elements of the @replacement_pairs? How about something like this instead:

sub rebind_closure {
    my $sub = shift;
    ref($sub) eq 'CODE' or die "First parameter must be a code ref (cl
+osure)";
    @_ % 2 or die "Rules must be an even numbered list: @_";

    my ($names,@values) = svref_2object( $sub )->PADLIST->ARRAY;
    my @names = @{$names->object_2svref};
    while (($rule,$replacement) = (shift, shift)) {  
        for ( 1 .. $#names ) {
            next unless rule_matches( $rule, $names[$_] );
            my $sigil = substr $names[$_], 0, 1;
            if ( $sigil eq '$' ) {
                ${($values[0]->ARRAY)[$_]->object_2svref} = $replaceme
+nt;
            } elsif ( $sigil eq '@' ) {
                @{($values[0]->ARRAY)[$_]->object_2svref} = @$replacem
+ent;
            } elsif ( $sigil eq '%' ) {
                %{($values[0]->ARRAY)[$_]->object_2svref} = %$replacem
+ent;
            } elsif ( $sigil eq '*' or
                      $sigil eq '&' ) {
                warn "$names[$_] cannot be rebound because it is not a
+ scalar, array or hash";
            } else {
                warn "Unknown sigil $sigil";
            }
        }
    }
}

[download]

As usual, caveat lector, I didn't test this code

duff

Replies are listed 'Best First'.
Re: Re: Rebinding closures
by diotalevi (Canon) on Dec 17, 2003 at 01:39 UTC
    I wanted to be able to access @rules and @replacements by index.
[reply]

      I saw that but the only place you did it was right at the top of your loop. If you had accessed the rules/replacements by index in more places, it wouldn't have even occurred to me to ask or post an alternative.

      duff

[reply]

        I suppose I could have written that without looping twice over grep. I had this thought of verifying that all the rules matched something since it might be considered an error condition to attempt to replace lexicals that don't exist. Then again, in a forest of indexed lists (PADLIST zero is the names, >=one is the pads, on each component of PADLIST only the index 1+ is interesting, etc) the whole thought is on doing everything indexed. The only remaining problem is that there is no guarantee that your two shifts execute in any particular order since you didn't separate the two modifications to @_ into two statements. You might get the replacement first and then the rule.

            my @replacements;
    my @rules;
    for ( 0 .. $#replacement_pairs ) {
        push
            @{ $_ & 1
               ? \@replacements
               : \@rules },
            $replacement_pairs[$_];
    }

        [download]
[reply]
[d/l]

In Section Cool Uses for Perl