Hmm, I think I own you now - this uses code that writes code:

[%# Run this through tpage - from Template %]

[% numbers = [ 1, 2, 3, 4, 5, 6 ] -%]
[%   end   = '\)' -%]
[%   start = '\w+\(' -%]


my %functions = ();

[% FOR level = numbers -%]
$functions{ [% level %] } = sub { 
  $_[0] =~ s/[% end %]{[% level %]}$//o;  
  $_[0] =~ s/^([% start %]){[% level %]}//o;
  return $_[0];
};
[% END -%]

sub get_proparg_evdb {
 $_ = $_[0];
 my $level  = $_[1] || return $_;

 if ($level == -1) {
   m/\(([^()]+)\)+/;
   return $1;
 } 

 return &{$functions{ $level }}( $_ ) 
   || die 'Add universal function here';
}
[download]

The complete code that is produced is here:

             Rate       ori m-elegant     ori++      evdb
ori        6234/s        --      -36%      -40%      -51%
m-elegant  9690/s       55%        --       -7%      -24%
ori++     10373/s       66%        7%        --      -18%
evdb      12690/s      104%       31%       22%        --
[download]

Code that writes code - tip 29 from the pragmatic programmer.

--tidiness is the memory loss of environmental mnemonics

Another useless use of /o. See /o is dead, long live qr//!. Also, your code can be simplified by throwing away the %functions hash and just creating the matching expressions as needed.

I think I understand what you mean about creating the matching expressions on the fly - but that would remove the speed gain from creating all the anonymous functions at compile time and then calling them as needed.

If I have misunderstood please could you post some code to demonstrate. (PS I have revised my code - see above. That wretched \o is gone - nice posting on it ++).

--tidiness is the memory loss of environmental mnemonics

UPDATE: This "solution" modifies the @data, such that all entries are case 0, so the benchmarks as run are not valid.

Nice try, though.

IGNORE THE REST OF THIS.

OK, I'm owned. This is pretty slick. update: Yours test fastest. However, my test numbers are way different than befpore anthe OP's best shoit is now *better* than mine - which I don't understand.

--Bob Niederman, http://bob-n.com

I believe I have addressed your concerns with this:

[%# Run this through tpage - from Template %]

[% debug = 0 %]

[% numbers = [ 1, 2, 3, 4, 5, 6 ] -%]
[%   end   = '\)' -%]
[%   start = '\w+\(' -%]


my %functions = ();


[% FOR level = numbers -%]
$functions{ [% level %] } = sub { 
  my $string = shift;

  [% IF debug %]my $warn = "running [% level %] on '$string'";[% END %
+]

  $string =~ s/[% end %]{[% level %]}$//;  
  $string =~ s/^([% start %]){[% level %]}//;

  [% IF debug %]warn "$warn to produce '$string'\n\n";[% END %]
  return $string;
};
[% END -%]


$functions{-1} = sub {
  my $string = shift;
  $string =~ m/\(([^()]+)\)+/;

  [% IF debug %]warn "running -1 on $string to produce '$1'\n";[% END 
+%]

  return $1;
};

sub get_proparg_evdb {
 my $string = shift;
 my $level  = shift || return $string;

 return &{$functions{ $level }}( $string ) 
   || die 'Add universal function here';
}
[download]

I also wrote the following test code which should check that the function is behaving as it should:

# Test the function against another with known good results.
for (@data) {
  my @args = split;

  my @copy = @args;

  my $A = get_proparg( @args );
  my $B = get_proparg_evdb( @args );

  unless ( $A eq $B ) {

    warn "function wrong for '$args[1]'\n";
    warn "A is '$A'\nB is '$B'\n\n";

  }

  warn "array messed up\n" unless join(' ',@copy) eq join(' ',@args);

}
[download]

I took into account the uselessness of \o (thank you diotalevi) and also removed the case == -1 check by creating a function for it. Interestingly the results are now even better:

            Rate m-elegant       ori     ori++      evdb
m-elegant 1797/s        --       -6%      -11%      -36%
ori       1914/s        7%        --       -5%      -32%
ori++     2016/s       12%        5%        --      -28%
evdb      2818/s       57%       47%       40%        --
[download]

If I have misunderstood your critique please let me know. As you can see you can set debug = 1 in the template stuff to enable messages during the run that shows that all cases are being used.

--tidiness is the memory loss of environmental mnemonics

$propstr =~ /.*\((.*?)\)/;
[download]