keep a position cache to speed up sibling iteration

Iterating over siblings using ->next_sibling or similar methods will
take quadratic time if it has to search the parent's child list every
time.

Add a cache of the position in the parent's child list. When the
position of a child is requested, cache the position of every child of
the parent. Verifying that the cache is accurate is nearly instant, so
we can use that to invalidate the cache rather than invalidating on
modifications to the structure.

Update the __position method to use this cache, and change all of the
child iterating functions to use __position.

lib/PPI/Element.pm

@@ -25,10 +25,9 @@ use strict;
 use Clone 0.30      ();
 use Scalar::Util    qw{refaddr};
 use Params::Util    qw{_INSTANCE _ARRAY};
-use List::Util      ();
 use PPI::Util       ();
 use PPI::Node       ();
-use PPI::Singletons '%_PARENT';
+use PPI::Singletons '%_PARENT', '%_POSITION_CACHE';
 
 our $VERSION = '1.279';
 
@@ -259,9 +258,7 @@ sub next_sibling {
 	my $key      = refaddr $self;
 	my $parent   = $_PARENT{$key} or return '';
 	my $elements = $parent->{children};
-	my $position = List::Util::first {
-		refaddr $elements->[$_] == $key
-		} 0..$#$elements;
+	my $position = $parent->__position($self);
 	$elements->[$position + 1] || '';
 }
 
@@ -282,9 +279,7 @@ sub snext_sibling {
 	my $key      = refaddr $self;
 	my $parent   = $_PARENT{$key} or return '';
 	my $elements = $parent->{children};
-	my $position = List::Util::first {
-		refaddr $elements->[$_] == $key
-		} 0..$#$elements;
+	my $position = $parent->__position($self);
 	while ( defined(my $it = $elements->[++$position]) ) {
 		return $it if $it->significant;
 	}
@@ -307,9 +302,7 @@ sub previous_sibling {
 	my $key      = refaddr $self;
 	my $parent   = $_PARENT{$key} or return '';
 	my $elements = $parent->{children};
-	my $position = List::Util::first {
-		refaddr $elements->[$_] == $key
-		} 0..$#$elements;
+	my $position = $parent->__position($self);
 	$position and $elements->[$position - 1] or '';
 }
 
@@ -330,9 +323,7 @@ sub sprevious_sibling {
 	my $key      = refaddr $self;
 	my $parent   = $_PARENT{$key} or return '';
 	my $elements = $parent->{children};
-	my $position = List::Util::first {
-		refaddr $elements->[$_] == $key
-		} 0..$#$elements;
+	my $position = $parent->__position($self);
 	while ( $position-- and defined(my $it = $elements->[$position]) ) {
 		return $it if $it->significant;
 	}
@@ -844,8 +835,10 @@ sub _clear {
 # ->delete means our reference count has probably fallen to zero.
 # Therefore we don't need to remove ourselves from our parent,
 # just the index ( just in case ).
-### XS -> PPI/XS.xs:_PPI_Element__DESTROY 0.900+
-sub DESTROY { delete $_PARENT{refaddr $_[0]} }
+sub DESTROY {
+  delete $_PARENT{refaddr $_[0]};
+  delete $_POSITION_CACHE{refaddr $_[0]};
+}
 
 # Operator overloads
 sub __equals  { ref $_[1] and refaddr($_[0]) == refaddr($_[1]) }

lib/PPI/Node.pm

@@ -51,10 +51,9 @@ L<PPI::Element> objects also apply to C<PPI::Node> objects.
 use strict;
 use Carp            ();
 use Scalar::Util    qw{refaddr};
-use List::Util      ();
 use Params::Util    qw{_INSTANCE _CLASS _CODELIKE _NUMBER};
 use PPI::Element    ();
-use PPI::Singletons '%_PARENT';
+use PPI::Singletons '%_PARENT', '%_POSITION_CACHE';
 
 our $VERSION = '1.279';
 
@@ -510,9 +509,7 @@ sub remove_child {
 
 	# Find the position of the child
 	my $key = refaddr $child;
-	my $p   = List::Util::first {
-		refaddr $self->{children}[$_] == $key
-	} 0..$#{$self->{children}};
+	my $p   = $self->__position($child);
 	return undef unless defined $p;
 
 	# Splice it out, and remove the child's parent entry
@@ -702,23 +699,33 @@ sub DESTROY {
 		}
 	}
 
-	# Remove us from our parent node as normal
-	delete $_PARENT{refaddr $_[0]};
+	$_[0]->SUPER::DESTROY;
 }
 
-# Find the position of a child
 sub __position {
-	my $key = refaddr $_[1];
-	List::Util::first { refaddr $_[0]{children}[$_] == $key } 0..$#{$_[0]{children}};
+	my ( $self, $child ) = @_;
+	my $key = refaddr $child;
+
+	return undef unless #
+		my $elements = $self->{children};
+
+	if (defined (my $position = $_POSITION_CACHE{$key})) {
+		my $maybe_child = $elements->[$position];
+		return $position if defined $maybe_child and refaddr $maybe_child == $key;
+	}
+
+	delete $_POSITION_CACHE{$key};
+
+	$_POSITION_CACHE{refaddr $elements->[$_]} = $_ for 0 .. $#{$elements};
+
+	return $_POSITION_CACHE{$key};
 }
 
 # Insert one or more elements before a child
 sub __insert_before_child {
 	my ( $self, $child, @insertions ) = @_;
 	my $key  = refaddr $child;
-	my $p    = List::Util::first {
-	         refaddr $self->{children}[$_] == $key
-	         } 0..$#{$self->{children}};
+	my $p    = $self->__position($child);
 	foreach ( @insertions ) {
 		Scalar::Util::weaken(
 			$_PARENT{refaddr $_} = $self
@@ -732,9 +739,7 @@ sub __insert_before_child {
 sub __insert_after_child {
 	my ( $self, $child, @insertions ) = @_;
 	my $key  = refaddr $child;
-	my $p    = List::Util::first {
-	         refaddr $self->{children}[$_] == $key
-	         } 0..$#{$self->{children}};
+	my $p    = $self->__position($child);
 	foreach ( @insertions ) {
 		Scalar::Util::weaken(
 			$_PARENT{refaddr $_} = $self
@@ -750,9 +755,7 @@ sub __replace_child {
 	my $old_child_addr  = refaddr $old_child;
 
 	# Cache parent of new children
-	my $old_child_index = List::Util::first {
-	         refaddr $self->{children}[$_] == $old_child_addr
-	         } 0..$#{$self->{children}};
+	my $old_child_index = $self->__position($old_child);
 
 	return undef if !defined $old_child_index;
 

lib/PPI/Singletons.pm

@@ -8,9 +8,10 @@ use Exporter     ();
 our $VERSION = '1.279';
 
 our @ISA       = 'Exporter';
-our @EXPORT_OK = qw{ %_PARENT %OPERATOR %MAGIC %LAYER $CURLY_SYMBOL %QUOTELIKE %KEYWORDS };
+our @EXPORT_OK = qw{ %_PARENT %_POSITION_CACHE %OPERATOR %MAGIC %LAYER $CURLY_SYMBOL %QUOTELIKE %KEYWORDS };
 
 our %_PARENT; # Master Child -> Parent index
+our %_POSITION_CACHE; # cache for position in parent
 
 # operator index
 our %OPERATOR = map { $_ => 1 } (