Skip to content

Commit

Permalink
Use precompiled Parse::RecDescent parsers for moar speed
Browse files Browse the repository at this point in the history
Leverage the (hideous but effective) capability of Parse::RecDescent to
precompile concise gramars into multithousand line monsters. Improves
parsing and thus diffing speed considerably, i.e.:

Testing before:
Files=66, Tests=1851, 23 wallclock secs ( 0.38 usr  0.06 sys + 19.96 cusr  1.80 csys = 22.20 CPU)

Testing after:
Files=66, Tests=1858, 17 wallclock secs ( 0.38 usr  0.08 sys + 15.50 cusr  0.74 csys = 16.70 CPU)

A number of cleanups, including grammar fixes when transitioning from
q{} to heredocs. No functional changes at all.
  • Loading branch information
ribasushi committed Jan 17, 2012
1 parent 88ad825 commit bdf6058
Show file tree
Hide file tree
Showing 18 changed files with 940 additions and 48,753 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -12,4 +12,5 @@ blib/
inc/
pm_to_blib
t/data/roundtrip_autogen.yaml
share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/*.pm
*.swp
1 change: 1 addition & 0 deletions Changes
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
* All parser grammars are now precompiled for speed
* Proper quoting support in SQLite
* Support for triggers in PostgreSQL producer and parser
* Correct Data Type in SQLT::Parser::DBI::PostgreSQL (patch from Andrew Pam)
Expand Down
52 changes: 49 additions & 3 deletions Makefile.PL
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ my $deps = {
'Carp::Clan' => 0,
'IO::Dir' => 0,
'IO::Scalar' => 2.110,
'Parse::RecDescent' => 1.962002,
'Parse::RecDescent' => 1.964001,
'Pod::Usage' => 0,
'DBI' => 0,
'File::ShareDir' => 1.0,
Expand Down Expand Up @@ -88,8 +88,54 @@ if ($Module::Install::AUTHOR) {
WriteAll();

sub _recompile_grammars {
# placeholder, will be used to recompile P::RD parsers before shipping
# will also allow to lose dependency on P::RD
require File::Spec;

my $compiled_parser_dir = File::Spec->catdir(qw/
share PrecompiledParsers Parse RecDescent DDL SQLT
/);

# Currently consider only single-name parsers containing a grammar marker
# This is somewhat fragile, but better than loading all kinds of parsers
# to some of which we may not even have the deps
my $parser_libdir = 'lib/SQL/Translator/Parser';
for my $parser_fn (glob "$parser_libdir/*.pm") {
die "$parser_fn does not look like a readable file\n"
unless ( -f $parser_fn and -r $parser_fn );

my ($type) = $parser_fn =~ /^\Q$parser_libdir\E\/(.+)\.pm$/i
or die "$parser_fn not named in expected format\n";

my $parser_source = do { local (@ARGV, $/) = $parser_fn; <> };
next unless $parser_source =~ /\$GRAMMAR.+?END_OF_GRAMMAR/s;


my $precomp_parser_fn = File::Spec->catfile($compiled_parser_dir, "$type.pm");

next if (
-f $precomp_parser_fn
and
(stat($parser_fn))[9] <= (stat($precomp_parser_fn))[9]
);


print "Precompiling parser for $type\n";

require $parser_fn;
require Parse::RecDescent;

Parse::RecDescent->Precompile(
do {
no strict 'refs';
${"SQL::Translator::Parser::${type}::GRAMMAR"}
|| die "No \$GRAMMAR global found in SQL::Translator::Parser::$type ($parser_fn)\n"
},
"Parse::RecDescent::DDL::SQLT::$type"
);

rename( "$type.pm", $precomp_parser_fn )
or die "Unable to move $type.pm to $compiled_parser_dir: $!\n";
}

}

sub _recreate_rt_source {
Expand Down
35 changes: 16 additions & 19 deletions lib/SQL/Translator/Parser/Access.pm
Original file line number Diff line number Diff line change
Expand Up @@ -21,23 +21,19 @@ something similar to the output of mdbtools (http://mdbtools.sourceforge.net/).

use strict;
use warnings;
our ( $DEBUG, $GRAMMAR, @EXPORT_OK );

our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;

use Data::Dumper;
use Parse::RecDescent;
use Exporter;
use base qw(Exporter);
our $DEBUG;
$DEBUG = 0 unless defined $DEBUG;

@EXPORT_OK = qw(parse);
use Data::Dumper;
use SQL::Translator::Utils qw/ddl_parser_instance/;

# Enable warnings within the Parse::RecDescent module.
$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
$::RD_HINT = 1; # Give out hints to help fix problems.
use base qw(Exporter);
our @EXPORT_OK = qw(parse);

$GRAMMAR = q!
our $GRAMMAR = <<'END_OF_GRAMMAR';
{
my ( %tables, $table_order, @table_comments );
Expand Down Expand Up @@ -263,7 +259,7 @@ not_null : /not/i /null/i { $return = 0 }
unsigned : /unsigned/i { $return = 0 }
default_val : /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
default_val : /default/i /'(?:.*?\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
{
$item[2] =~ s/^\s*'|'\s*$//g;
$return = $item[2];
Expand Down Expand Up @@ -379,19 +375,20 @@ VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
| /NULL/
{ 'NULL' }
!;
END_OF_GRAMMAR

sub parse {
my ( $translator, $data ) = @_;
my $parser = Parse::RecDescent->new($GRAMMAR);

# Enable warnings within the Parse::RecDescent module.
local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
local $::RD_WARN = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
local $::RD_HINT = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.

local $::RD_TRACE = $translator->trace ? 1 : undef;
local $DEBUG = $translator->debug;

unless (defined $parser) {
return $translator->error("Error instantiating Parse::RecDescent ".
"instance: Bad grammer");
}
my $parser = ddl_parser_instance('Access');

my $result = $parser->startrule($data);
return $translator->error( "Parse failed." ) unless defined $result;
Expand Down
Loading

0 comments on commit bdf6058

Please sign in to comment.