svn commit: r431104 - in /spamassassin/branches/jm_re2c_hacks/rule2xs: ./ re2xs

[jm...@apache.org]

Author: jm
Date: Sat Aug 12 15:40:11 2006
New Revision: 431104

URL: http://svn.apache.org/viewvc?rev=431104&view=rev
Log:
import of Matt Sergeant's 're2xs' script, which uses re2c(1) to compile regexps into a fully-compiled, binary lexer XS module.  This has the potential to provide *insanely* fast rules -- which is nice.  Copied from http://www.sergeant.org/re2xs, via http://use.perl.org/~Matts/journal/30597

Added:
    spamassassin/branches/jm_re2c_hacks/rule2xs/
    spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs   (with props)

Added: spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs
URL: http://svn.apache.org/viewvc/spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs?rev=431104&view=auto
==============================================================================
--- spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs (added)
+++ spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs Sat Aug 12 15:40:11 2006
@@ -0,0 +1,388 @@
+#!/usr/bin/perl -w
+
+use ExtUtils::MakeMaker qw(prompt);
+use File::Copy;
+use Getopt::Long;
+
+use constant MAX_RULES => 60;
+
+our $NAME = "My::FastRE";
+our $FORCE;
+
+sub usage {
+	print "Usage:
+$0 [OPTIONS] file
+
+Options:
+	-n, --name N    : Name of the module
+	-h, --help      : This page
+	-f, --force     : run even if module dir exists
+\n";
+	exit();
+}
+
+GetOptions(
+	"name|n=s" => \$NAME,
+	"help|h"   => \&usage,
+	"force|f"  => \$FORCE,
+	);
+
+usage() unless @ARGV;
+our $FILE = shift @ARGV;
+-e $FILE || die "No such file: $FILE";
+
+if ($NAME eq "My::FastRE") {
+	$NAME = prompt("Module name?", $NAME);
+}
+
+our $PATH = $NAME;
+$PATH =~ s/::/-/g;
+our $PMFILE = $NAME;
+$PMFILE =~ s/.*:://;
+$PMFILE .= ".pm";
+our $XSFILE = $PMFILE;
+$XSFILE =~ s/\.pm$/.xs/;
+
+open(my $fh, "sort $FILE |") || die "open($FILE): $!";
+mkdir $PATH or (!$FORCE and die "mkdir($PATH): $!");
+chdir $PATH;
+
+my $numscans = 0;
+my (@dot_star, @dot_plus);
+
+while (!eof($fh)) {
+	$numscans++;
+	
+	open(my $re, ">scanner${numscans}.re") || die "open(>scanner{$numscans}.re): $!";
+	
+	print $re <<EOT;
+#define NULL            ((char*) 0)
+#define YYCTYPE         char
+#define YYCURSOR        p
+#define YYLIMIT         p
+#define YYMARKER        q
+#define YYFILL(n)
+EOT
+
+	print $re <<EOT;
+char *scan${numscans}(char *p){
+char *q;
+/*!re2c
+EOT
+
+	my $line = 0;
+	while (<$fh>) {
+		next if /^#/;
+		my ($regexp, $reason) = /^(.*):(.*)$/;
+		if ($regexp =~ /^\.\*/) {
+			push @dot_star, "$regexp:$reason";
+			next;
+		}
+		elsif ($regexp =~ /^\.\+/) {
+			push @dot_plus, "$regexp:$reason";
+			next;
+		}
+		print $re "\t", fixup_re($regexp), "               {return \"$reason\";}\n";
+		last if $line++ == MAX_RULES;
+	}
+	
+	print $re <<EOT;
+	[\\000-\\377]				{ return NULL; }
+*/
+}
+EOT
+
+	#last if $numscans == 2;
+}
+
+while (@dot_star) {
+	$numscans++;
+
+	open(my $re, ">scanner${numscans}.re") || die "open(>scanner{$numscans}.re): $!";
+	
+	print $re <<EOT;
+#define NULL            ((char*) 0)
+#define YYCTYPE         char
+#define YYCURSOR        p
+#define YYLIMIT         p
+#define YYMARKER        q
+#define YYFILL(n)
+EOT
+
+	print $re <<EOT;
+char *scan${numscans}(char *p){
+char *q;
+start:
+/*!re2c
+EOT
+
+	my $line = 0;
+	while ($_ = shift @dot_star) {
+		my ($regexp, $reason) = /^(.*):(.*)$/;
+		$regexp =~ s/^\.\*//;
+		print $re "\t", fixup_re($regexp), "               {return \"$reason\";}\n";
+		last if $line++ == MAX_RULES;
+	}
+	
+	print $re <<EOT;
+	[\\001-\\377]		{ goto start; }
+	[\\000]				{return NULL; }
+*/
+}
+EOT
+}
+
+while (@dot_plus) {
+	$numscans++;
+
+	open(my $re, ">scanner${numscans}.re") || die "open(>scanner{$numscans}.re): $!";
+	
+	print $re <<EOT;
+#define NULL            ((char*) 0)
+#define YYCTYPE         char
+#define YYCURSOR        p
+#define YYLIMIT         p
+#define YYMARKER        q
+#define YYFILL(n)
+EOT
+
+	print $re <<EOT;
+char *scan${numscans}(char *p){
+char *q;
+p++;
+start:
+/*!re2c
+EOT
+	
+	my $line = 0;
+	while ($_ = shift @dot_plus) {
+		my ($regexp, $reason) = /^(.*):(.*)$/;
+		$regexp =~ s/^\.\+//;
+		print $re "\t", fixup_re($regexp), "               {return \"$reason\";}\n";
+		last if $line++ == MAX_RULES;
+	}
+	
+	print $re <<EOT;
+	[\\001-\\377]		{ goto start; }
+	[\\000]				{return NULL; }
+*/
+
+}
+EOT
+}
+
+open(my $re, ">scanner.c") || die "open(>scanner.c): $!";
+	
+for (1..$numscans) {
+	print $re "char *scan$_(char *);\n";
+}
+
+print $re <<EOT;
+#define NULL            ((char*) 0)
+char *scan(char *p){
+int i;
+char *match;
+EOT
+
+for (1..$numscans) {
+	print $re "if (match = scan$_(p)) return match;\n";
+}
+
+print $re <<EOT;
+return NULL;
+}
+EOT
+
+close($re);
+
+print "Running re2c...\n";
+for (1..$numscans) {
+	print "$_ / $numscans ";
+	system("time re2c -i -b -o scanner$_.c scanner$_.re");
+}
+
+open(FILE, ">Makefile.PL") || die "write Makefile.PL: $!";
+print FILE <<"EOT";
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    'NAME' => '$NAME',
+    'VERSION_FROM' => '$PMFILE',
+    'OBJECT' => '\$(O_FILES)',
+    'OPTIMIZE' => '-O2',
+    'ABSTRACT_FROM' => '$PMFILE',
+    'AUTHOR' => 'A. N. Author <au...@example.com>',
+);
+EOT
+
+open(FILE, ">MANIFEST.SKIP") || die "write MANIFEST.SKIP: $!";
+print FILE <<'EOT';
+CVS/.*
+\.bak$
+\.sw[a-z]$
+\.tar$
+\.tgz$
+\.tar\.gz$
+\.o$
+\.xsi$
+\.bs$
+output/.*
+^.#
+^mess/
+^sqlite/
+^output/
+^tmp/
+^blib/
+^Makefile$
+^Makefile\.[a-z]+$
+^pm_to_blib$
+~$
+EOT
+
+open(FILE, ">scanner.h") || die "write scanner.h: $!";
+print FILE <<EOT;
+/* scanner.h */
+
+char *scan(char *);
+
+EOT
+
+open(FILE, ">$XSFILE") || die "write $XSFILE: $!";
+print FILE <<"EOT";
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "scanner.h"
+
+MODULE = $NAME  PACKAGE = $NAME
+
+PROTOTYPES: DISABLE
+
+char *
+scan(char *p);
+
+EOT
+
+open(FILE, ">$PMFILE") || die "write $PMFILE: $!";
+print FILE <<"EOT";
+
+package $NAME;
+
+use strict;
+use vars qw(\$VERSION \@ISA \@EXPORT_OK);
+
+use DynaLoader ();
+use Exporter ();
+
+BEGIN {
+\$VERSION = '1.0';
+\@ISA = qw(Exporter DynaLoader);
+\@EXPORT_OK = qw(scan);
+
+bootstrap $NAME \$VERSION;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+$NAME - Efficient string matching for regexps found in $FILE
+
+=head1 SYNOPSIS
+
+  use $NAME;
+  
+  ...
+  my \$match = ${NAME}::scan(\$string);
+
+=head1 DESCRIPTION
+
+This module is created by re2xs which uses re2c to create an XS library
+capable of scanning through a bunch of regular expressions as defined
+in F<$FILE>.
+
+That's all for now. Enjoy.
+
+=cut
+EOT
+
+sub fixup_re {
+	my $re = shift;
+	
+	# print "FIXUP: $re\n";
+	
+	my $output = "";
+	my $TOK = qr([\{\(\[\|\\\)\.\+\*]);
+	
+	my $STATE;
+	while ($re =~ /\G(.*?)($TOK)/gc) {
+		my $pre = $1;
+		my $tok = $2;
+		
+		if (length($pre)) {
+			$output .= "\"$pre\"";
+		}
+		if ($tok eq "(") {
+			# Grouping
+			if ($re =~ /\G(.*?)\)/gc) {
+				$output .= "( " . fixup_re($1) . " )";
+			}
+			else {
+				die "re: $re doesn't have group closing bracket";
+			}
+		}
+		elsif ($tok eq "|") {
+			$output .= " | ";
+		}
+		elsif ($tok eq "[") {
+			# chars
+			if ($re =~ /\G(.*?)\]/gc) {
+				$output .= "[$1]";
+			}
+			else {
+				die "re: $re doesn't have character class closing bracket";
+			}
+		}
+		elsif ($tok eq '{') {
+			if ($re =~ /\G(.*?)\}/gc) {
+				$output .= "{$1}";
+			}
+			else {
+				die "re: $re doesn't have quantifier closing bracket";
+			}
+		}
+		elsif ($tok eq '.') {
+			$output .= '.';
+		}
+		elsif ($tok eq '*') {
+			$output .= '* ';
+		}
+		elsif ($tok eq '+') {
+			$output .= '+ ';
+		}
+		elsif ($tok eq '\\') {
+			$re =~ /\G(.)/gc or die "\\ at end of string!";
+			my $esc = $1;
+			if ($esc !~ /^[\.\-\+\*_]$/) {
+				die "Unsupported escape: \\$esc";
+			}
+			$output .= "\"$esc\"";
+		}
+		else {
+			print "PRE: $pre\nTOK: $tok\n";
+		}
+	}
+	
+	if (!defined(pos($re))) {
+		# no matches
+		$output .= "\"$re\"";
+	}
+	elsif (pos($re) <= length($re)) {
+		$output .= fixup_re(substr($re, pos($re)));
+	}
+	
+	$output =~ s/""//g; # strip empty strings, or turn "abc""def" -> "abcdef"
+	# print "OUTPUT: $output\n";
+	return $output;
+}
\ No newline at end of file

Propchange: spamassassin/branches/jm_re2c_hacks/rule2xs/re2xs
------------------------------------------------------------------------------
    svn:executable = *