From d219a89d8d6ecc553851687967473665a78c77c8 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Sun, 13 Feb 2011 18:47:12 +0000
Subject: some more notes on an optimizer

---
 lib/Tree/Transform/XSLTish/Optimizer.pm | 93 +++++++++++++++++++++++++++++++++
 1 file changed, 93 insertions(+)
 create mode 100644 lib/Tree/Transform/XSLTish/Optimizer.pm

(limited to 'lib/Tree/Transform/XSLTish/Optimizer.pm')

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;
-- 
cgit v1.2.3