line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Logic::Variable; |
2
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
25058
|
use 5.006001; |
|
8
|
|
|
|
|
30
|
|
|
8
|
|
|
|
|
325
|
|
4
|
|
|
|
|
|
|
|
5
|
8
|
|
|
8
|
|
47
|
use strict; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
325
|
|
6
|
8
|
|
|
8
|
|
43
|
no warnings; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
309
|
|
7
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
921
|
use Perl6::Attributes; |
|
8
|
|
|
|
|
30202
|
|
|
8
|
|
|
|
|
88
|
|
9
|
|
|
|
|
|
|
|
10
|
8
|
|
|
8
|
|
9543
|
use Carp; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
3012
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
{ |
13
|
|
|
|
|
|
|
my $counter = '0'; |
14
|
|
|
|
|
|
|
sub new { |
15
|
66
|
|
|
66
|
0
|
95
|
my ($class) = @_; |
16
|
66
|
|
33
|
|
|
641
|
bless { |
17
|
|
|
|
|
|
|
id => 'VAR' . $counter++, |
18
|
|
|
|
|
|
|
} => ref $class || $class; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub id { |
23
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
24
|
0
|
|
|
|
|
0
|
$.id; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub bound { |
28
|
161
|
|
|
161
|
0
|
189
|
my ($self, $state) = @_; |
29
|
161
|
100
|
|
|
|
572
|
$state->{$.id} && $state->{$.id}{bound}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub binding { |
33
|
81
|
|
|
81
|
0
|
99
|
my ($self, $state) = @_; |
34
|
81
|
50
|
|
|
|
232
|
croak "variable not bound!" unless $state->{$.id}{bound}; |
35
|
81
|
50
|
|
|
|
266
|
$state->{$.id} && $state->{$.id}{to}; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub bind { |
39
|
77
|
|
|
77
|
0
|
105
|
my ($self, $state, $to) = @_; |
40
|
77
|
|
|
|
|
239
|
$state->{$.id}{bound} = 1; |
41
|
77
|
|
|
|
|
274
|
$state->{$.id}{to} = $to; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub unbind { |
45
|
0
|
|
|
0
|
0
|
0
|
my ($self, $state) = @_; |
46
|
0
|
|
|
|
|
0
|
delete $state->{$.id}; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
package Logic::Variable::Pad; |
50
|
|
|
|
|
|
|
|
51
|
8
|
|
|
8
|
|
44
|
use Carp; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
8710
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub new { |
54
|
109
|
|
|
109
|
|
174
|
my ($class, $parent) = @_; |
55
|
109
|
|
33
|
|
|
652
|
tie my %self => ref $class || $class, $parent; |
56
|
109
|
|
33
|
|
|
1730
|
bless \%self => ref $class || $class; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub save { |
60
|
247
|
|
|
247
|
|
314
|
my ($self) = @_; |
61
|
247
|
|
33
|
|
|
591
|
$self = tied %$self || $self; |
62
|
247
|
|
|
|
|
294
|
++$.rev; |
63
|
247
|
|
|
|
|
236
|
push @.diff, { add => { }, alter => { }, src => $.rev, dest => $.rev+1 }; |
|
247
|
|
|
|
|
1172
|
|
64
|
247
|
|
|
|
|
644
|
$.rev; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub restore { |
68
|
112
|
|
|
112
|
|
1956
|
my ($self) = @_; |
69
|
112
|
|
33
|
|
|
241
|
$self = tied %$self || $self; |
70
|
|
|
|
|
|
|
|
71
|
112
|
50
|
|
|
|
97
|
croak "Already at revision zero" unless @.diff; |
|
112
|
|
|
|
|
275
|
|
72
|
112
|
|
|
|
|
114
|
my $diff = pop @.diff; |
|
112
|
|
|
|
|
157
|
|
73
|
112
|
|
|
|
|
116
|
for (keys %{$diff->{alter}}) { |
|
112
|
|
|
|
|
347
|
|
74
|
9
|
|
|
|
|
29
|
$.pad{$_} = $diff->{alter}{$_}; |
75
|
|
|
|
|
|
|
} |
76
|
112
|
|
|
|
|
144
|
for (keys %{$diff->{add}}) { |
|
112
|
|
|
|
|
278
|
|
77
|
43
|
|
|
|
|
147
|
delete $.pad{$_}; |
78
|
|
|
|
|
|
|
} |
79
|
112
|
|
|
|
|
6441
|
$.rev = $diff->{src}; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub revision { |
83
|
3
|
|
|
3
|
|
9
|
my ($self) = @_; |
84
|
3
|
|
33
|
|
|
9
|
$self = tied %$self || $self; |
85
|
3
|
|
|
|
|
14
|
$.rev; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub merge { |
89
|
11
|
|
|
11
|
|
15
|
my ($self, $src, $dest) = @_; |
90
|
11
|
|
33
|
|
|
35
|
$self = tied %$self || $self; |
91
|
|
|
|
|
|
|
|
92
|
11
|
|
|
|
|
24
|
my $si = $self->find_internal_diff($src); |
93
|
11
|
|
|
|
|
19
|
my $di = $self->find_internal_diff($dest); |
94
|
11
|
|
|
|
|
65
|
my $diff = { |
95
|
|
|
|
|
|
|
add => { }, |
96
|
|
|
|
|
|
|
alter => { }, |
97
|
|
|
|
|
|
|
src => $.diff[$si]{src}, |
98
|
|
|
|
|
|
|
dest => $.diff[$di]{dest}, |
99
|
|
|
|
|
|
|
}; |
100
|
|
|
|
|
|
|
|
101
|
11
|
|
|
|
|
24
|
for my $rev ($src..$dest) { |
102
|
14
|
|
|
|
|
14
|
$diff->{add}{$_} = $.diff[$rev]{add}{$_} for keys %{$.diff[$rev]{add}}; |
|
14
|
|
|
|
|
60
|
|
103
|
14
|
|
|
|
|
19
|
$diff->{alter}{$_} = $.diff[$rev]{alter}{$_} for keys %{$.diff[$rev]{alter}}; |
|
14
|
|
|
|
|
83
|
|
104
|
|
|
|
|
|
|
} |
105
|
11
|
|
|
|
|
15
|
splice @.diff, $si, $di-$si+1, $diff; |
|
11
|
|
|
|
|
56
|
|
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub commit { |
109
|
11
|
|
|
11
|
|
14
|
my ($self, $rev) = @_; |
110
|
11
|
|
33
|
|
|
39
|
$self = tied %$self || $self; |
111
|
11
|
|
|
|
|
24
|
$self->merge($rev, $.rev); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub find_internal_diff { |
115
|
|
|
|
|
|
|
# Yeah, I implement my own binary search. Search::Binary's interface is crap. |
116
|
22
|
|
|
22
|
|
49
|
my ($self, $rev) = @_; |
117
|
22
|
|
33
|
|
|
72
|
$self = tied %$self || $self; |
118
|
22
|
|
|
|
|
24
|
my $lo = 0; |
119
|
22
|
|
|
|
|
19
|
my $hi = @.diff-1; |
|
22
|
|
|
|
|
37
|
|
120
|
|
|
|
|
|
|
|
121
|
22
|
50
|
|
|
|
55
|
if ($rev > $.rev) { |
122
|
0
|
|
|
|
|
0
|
return scalar @.diff; |
|
0
|
|
|
|
|
0
|
|
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
22
|
|
|
|
|
39
|
while ($hi > $lo) { |
126
|
37
|
|
|
|
|
56
|
my $i = int(($hi+$lo)/2); |
127
|
37
|
100
|
|
|
|
99
|
if ($rev < $.diff[$i]{src}) { |
|
|
100
|
|
|
|
|
|
128
|
6
|
|
|
|
|
12
|
$hi = $i - 1; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
elsif ($rev >= $.diff[$i]{dest}) { |
131
|
21
|
|
|
|
|
42
|
$lo = $i + 1; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
else { |
134
|
10
|
|
|
|
|
22
|
return $i; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
12
|
|
|
|
|
17
|
return $lo; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# for saving memory for gc'd variables |
141
|
|
|
|
|
|
|
sub prune { |
142
|
0
|
|
|
0
|
|
0
|
my ($self, $key) = @_; |
143
|
0
|
|
0
|
|
|
0
|
$self = tied %$self || $self; |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
0
|
delete $.pad{$key}; |
146
|
0
|
|
|
|
|
0
|
for (@.diff) { |
|
0
|
|
|
|
|
0
|
|
147
|
0
|
|
|
|
|
0
|
delete $_->{alter}{$key}; |
148
|
0
|
|
|
|
|
0
|
delete $_->{add}{$key}; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub TIEHASH { |
153
|
109
|
|
|
109
|
|
157
|
my ($class, $parent) = @_; |
154
|
109
|
|
33
|
|
|
994
|
bless { |
155
|
|
|
|
|
|
|
parent => $parent && tied %$parent, |
156
|
|
|
|
|
|
|
pad => { }, |
157
|
|
|
|
|
|
|
rev => 0, |
158
|
|
|
|
|
|
|
diff => [ { add => { }, alter => { }, src => 0, dest => 1 } ], |
159
|
|
|
|
|
|
|
} => $class; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub FETCH { |
163
|
1036
|
|
|
1036
|
|
8286
|
my ($self, $key) = @_; |
164
|
1036
|
100
|
|
|
|
6466
|
$.pad{$key} && $.pad{$key}{value}; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub STORE { |
168
|
243
|
|
|
243
|
|
459
|
my ($self, $key, $value) = @_; |
169
|
243
|
100
|
|
|
|
474
|
if (exists $.pad{$key}) { |
170
|
143
|
100
|
|
|
|
333
|
if ($.pad{$key}{rev} < $.rev) { |
171
|
24
|
|
|
|
|
59
|
$.diff[-1]{alter}{$key} = $.pad{$key}; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
else { |
175
|
100
|
|
|
|
|
294
|
$.diff[-1]{add}{$key} = 1; |
176
|
|
|
|
|
|
|
} |
177
|
243
|
|
|
|
|
1269
|
$.pad{$key} = { value => $value, rev => $.rev }; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
1; |