[svn:parrot] r45660 - trunk/runtime/parrot/library/ProfTest
cotto at svn.parrot.org
cotto at svn.parrot.org
Wed Apr 14 09:39:24 UTC 2010
Author: cotto
Date: Wed Apr 14 09:39:23 2010
New Revision: 45660
URL: https://trac.parrot.org/parrot/changeset/45660
Log:
[proftest] switch from grammar to manual string mangling
results in small t/profiling/profiling.t speedup and 97% speedup when parsing large profiles
Modified:
trunk/runtime/parrot/library/ProfTest/Matcher.nqp
trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp
trunk/runtime/parrot/library/ProfTest/Want.nqp
Modified: trunk/runtime/parrot/library/ProfTest/Matcher.nqp
==============================================================================
--- trunk/runtime/parrot/library/ProfTest/Matcher.nqp Wed Apr 14 08:12:34 2010 (r45659)
+++ trunk/runtime/parrot/library/ProfTest/Matcher.nqp Wed Apr 14 09:39:23 2010 (r45660)
@@ -24,21 +24,31 @@
my $start_line := 0;
my $max_line := +$profile.profile_array;
- my $curr_line;
+ my %curr_line;
my $curr_want;
while ($line_idx < $max_line) {
- $curr_line := $profile.profile_array[$line_idx];
+ %curr_line := $profile.profile_array[$line_idx];
$curr_want := self<wants>[$want_idx];
self.say("current want: "~$curr_want.get_str);
- self.say("current line: "~ ~$curr_line);
+ my $line_desc;
+ if self<debugging> {
+ $line_desc := "current line: " ~ %curr_line<type> ~'(';
+ for %curr_line -> $k {
+ unless $k eq 'type' {
+ $line_desc := "$line_desc :$k(" ~ %curr_line{$k} ~") ";
+ }
+ }
+ $line_desc := $line_desc ~ ")";
+ }
+ self.say($line_desc);
if $curr_want.goal {
self.say("SUCCESS\n");
return 1;
}
- elsif ($curr_want.accepts($curr_line)) {
+ elsif ($curr_want.accepts(%curr_line)) {
self.say("ACCEPTED");
$line_idx++;
Modified: trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp
==============================================================================
--- trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp Wed Apr 14 08:12:34 2010 (r45659)
+++ trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp Wed Apr 14 09:39:23 2010 (r45660)
@@ -21,29 +21,44 @@
my @pprof_lines := pir::split("\n", self<profile>);
self<profile_array> := ();
- grammar pprof_line {
- rule TOP { ^^ [ <variable_line> | <fixed_line> ] $$ }
-
- rule line_type { [ 'VERSION' | 'CLI' | 'END_OF_RUNLOOP' | 'CS' | 'OP' ] }
-
- rule fixed_line { <line_type> ':' <fixed_data> }
- rule fixed_data { \N* }
-
- rule variable_line { <line_type> ':' <variable_data>* }
- rule variable_data { '{x{' <field_name> ':' <field_data> '}x}' }
- rule field_name { <.ident> }
- #XXX(cotto): really need to find something better
- rule field_data { <[a..zA..Z0..9_\-;\/.]>* }
- }
-
for @pprof_lines -> $line {
- my $line_match := pprof_line.parse($line);
+ my $line_match := self.make_line_hash($line);
#pir::say($line);
#_dumper($line_match);
self<profile_array>.push($line_match);
}
}
+method make_line_hash($line) {
+
+ my %line_hash := {};
+
+ my $colon_idx := pir::index($line, ":");
+ #if the line starts with "VERSION, CLI or END_OF_RUNLOOP,
+ if ($colon_idx >= 3) {
+ my $type := pir::substr($line, 0, $colon_idx);
+ my $data := pir::substr($line, $colon_idx+1);
+ %line_hash<type> := $type;
+ %line_hash<data> := $data;
+ }
+ else {
+ my $type := pir::substr($line, 0, $colon_idx);
+ %line_hash<type> := $type;
+ $line := pir::substr($line, $colon_idx+1);
+ while ($line) {
+ $line := pir::substr($line, 3);
+ my $colon_idx := pir::index($line, ":");
+ my $split_idx := pir::index($line, "}x}");
+ my $name := pir::substr($line, 0, $colon_idx);
+ my $value := pir::substr($line, $colon_idx+1, $split_idx-$colon_idx-1);
+ %line_hash{ $name } := $value;
+ $line := pir::substr($line, $split_idx+3);
+ }
+ }
+ %line_hash;
+}
+
+
method build_pir_profile() {
my %config := self.get_config();
@@ -76,8 +91,16 @@
my $pprof_fh := pir::new__p_sc('FileHandle');
self<profile> := $pprof_fh.readall($tmp_pprof);
- pir::new__p_sc('OS').rm($tmp_pir);
- pir::new__p_sc('OS').rm($tmp_pprof);
+# pir::new__p_sc('OS').rm($tmp_pir);
+# pir::new__p_sc('OS').rm($tmp_pprof);
+}
+
+method line_is_cs($line) {
+ return $line<variable_line> && $line<variable_line><line_type> eq 'CS';
+}
+
+method line_is_op($line) {
+ return $line<variable_line> && $line<variable_line><line_type> eq 'OP';
}
method get_config() {
Modified: trunk/runtime/parrot/library/ProfTest/Want.nqp
==============================================================================
--- trunk/runtime/parrot/library/ProfTest/Want.nqp Wed Apr 14 08:12:34 2010 (r45659)
+++ trunk/runtime/parrot/library/ProfTest/Want.nqp Wed Apr 14 09:39:23 2010 (r45660)
@@ -8,14 +8,6 @@
method accepts() { 1; }
-method hashify_profile_data($data) {
- my %h := {};
- for $data -> $match {
- %h{ $match<field_name> } := $match<field_data>;
- }
- %h;
-}
-
method goal() { 0; }
@@ -36,13 +28,9 @@
self;
}
-method accepts($prof_line) {
- my $line_type := $prof_line<variable_line> ??
- $prof_line<variable_line><line_type> !!
- $prof_line<variable_line><line_type> ;
-
+method accepts(%prof_line) {
for self<except> -> $except_type {
- if $except_type eq $line_type {
+ if $except_type eq %prof_line<type>{
return 0;
}
}
@@ -63,13 +51,12 @@
class ProfTest::Want::Version is ProfTest::Want;
method new($version?) {
- self<version> := $version;
+ self<version> := $version;
self;
}
-method accepts($prof_line) {
- if $prof_line<fixed_line> &&
- $prof_line<fixed_line><line_type> eq 'VERSION' {
+method accepts(%prof_line) {
+ if %prof_line<type> eq 'VERSION' {
return 1;
}
}
@@ -87,13 +74,10 @@
class ProfTest::Want::CLI is ProfTest::Want;
-method new() {
- self;
-}
+method new() { self }
-method accepts($prof_line) {
- if $prof_line<fixed_line> &&
- $prof_line<fixed_line><line_type> eq 'CLI' {
+method accepts(%prof_line) {
+ if %prof_line<type> eq 'CLI' {
return 1;
}
}
@@ -106,9 +90,8 @@
method new() { self; }
-method accepts($prof_line) {
- if $prof_line<fixed_line> &&
- $prof_line<fixed_line><line_type> eq 'END_OF_RUNLOOP' {
+method accepts(%prof_line) {
+ if %prof_line<type> eq 'END_OF_RUNLOOP' {
return 1;
}
}
@@ -127,13 +110,12 @@
self;
}
-method accepts($prof_line) {
- if $prof_line<variable_line> && $prof_line<variable_line><line_type> eq 'OP' {
- my %variable_data := self.hashify_profile_data($prof_line<variable_line><variable_data>);
- if self<name> ne %variable_data<op> {
+method accepts(%prof_line) {
+ if %prof_line<type> eq 'OP' {
+ if self<name> ne %prof_line<op> {
return 0;
}
- if self<line> && self<line> != %variable_data<line> {
+ if self<line> && self<line> != %prof_line<line> {
return 0;
}
return 1;
@@ -163,20 +145,19 @@
self;
}
-method accepts($prof_line) {
+method accepts(%prof_line) {
if self<found_cs> && self<slurp_until> {
- if pir::downcase($prof_line<variable_line><line_type>) ne self<slurp_until> {
+ if pir::downcase(%prof_line<type>) ne self<slurp_until> {
return 1;
}
return 0;
}
- elsif $prof_line<variable_line> && $prof_line<variable_line><line_type> eq 'CS' {
+ elsif %prof_line<type> eq 'CS' {
if !self<ns> {
self<found_cs> := 1;
return 1;
}
- my %h := self.hashify_profile_data($prof_line<variable_line><variable_data>);
- if %h<ns> eq self<ns> {
+ if %prof_line<ns> eq self<ns> {
self<found_cs> := 1;
return 1;
}
More information about the parrot-commits
mailing list