line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Tree::RB::XS; |
2
|
|
|
|
|
|
|
$Tree::RB::XS::VERSION = '0.05'; |
3
|
|
|
|
|
|
|
# VERSION |
4
|
|
|
|
|
|
|
# ABSTRACT: Red/Black Tree implemented in C, with similar API to Tree::RB |
5
|
|
|
|
|
|
|
|
6
|
10
|
|
|
10
|
|
2187975
|
use strict; |
|
10
|
|
|
|
|
79
|
|
|
10
|
|
|
|
|
292
|
|
7
|
10
|
|
|
10
|
|
52
|
use warnings; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
250
|
|
8
|
10
|
|
|
10
|
|
52
|
use Carp; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
983
|
|
9
|
|
|
|
|
|
|
require XSLoader; |
10
|
|
|
|
|
|
|
XSLoader::load('Tree::RB::XS', $Tree::RB::XS::VERSION); |
11
|
10
|
|
|
10
|
|
70
|
use Exporter 'import'; |
|
10
|
|
|
|
|
15
|
|
|
10
|
|
|
|
|
10742
|
|
12
|
|
|
|
|
|
|
our @_key_types= qw( KEY_TYPE_ANY KEY_TYPE_INT KEY_TYPE_FLOAT KEY_TYPE_BSTR KEY_TYPE_USTR ); |
13
|
|
|
|
|
|
|
our @_cmp_enum= qw( CMP_PERL CMP_INT CMP_FLOAT CMP_MEMCMP CMP_UTF8 CMP_NUMSPLIT ); |
14
|
|
|
|
|
|
|
our @_lookup_modes= qw( GET_EQ GET_EQ_LAST GET_GT GET_LT GET_GE GET_LE GET_LE_LAST GET_NEXT GET_PREV |
15
|
|
|
|
|
|
|
LUEQUAL LUGTEQ LULTEQ LUGREAT LULESS LUNEXT LUPREV ); |
16
|
|
|
|
|
|
|
our @EXPORT_OK= (@_key_types, @_cmp_enum, @_lookup_modes); |
17
|
|
|
|
|
|
|
our %EXPORT_TAGS= ( |
18
|
|
|
|
|
|
|
key_type => \@_key_types, |
19
|
|
|
|
|
|
|
cmp => \@_cmp_enum, |
20
|
|
|
|
|
|
|
lookup => \@_lookup_modes, |
21
|
|
|
|
|
|
|
get => \@_lookup_modes, |
22
|
|
|
|
|
|
|
all => \@EXPORT_OK, |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub new { |
27
|
45
|
|
|
45
|
1
|
3798498
|
my $class= shift; |
28
|
45
|
50
|
33
|
|
|
361
|
my %options= @_ == 1 && ref $_[0] eq 'HASH'? %{$_[0]} |
|
0
|
50
|
|
|
|
0
|
|
29
|
|
|
|
|
|
|
: @_ == 1? ( compare_fn => $_[0] ) |
30
|
|
|
|
|
|
|
: @_; |
31
|
45
|
|
|
|
|
128
|
my $self= bless \%options, $class; |
32
|
45
|
|
|
|
|
584
|
$self->_init_tree(delete $self->{key_type}, delete $self->{compare_fn}); |
33
|
45
|
100
|
|
|
|
172
|
$self->allow_duplicates(1) if delete $self->{allow_duplicates}; |
34
|
45
|
50
|
|
|
|
157
|
$self->compat_list_get(1) if delete $self->{compat_list_get}; |
35
|
45
|
|
|
|
|
141
|
$self; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
*root= *root_node; |
40
|
|
|
|
|
|
|
*min= *min_node; |
41
|
|
|
|
|
|
|
*max= *max_node; |
42
|
|
|
|
|
|
|
*nth= *nth_node; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub iter { |
46
|
118
|
|
|
118
|
1
|
5928
|
my ($self, $key_or_node, $mode)= @_; |
47
|
118
|
50
|
66
|
|
|
309
|
$key_or_node= $self->get_node($key_or_node, @_ > 2? $mode : GET_GE()) |
|
|
100
|
|
|
|
|
|
48
|
|
|
|
|
|
|
if @_ > 1 && ref $key_or_node ne 'Tree::RB::XS::Node'; |
49
|
118
|
|
66
|
|
|
416
|
Tree::RB::XS::Iter->_new($key_or_node || $self, 1); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub rev_iter { |
53
|
107
|
|
|
107
|
1
|
2198
|
my ($self, $key_or_node, $mode)= @_; |
54
|
107
|
50
|
66
|
|
|
270
|
$key_or_node= $self->get_node($key_or_node, @_ > 2? $mode : GET_LE_LAST()) |
|
|
100
|
|
|
|
|
|
55
|
|
|
|
|
|
|
if @_ > 1 && ref $key_or_node ne 'Tree::RB::XS::Node'; |
56
|
107
|
|
66
|
|
|
308
|
Tree::RB::XS::Iter->_new($key_or_node || $self, -1); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
*Tree::RB::XS::Node::min= *Tree::RB::XS::Node::left_leaf; |
61
|
|
|
|
|
|
|
*Tree::RB::XS::Node::max= *Tree::RB::XS::Node::right_leaf; |
62
|
|
|
|
|
|
|
*Tree::RB::XS::Node::successor= *Tree::RB::XS::Node::next; |
63
|
|
|
|
|
|
|
*Tree::RB::XS::Node::predecessor= *Tree::RB::XS::Node::prev; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub Tree::RB::XS::Node::strip { |
67
|
1
|
|
|
1
|
|
28
|
my ($self, $cb)= @_; |
68
|
1
|
|
33
|
|
|
14
|
my ($at, $next, $last)= (undef, $self->left_leaf || $self, $self->right_leaf || $self); |
|
|
|
33
|
|
|
|
|
69
|
1
|
|
|
|
|
2
|
do { |
70
|
3
|
|
|
|
|
11
|
$at= $next; |
71
|
3
|
|
|
|
|
10
|
$next= $next->next; |
72
|
3
|
100
|
|
|
|
8
|
if ($at != $self) { |
73
|
2
|
|
|
|
|
10
|
$at->prune; |
74
|
2
|
50
|
|
|
|
8
|
$cb->($at) if $cb; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} while ($at != $last); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub Tree::RB::XS::Node::as_lol { |
80
|
3
|
|
33
|
3
|
|
44
|
my $self= $_[1] || $_[0]; |
81
|
|
|
|
|
|
|
[ |
82
|
3
|
100
|
50
|
|
|
68
|
$self->left? $self->left->as_lol : '*', |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$self->right? $self->right->as_lol : '*', |
84
|
|
|
|
|
|
|
($self->color? 'R':'B').':'.($self->key||'') |
85
|
|
|
|
|
|
|
] |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub Tree::RB::XS::Node::iter { |
89
|
3
|
|
|
3
|
|
59
|
Tree::RB::XS::Iter->_new($_[0], 1); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub Tree::RB::XS::Node::rev_iter { |
93
|
1
|
|
|
1
|
|
1015
|
Tree::RB::XS::Iter->_new($_[0], -1); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# I can't figure out how to do the closure in XS yet |
98
|
|
|
|
|
|
|
sub Tree::RB::XS::Iter::_new { |
99
|
229
|
|
|
229
|
|
332
|
my $class= shift; |
100
|
229
|
|
|
|
|
291
|
my ($self,$y); |
101
|
229
|
|
|
0
|
|
801
|
$self= bless sub { Tree::XS::RB::Iter::next($y) }, $class; |
|
0
|
|
|
|
|
0
|
|
102
|
229
|
|
|
|
|
603
|
Scalar::Util::weaken($y= $self); |
103
|
229
|
|
|
|
|
1089
|
$self->_init(@_); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
sub Tree::RB::XS::Iter::clone { |
106
|
0
|
|
|
0
|
|
0
|
my $self= shift; |
107
|
0
|
|
|
|
|
0
|
ref($self)->_new($self); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
*TIEHASH= *new; |
112
|
|
|
|
|
|
|
*STORE= *put; |
113
|
|
|
|
|
|
|
*CLEAR= *clear; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub hseek { |
116
|
3
|
|
|
3
|
1
|
16750
|
my ($self, $key, $opts)= @_; |
117
|
3
|
100
|
100
|
|
|
19
|
if (@_ == 2 && ref $key eq 'HASH') { |
118
|
1
|
|
|
|
|
3
|
$opts= $key; |
119
|
1
|
|
|
|
|
2
|
$key= $opts->{'-key'}; |
120
|
|
|
|
|
|
|
} |
121
|
3
|
|
100
|
|
|
18
|
my $reverse= $opts && $opts->{'-reverse'} || 0; |
122
|
3
|
100
|
|
|
|
25
|
my $node= defined $key? $self->get_node($key, $reverse? GET_LE_LAST() : GET_GE()) : undef; |
|
|
100
|
|
|
|
|
|
123
|
3
|
|
|
|
|
19
|
$self->_set_hashiter($node, $reverse); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
*LUEQUAL= *GET_EQ; |
128
|
|
|
|
|
|
|
*LUGTEQ= *GET_GE; |
129
|
|
|
|
|
|
|
*LUGTLT= *GET_LE; |
130
|
|
|
|
|
|
|
*LUGREAT= *GET_GT; |
131
|
|
|
|
|
|
|
*LULESS= *GET_LT; |
132
|
|
|
|
|
|
|
*LUPREV= *GET_PREV; |
133
|
|
|
|
|
|
|
*LUNEXT= *GET_NEXT; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
1; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
__END__ |