Skip to content

Commit

Permalink
Lots of refactoring and other code mangling
Browse files Browse the repository at this point in the history 
This commit introduces some functional changes and some minor code
style tweaks.

Issues resolved: #32 #34 #48 #49 #50 #67 #70 #88 #95 #102 #103 #105

Kids, do not try this at home. Try to work on each issue separately.

Funtions that were returnings lists of things are a leftover from the
old times. For now, these were changed to return hashes, but some time
later these may start returning an object of some class.

Subclassing a Str was an interesting idea to make filters
work. However, mixing in some roles is probably more appropriate (but
still a bit unusual).

｢help｣ method is now actually required because of a stub in Helpful
role.

*Many* other changes as well, but given that all this was done in one
go, it is hard to highlight everything that was changed.

I consider all code style changes not very important, but with a code
base that is using two styles randomly, I'd much rather like
everything to be consistent. Therefore, here is an incomplete list:
* Avoid parens when possible, unless parens add clarity
* Prefer no semicolon if not needed
* Prefer trailing commas
* Prefer no “return” (unless it adds clarity)
* Prefer unicode ops and quotes
* Try to fit into some reasonable line length (80, or at least 120)
* Prefer $msg over $message (it is too common in this project)
* Prefer ｢with｣ and ｢without｣ instead of ｢if defined｣
* Lines with ｢use …;｣ are sorted alphabetically
  • Loading branch information
@AlexDaniel
AlexDaniel committed Mar 4, 2017
1 parent a44467e commit bbede98
Show file tree
Hide file tree
Showing 13 changed files with 767 additions and 623 deletions.
189 changes: 95 additions & 94 deletions Benchable.p6
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
#!/usr/bin/env perl6
# Copyright © 2016
# Copyright © 2016-2017
# Aleks-Daniel Jakimenko-Aleksejev <alex.jakimenko@gmail.com>
# Daniel Green <ddgreen@gmail.com>
#
Expand All @@ -17,53 +17,55 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.

use lib ‘.’;
use Misc;
use Whateverable;

use IRC::Client;

use SVG;
use SVG::Plot;
use File::Directory::Tree;
use SVG::Plot;
use SVG;
use Stats;

unit class Benchable is Whateverable;
unit class Benchable does Whateverable;

constant TOTAL-TIME = 60*4;
constant TOTAL-TIME = 60 × 4;
constant ITERATIONS = 5;
constant LIB-DIR = '.'.IO.absolute;
constant LIB-DIR = ‘.’.IO.absolute;

method help($message) {
'Like this: ' ~ $message.server.current-nick ~ ': f583f22,HEAD my $a = "a" x 2**16;for ^1000 {my $b = $a.chop($_)}'
method help($msg) {
‘Like this: ’ ~ $msg.server.current-nick
~ ‘: f583f22,HEAD my $a = ‘a’ x 2¹⁶; for ^1000 {my $b = $a.chop($_)}’
}

multi method benchmark-code($full-commit, $filename) {
my @times;
my %stats;
for ^ITERATIONS {
my ($, $exit, $signal, $time) = self.run-snippet($full-commit, $filename);
if $exit == 0 {
@times.push: sprintf('%.4f', $time);
} else {
%stats<err> = "«run failed, exit code = $exit, exit signal = $signal»";
return %stats;
my $result = self.run-snippet: $full-commit, $filename;
if $result<exit-code> != 0 {
%stats<err> = “«run failed, exit code = $result<exit-code>, exit signal = $result<signal>»”;
return %stats
}
@times.push: sprintf ‘%.4f’, $result<time>
}

%stats<min> = min(@times);
%stats<max> = max(@times);
%stats<mean> = mean(@times);
%stats<stddev> = sd(@times);
# TODO min/max/mean/sd are working on stringified numbers? Is that what we want?
%stats<min> = min @times;
%stats<max> = max @times;
%stats<mean> = mean @times;
%stats<stddev> = sd @times;

return %stats;
%stats
}

multi method benchmark-code($full-commit-hash, @code) {
my $code-to-compare = 'use Bench; my %subs = ' ~ @code.kv.map({ $^k => " => sub \{ $^v \} " }).join(',') ~ ';'
~ ' my $b = Bench.new; $b.cmpthese(' ~ ITERATIONS*2 ~ ', %subs)';
my $code-to-compare = ‘use Bench; my %subs = ’ ~ @code.kv.map({ $^k => “ => sub \{ $^v \} ” }).join(‘,’) ~ ‘;’
~ ‘ my $b = Bench.new; $b.cmpthese(’ ~ ITERATIONS × 2 ~ ‘, %subs)’;

# lock on the destination directory to make
# sure that other bots will not get in our way.
while run(‘mkdir’, ‘--’, “{BUILDS-LOCATION}/$full-commit-hash”).exitcode != 0 {
while run(‘mkdir’, ‘--’, “{BUILDS-LOCATION}/rakudo-moar/$full-commit-hash”).exitcode != 0 {
sleep 0.5;
# Uh, wait! Does it mean that at the same time we can use only one
# specific build? Yes, and you will have to wait until another bot
Expand All @@ -72,141 +74,140 @@ multi method benchmark-code($full-commit-hash, @code) {
# we should be doing everything in separate isolated containers (soon),
# so this problem will fade away.
}
my $proc = run(:out, :bin, ‘pzstd’, ‘-dqc’, ‘--’, “{ARCHIVES-LOCATION}/$full-commit-hash.zst”);
run(:in($proc.out), :bin, ‘tar’, ‘x’, ‘--absolute-names’);
my $proc = run :out, :bin, ‘pzstd’, ‘-dqc’, ‘--’, “{ARCHIVES-LOCATION}/rakudo-moar/$full-commit-hash.zst”;
run :in($proc.out), :bin, ‘tar’, ‘x’, ‘--absolute-names’;
my $timing;
if “{BUILDS-LOCATION}/$full-commit-hash/bin/perl6”.IO !~~ :e {
return ‘Commit exists, but a perl6 executable could not be built for it’;
if “{BUILDS-LOCATION}/rakudo-moar/$full-commit-hash/bin/perl6”.IO !~~ :e {
return ‘Commit exists, but a perl6 executable could not be built for it’
} else {
$timing = self.get-output(“{BUILDS-LOCATION}/$full-commit-hash/bin/perl6”, '--setting=RESTRICTED', '-I', "{LIB-DIR}/perl6-bench/lib,{LIB-DIR}/Perl6-Text--Table--Simple/lib", '-e', $code-to-compare).head;
$timing = self.get-output(“{BUILDS-LOCATION}/rakudo-moar/$full-commit-hash/bin/perl6”,
‘--setting=RESTRICTED’, ‘-I’,
“{LIB-DIR}/perl6-bench/lib,{LIB-DIR}/Perl6-Text--Table--Simple/lib”,
‘-e’, $code-to-compare)<output>
}
rmtree “{BUILDS-LOCATION}/$full-commit-hash”;
return $timing;
rmtree “{BUILDS-LOCATION}/rakudo-moar/$full-commit-hash”;
$timing
}

multi method irc-to-me($message where { .text ~~ /^ \s* $<config>=([:i compare \s]? \S+) \s+ $<code>=.+ / }) {
my ($value, %additional-files) = self.process($message, ~$<config>, ~$<code>);
return unless defined $value;
return ResponseStr.new(:$value, :$message, :%additional-files);
multi method irc-to-me($msg where .text ~~ /^ \s* $<config>=([:i compare \s]? \S+) \s+ $<code>=.+ /) {
my ($value, %additional-files) = self.process: $msg, ~$<config>, ~$<code>;
return without $value;
return ($value but Reply($msg)) but FileStore(%additional-files)
}

method process($message, $config, $code is copy) {
method process($msg, $config, $code is copy) {
my $start-time = now;
my $old-dir = $*CWD;
my ($commits-status, @commits) = self.get-commits($config);
my ($commits-status, @commits) = self.get-commits: $config;
return $commits-status unless @commits;

my ($succeeded, $code-response) = self.process-code($code, $message);
my ($succeeded, $code-response) = self.process-code: $code, $msg;
return $code-response unless $succeeded;
$code = $code-response;

my $filename = self.write-code($code);
my $filename = self.write-code: $code;

my $msg-response = '';
my $msg-response = ‘’;
my %graph;

my %times;
my $actually-tested = 0;

for @commits -> $commit {
FIRST my $once = 'Give me a ping, Vasili. One ping only, please.';
FIRST my $once = ‘Give me a ping, Vasili. One ping only, please.’;
# convert to real ids so we can look up the builds
my $full-commit = self.to-full-commit($commit);
my $short-commit = self.get-short-commit($commit);
my $full-commit = self.to-full-commit: $commit;
my $short-commit = self.get-short-commit: $commit;
if not defined $full-commit {
%times{$short-commit}<err> = ‘Cannot find this revision’;
} elsif not self.build-exists($full-commit) {
%times{$short-commit}<err> = ‘No build for this commit’;
my @options = <HEAD v6.c releases all>;
%times{$short-commit}<err> = ‘Cannot find this revision’
~ “ (did you mean “{self.get-short-commit: self.get-similar: $commit, @options}”?)”
# TODO why $commit is a match here when using compare?
} elsif not self.build-exists: $full-commit {
%times{$short-commit}<err> = ‘No build for this commit’
} else { # actually run the code
if $once.defined {
with $once {
my $c = +@commits;
my $s = $c == 1 ?? '' !! 's';
$message.reply: "starting to benchmark the $c given commit$s";
my $s = $c == 1 ⁇ ‘’ ‼ ‘s’;
$msg.reply: “starting to benchmark the $c given commit$s”
}
if $config ~~ /:i compare / {
%times{$short-commit} = self.benchmark-code($full-commit, $code.split('|||'));
%times{$short-commit} = self.benchmark-code: $full-commit, $code.split: ‘|||’
} else {
%times{$short-commit} = self.benchmark-code($full-commit, $filename);
%times{$short-commit} = self.benchmark-code: $full-commit, $filename
}
$actually-tested++
}

if (now - $start-time > TOTAL-TIME) {
return "«hit the total time limit of {TOTAL-TIME} seconds»";
if now - $start-time > TOTAL-TIME {
return “«hit the total time limit of {TOTAL-TIME} seconds»”
}
}

my $num-commits = +@commits;

# for these config options, check if there are any large speed differences between two commits and if so,
# for these config options, check if there are any large speed differences between two commits and if so,
# recursively find the commit in the middle until there are either no more large speed differences or no
# more commits inbetween (i.e., the next commit is the exact one that caused the difference)
if $config ~~ /:i releases | v? 6 \.? c | all / or $config.contains(',') {
if $num-commits < ITERATIONS {
my @prelim-commits = @commits.map({ self.get-short-commit($_) });
$message.reply: '¦' ~ @prelim-commits.map({ "«$_»:" ~(%times{$_}<err> // %times{$_}<min> // %times{$_}) }).join("\n¦");
}

if $actually-tested and
$config ~~ /:i ^ [ releases | v? 6 \.? c | all ] $ / or $config.contains: ‘,’ {
$msg.reply: ‘benchmarked the given commits, now zooming in on performance differences’;
chdir RAKUDO;

Z: loop (my int $x = 0; $x < @commits - 1; $x++) {
if (now - $start-time > TOTAL-TIME) {
$message.reply: "«hit the total time limit of {TOTAL-TIME} seconds»";
last Z;
Z: loop (my $x = 0; $x < @commits - 1; $x++) {
if now - $start-time > TOTAL-TIME {
return “«hit the total time limit of {TOTAL-TIME} seconds»”
}

next unless %times{@commits[$x]}:exists and %times{@commits[$x + 1]}:exists; # the commits have to have been run at all
next if %times{@commits[$x]}<err>:exists or %times{@commits[$x + 1]}<err>:exists; # and without error
if abs(%times{@commits[$x]}<min> - %times{@commits[$x + 1]}<min>) >= %times{@commits[$x]}<min>*0.1 {
once $message.reply: 'benchmarked the given commits and found a performance differences > 10%, now bisecting';
my ($new-commit, $exit-status, $exit-signal, $time) = self.get-output('git', 'rev-list', '--bisect', '--no-merges', @commits[$x] ~ '^..' ~ @commits[$x + 1]);
if $exit-status == 0 and $new-commit.defined and $new-commit ne '' {
my $short-commit = self.get-short-commit($new-commit);
if not self.build-exists($new-commit) {
%times{$short-commit}<err> = ‘No build for this commit’;
if abs(%times{@commits[$x]}<min> - %times{@commits[$x + 1]}<min>) >= %times{@commits[$x]}<min> × 0.1 {
my $result = self.get-output: ‘git’, ‘rev-list’, ‘--bisect’, ‘--no-merges’, @commits[$x] ~ ‘^..’ ~ @commits[$x + 1];
my $new-commit = $result<output>;
if $result<exit-code> == 0 and defined $new-commit and $new-commit ne ‘’ {
my $short-commit = self.get-short-commit: $new-commit;
if not self.build-exists: $new-commit {
%times{$short-commit}<err> = ‘No build for this commit’
} elsif %times{$short-commit}:!exists and $short-commit ne @commits[$x] and $short-commit ne @commits[$x + 1] { # actually run the code
%times{$short-commit} = self.benchmark-code($new-commit, $filename);
@commits.splice($x + 1, 0, $short-commit);
redo Z;
%times{$short-commit} = self.benchmark-code: $new-commit, $filename;
@commits.splice: $x + 1, 0, $short-commit;
redo Z
}
}
}
}
}

@commits .= map({ self.get-short-commit($_) });
@commits .= map: { self.get-short-commit: $_ };

if @commits >= ITERATIONS {
my $pfilename = 'plot.svg';
my $title = "$config $code".trans(['"'] => ['\"']);
my @valid-commits = @commits.grep({ %times{$_}<err>:!exists });
my @values = @valid-commits.map({ %times{$_}<min> });
my @labels = @valid-commits.map({ "$_ ({ .<mean max stddev>.map({ sprintf("%.2f", $_) }).join(',') with %times{$_} })" });
my $pfilename = ‘plot.svg’;
my $title = “$config $code”.trans: ｢"｣ => ｢\"｣;
my @valid-commits = @commits.grep: { %times{$_}<err>:!exists };
my @values = @valid-commits.map: { %times{$_}<min> };
my @labels = @valid-commits.map: { “$_ ({ .<mean max stddev>.map({ sprintf “%.2f”, $_ }).join: ‘,’ with %times{$_} })” };

my $plot = SVG::Plot.new(
width => 1000,
height => 800,
min-y-axis => 0,
:1000width,
:800height,
:0min-y-axis,
:$title,
values => (@values,),
values => (@values,),
:@labels,
background => 'white',
background => ‘white’,
).plot(:lines);

%graph{$pfilename} = SVG.serialize($plot);
%graph{$pfilename} = SVG.serialize: $plot
}

if $num-commits < @commits {
$msg-response ~= '¦' ~ @commits.map({ "«$_»:" ~(%times{$_}<err> // %times{$_}<min> // %times{$_}) }).join("\n¦");
} else {
return;
}
$msg-response ~= ‘¦’ ~ @commits.map({ “«$_»:” ~(%times{$_}<err> // %times{$_}<min> // %times{$_}) }).join: “\n¦”;

return ($msg-response, %graph);
return $msg-response, %graph;

LEAVE {
chdir $old-dir;
unlink $filename if $filename.defined and $filename.chars > 0;
unlink $filename if defined $filename and $filename.chars > 0
}
}

Benchable.new.selfrun(‘benchable6’, [ /bench6?/, fuzzy-nick(‘benchable6’, 2) ]);
Benchable.new.selfrun: ‘benchable6’, [ /bench6?/, fuzzy-nick(‘benchable6’, 2) ];

# vim: expandtab shiftwidth=4 ft=perl6
Loading

0 comments on commit bbede98

Please sign in to comment.