some more notes on an optimizeroptimizer

4 files changed, 196 insertions, 1 deletions

diff --git a/lib/Tree/Transform/XSLTish/Optimizer.pm b/lib/Tree/Transform/XSLTish/Optimizer.pm
new file mode 100644
index 0000000..d6449ed
--- /dev/null
+++ b/lib/Tree/Transform/XSLTish/Optimizer.pm
@@ -0,0 +1,93 @@
+package Tree::Transform::XSLTish::Optimizer;
+use strict;
+use warnings;
+use Tree::XPathEngine;
+use Scalar::Util qw(blessed looks_like_number reftype);
+
+my $NCName = qr{(?: [A-Za-z_] [\w\\.\\-]* )}x;
+my $QName = qr{(?: $NCName : )? $NCName}x;
+
+sub optimize_single_step {
+    my ($path) = @_;
+
+    my $s=$path->as_string;
+
+warn "single: $s\n";
+
+    if ($s =~ m{\A \( child:: ($QName) \) \z}x) {
+        return "self::$1",0,0,'any';
+    }
+
+    if ($s =~ m{\A \( /descendant:: ($QName) (?: /self::node\(\) )? \) \z}x) {
+        return "self::$1",0,0,'any';
+    }
+
+    return;
+}
+
+sub optimize_simple_path {
+    my ($path) = @_;
+
+    my $s=$path->as_string;
+    $s =~ s{/self::node\(\)/}{/}g;
+
+warn "simple: $s\n";
+
+    return unless $s =~ m{\A \(
+      (?: (?:child|/descendant) :: $QName )
+      (?: / (?:child|descendant) :: $QName )+
+    \) \z}x;
+
+    $s =~ s{/self::node\(\)/}{/}g;
+    my @steps= reverse grep {$_} split '/',substr($s,1,-1);
+
+    my @new=();
+
+    while (my $step = shift @steps) {
+        if ($step =~ m{^child::($QName)$}) {
+            if (@new) {
+                push @new,"parent::$1";
+            }
+            else {
+                push @new,"self::$1";
+            }
+        }
+        elsif ($step =~ m{^descendant::($QName)$}) {
+            if (@steps) {
+                push @new,"ancestor::$1";
+            }
+            else {
+                push @new,"parent::$1";
+            }
+        }
+    }
+
+    return unless @new;
+
+    return join('/',@new),0,0,'any';
+}
+
+my @rules = (
+    \&optimize_single_step,
+    \&optimize_simple_path,
+);
+
+my @flds=qw(opt_pattern min_depth max_depth expected_result);
+sub optimize {
+    my ($class,$rule) = @_;
+
+    return unless $rule->{match};
+
+    my $path = Tree::XPathEngine->new(NAME=>$QName)->_parse($rule->{match});
+
+    for my $opt (@rules) {
+        if (my @ret=$opt->($path)) {
+            @{$rule}{@flds}=@ret;
+            return;
+        }
+    }
+
+    return;
+}
+
+1;
diff --git a/lib/Tree/Transform/XSLTish/Optimizer.pod b/lib/Tree/Transform/XSLTish/Optimizer.pod
index ce855d5..e721e72 100644
--- a/lib/Tree/Transform/XSLTish/Optimizer.pod
+++ b/lib/Tree/Transform/XSLTish/Optimizer.pod
@@ -1,4 +1,6 @@
-C</> is in fact C</child:> (so C</whatever:foo> does not count)
+=head1 random notes
+
+C</> is in fact C</child::> (so C</whatever::foo> does not count)
 C<//> can also be C<descendants(-or-self)?> (check that option)
 C<..> can also be C<parent>
 
@@ -11,3 +13,57 @@ path contains C</> but no C<//>, apply only at C<count('/') - count('..')> upwar
 path contains C</> but no C<..>, start at C<count('/') - count('..')> upwards (ok, C<//> counts as 1 C</>) and go up to root
 
 what about C<ancestors(-or-self)?> ??
+
+
+--------
+
+an optimizer takes a match rule and adds three slots:
+
+=over 4
+
+=item C<opt_pattern>
+
+a pattern to use instead of the C<match> one
+
+=item C<expected_result>
+
+enum, specifying what the pattern (either C<match> or C<opt_pattern>)
+should return for this rule to be considered matching:
+
+=over 8
+
+=item C<this>
+
+the node we are applying the rule to
+
+=item C<any>
+
+any node
+
+=back
+
+=item C<min_depth>
+
+the minimum depth (on the C<ancestor-or-self::> axis) to test; 0 (or
+C<undef>) means start at the current node, 1 means start at its
+parent, and so on
+
+=item C<max_depth>
+
+the maximum depth (on the C<ancestor-or-self::> axis) to test;
+C<undef> means "unlimited", i.e. stop only at the document root
+
+=back
+
+So:
+
+C<< match => 'foo' >> or C<< match => '//foo' >> would produce C<<
+opt_pattern => 'self::foo', min_depth => 0, max_depth => 0 >>
+
+C<< match => 'foo/bar' >> or C<< match => '//foo/bar' >> would produce
+C<< opt_pattern => 'self::bar/parent::foo', min_depth => 0, max_depth
+=> 0 >>
+
+---------
+
+we need a proper structure matcher!
diff --git a/lib/Tree/Transform/XSLTish/Optimizer/StructMatcher.pm b/lib/Tree/Transform/XSLTish/Optimizer/StructMatcher.pm
new file mode 100644
index 0000000..56b19c1
--- /dev/null
+++ b/lib/Tree/Transform/XSLTish/Optimizer/StructMatcher.pm
@@ -0,0 +1,15 @@
+package Tree::Transform::XSLTish::Optimizer::StructMatcher;
+use struct;
+use warnings;
+use Scalar::Util qw(blessed looks_like_number reftype);
+
+sub match {
+    my ($datum,$struct) = @_;
+
+    my $dc=blessed($datum);my $sc=blessed($struct);
+    my $dr=reftype($datum);my $sr=reftype($struct);
+
+    
+}
+
+1;
diff --git a/t/08-optimize.t b/t/08-optimize.t
new file mode 100644
index 0000000..bd1b891
--- /dev/null
+++ b/t/08-optimize.t
@@ -0,0 +1,31 @@
+#!perl
+use Test::Most;
+use strict;
+use warnings;
+use Tree::Transform::XSLTish::Optimizer;
+
+my $o=\&Tree::Transform::XSLTish::Optimizer::optimize;
+
+my @flds=qw(opt_pattern min_depth max_depth expected_result);
+my %cases=(
+    'foo' => [ 'self::foo',0,0,'any' ],
+    '//foo' => [ 'self::foo',0,0,'any' ],
+    'foo/bar' => [ 'self::bar/parent::foo',0,0,'any' ],
+    '//foo/bar' => [ 'self::bar/parent::foo',0,0,'any' ],
+);
+
+while (my ($path,$res) = each %cases) {
+
+    note "testing $path";
+
+    my $rule = { match => $path };
+    $o->('',$rule);
+
+    my $i=0;
+    for my $field (@flds) {
+        is($rule->{$field},$res->[$i],"$field ok") if defined $res->[$i];
+        ++$i;
+    }
+}
+
+done_testing;