package Inline::Sub; use strict; use warnings; use Filter::Simple; use Regexp::Assemble; FILTER { my %inline = extract_inlined_subs($_); my $re = build_sub_name_regex(\%inline); # Handle void call while (m|^\s*($re)(\(.*\))\s*;\s*$|mg) { my ($sub, $args) = ($1, $2); my $replacement = build_void_sub(\%inline, $sub, $args); s|^\s*$sub\(.*\)\s*;\s*$|$replacement|mg; } # Handle assignment calls while (m|^\s*(.*?)\s*=\s*($re)(\(.*\))\s*;\s*$|mg) { my ($rhs, $sub, $args) = ($1, $2, $3); my $replacement = build_assignment_sub(\%inline, $sub, $rhs, $args); my $rhs_quoted = quotemeta $rhs; my $args_quoted = quotemeta $args; s|^\s*$rhs_quoted\s*=\s*$sub$args_quoted\s*;\s*$|$replacement|mg; } }; sub build_void_sub { my ($inline, $sub, $args) = @_; my $uniq_label = '__' . $sub . '__' . int(rand 42); my $replacement = "$uniq_label:\n$inline->{$sub}"; # Assignment to from @_ $replacement =~ s|^(.*)=\s*\@_\s*;\s*$|$1= $args;|m if $replacement =~ m|^.*=\s*\@_\s*;\s*$|m; # Replace return $replacement =~ s|^(\s*)return.*;\s*$|$1last $uniq_label;|mg; return $replacement; } sub build_assignment_sub { my ($inline, $sub, $rhs, $args) = @_; my $uniq_label = '__' . $sub . '__' . int(rand 42); my $replacement = ''; $replacement .= "$rhs;\n" if $rhs =~ m|^my|; $rhs =~ s|^my\s*||; $replacement .= "$uniq_label:\n$inline->{$sub}"; # Assignment to from @_ $replacement =~ s|^(.*)=\s*\@_\s*;\s*$|$1= $args;|m if $replacement =~ m|^.*=\s*\@_\s*;\s*$|m; # Replace return while ($replacement =~ m|^(\s*)return\s*(.*);\s*$|mg) { my ($leading_spaces, $return_value) = ($1, $2); $return_value = 'undef' if ! length($return_value); $replacement =~ s|^\s*return\s*.*;\s*$|$leading_spaces$rhs = $return_value;\n${leading_spaces}last $uniq_label;|m; } return $replacement; } sub extract_inlined_subs { my %inline; while ($_[0] =~ m|^inline sub (\w+)\s*({.*?^})|smg) { my ($sub, $body) = ($1, $2); $inline{$sub} = $body; $_[0] =~ s|^inline sub \w+.*?^}||sm; } return %inline; } sub build_sub_name_regex { my ($inline) = @_; my $ra = Regexp::Assemble->new; $ra->add($_) for keys %$inline; return $ra->re; } 'This statement is false'; #### #!/usr/bin/perl use strict; use warnings; use Inline::Sub; my @list = 1 .. 100; print time, "\n"; for (1 .. 5_000_000) { my $low = min(\@list); my $high = max(\@list); my $sum = sum(\@list); my $ave = $sum / @list; my $tot = @list; my $sd = sd(\@list); } print time, "\n"; inline sub min { my ($list) = @_; my $min; for (@$list) { $min = $_ if ! defined $min || $_ < $min; } return $min; } inline sub max { my ($list) = @_; my $max; for (@$list) { $max = $_ if ! defined $max || $_ > $max; } return $max; } inline sub sum { my ($list) = @_; my $tot = 0; $tot += $_ for @$list; return $tot; } inline sub sd { my ($list) = @_; my $sum = sum($list); my $ave = $sum / @$list; my $num = 0; $num += (($_ - $ave) ** 2) for @$list; return sqrt($num / @$list); }