line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Parse::Gnaw::LinkedList; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
#BEGIN {warn "inside Parse::Gnaw::LinkedList";} |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.001'; |
9
|
|
|
|
|
|
|
|
10
|
21
|
|
|
21
|
|
9748
|
use warnings; |
|
21
|
|
|
|
|
46
|
|
|
21
|
|
|
|
|
830
|
|
11
|
21
|
|
|
21
|
|
118
|
use strict; |
|
21
|
|
|
|
|
38
|
|
|
21
|
|
|
|
|
595
|
|
12
|
19
|
|
|
19
|
|
101
|
use Data::Dumper; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
1008
|
|
13
|
19
|
|
|
19
|
|
98
|
use Carp; |
|
19
|
|
|
|
|
32
|
|
|
19
|
|
|
|
|
1176
|
|
14
|
|
|
|
|
|
|
|
15
|
19
|
|
|
19
|
|
9804
|
use Parse::Gnaw::Blocks::Letter; |
|
19
|
|
|
|
|
47
|
|
|
19
|
|
|
|
|
589
|
|
16
|
19
|
|
|
19
|
|
159
|
use Parse::Gnaw::Blocks::LetterConstants; |
|
19
|
|
|
|
|
34
|
|
|
19
|
|
|
|
|
1716
|
|
17
|
19
|
|
|
19
|
|
101
|
use Parse::Gnaw::LinkedListConstants; |
|
19
|
|
|
|
|
37
|
|
|
19
|
|
|
|
|
1773
|
|
18
|
|
|
|
|
|
|
|
19
|
19
|
|
|
19
|
|
120
|
use base 'Parse::Gnaw::Blocks::ParsingMethods'; |
|
19
|
|
|
|
|
43
|
|
|
19
|
|
|
|
|
27568
|
|
20
|
19
|
|
|
19
|
|
146
|
use Parse::Gnaw::Blocks::ParsingMethods; |
|
19
|
|
|
|
|
38
|
|
|
19
|
|
|
|
|
41049
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 NAME |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Parse::Gnaw::LinkedList - A Parsable linked list of Parse::Gnaw::Letter objects. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
This class will create a basic, doubly-linked linked-list. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
A <=> B <=> C <=> D |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
B prev will point to A |
31
|
|
|
|
|
|
|
A next will point to B |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
and so on. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
If you want more sophisticated linked lists, then use this as a base class and |
36
|
|
|
|
|
|
|
override the create_interconnections_for_newly_appended_character method |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 VERSION |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Version 0.01 |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 get_raw_address |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
call letter package version of get_raw_address |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub get_raw_address{ |
56
|
0
|
|
|
0
|
1
|
0
|
Parse::Gnaw::Blocks::Letter::get_raw_address(@_); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head2 constructor_defaults |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
return a hash containing the default values for constructor arguments. |
62
|
|
|
|
|
|
|
this gets overloaded by derived classes so base constructor always does the right thing. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
sub constructor_defaults{ |
66
|
|
|
|
|
|
|
# derived classes always override the defaults for constructor |
67
|
21
|
|
|
21
|
1
|
111
|
my %defaults=( |
68
|
|
|
|
|
|
|
# you don't have to pass in a string to convert into a linked list. |
69
|
|
|
|
|
|
|
# can create bare linked list now, and then append string later. |
70
|
|
|
|
|
|
|
string=>'', |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# how many connections/directions between each letter. |
73
|
|
|
|
|
|
|
# a connection might be "horizontal". |
74
|
|
|
|
|
|
|
# note that each connection/direction has a next/previous idea built in. |
75
|
|
|
|
|
|
|
# so if you have one connection/direction that is "horizontal", |
76
|
|
|
|
|
|
|
# then next/previous might translate into left/right. |
77
|
|
|
|
|
|
|
max_connections=>1, |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# linked list of something. this says of what. |
80
|
|
|
|
|
|
|
# can change this to make linked list of some other, new class. |
81
|
|
|
|
|
|
|
letterpkg=>'Parse::Gnaw::Blocks::Letter', |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
|
84
|
21
|
|
|
|
|
144
|
return (%defaults); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 new |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
The new method is a constructor for creating a linked list |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
sub new{ |
94
|
|
|
|
|
|
|
|
95
|
27
|
|
|
27
|
1
|
20794
|
my $llistpkg=shift(@_); |
96
|
27
|
|
|
|
|
154
|
my %defaults=$llistpkg->constructor_defaults(); |
97
|
|
|
|
|
|
|
|
98
|
27
|
|
|
|
|
62
|
my %arguments; |
99
|
|
|
|
|
|
|
|
100
|
27
|
100
|
|
|
|
116
|
if(scalar(@_)==1){ |
|
|
50
|
|
|
|
|
|
101
|
21
|
|
|
|
|
46
|
my $arg=shift(@_); |
102
|
21
|
50
|
|
|
|
80
|
if(ref($arg)){ |
103
|
0
|
|
|
|
|
0
|
croak "constructor doesnt know how to handle this argument '$arg'"; |
104
|
|
|
|
|
|
|
} |
105
|
21
|
|
|
|
|
63
|
$arguments{string}=$arg; |
106
|
|
|
|
|
|
|
} elsif((scalar(@_)%2)==1){ |
107
|
0
|
|
|
|
|
0
|
print Dumper \@_; |
108
|
0
|
|
|
|
|
0
|
croak "constructor doesnt know how to handle odd number of arguments"; |
109
|
|
|
|
|
|
|
} else { |
110
|
6
|
|
|
|
|
16
|
%arguments=@_; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
27
|
|
|
|
|
223
|
while(my($key,$val)=each(%defaults)){ |
114
|
81
|
100
|
|
|
|
265
|
unless(exists($arguments{$key})){ |
115
|
54
|
|
|
|
|
213
|
$arguments{$key}=$defaults{$key}; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
27
|
|
|
|
|
62
|
my $letterpkg=$arguments{letterpkg}; |
120
|
|
|
|
|
|
|
|
121
|
27
|
|
|
|
|
74
|
my $usecmd = "use $letterpkg;"; |
122
|
|
|
|
|
|
|
# warn "usecmd is '$usecmd' "; |
123
|
27
|
|
|
16
|
|
2155
|
eval($usecmd); |
|
16
|
|
|
7
|
|
136
|
|
|
16
|
|
|
|
|
33
|
|
|
16
|
|
|
|
|
316
|
|
|
7
|
|
|
|
|
44
|
|
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
85
|
|
124
|
|
|
|
|
|
|
|
125
|
27
|
|
|
|
|
84
|
my $connm1 =$arguments{max_connections}-1; |
126
|
|
|
|
|
|
|
|
127
|
27
|
|
|
|
|
154
|
my $llist=bless([],$llistpkg); |
128
|
|
|
|
|
|
|
|
129
|
27
|
|
|
|
|
208
|
$llist->[LIST__HEADING_DIRECTION_INDEX]=0; |
130
|
27
|
|
|
|
|
144
|
$llist->[LIST__HEADING_PREVNEXT_INDEX]=0; |
131
|
|
|
|
|
|
|
|
132
|
27
|
|
|
|
|
65
|
$llist->[LIST__LETTER_PACKAGE]=$letterpkg; |
133
|
27
|
|
|
|
|
47
|
$llist->[LIST__CONNECTIONS_MINUS_ONE]=$connm1; |
134
|
|
|
|
|
|
|
|
135
|
27
|
|
|
|
|
146
|
my $first=$letterpkg->new($llist,'FIRSTSTART', 0); |
136
|
27
|
|
|
|
|
119
|
my $last =$letterpkg->new($llist,'LASTSTART' , 0); |
137
|
|
|
|
|
|
|
|
138
|
27
|
|
|
|
|
54
|
$llist->[LIST__FIRST_START]=$first; |
139
|
|
|
|
|
|
|
|
140
|
27
|
|
|
|
|
45
|
$llist->[LIST__LAST_START]=$last; |
141
|
|
|
|
|
|
|
|
142
|
27
|
|
|
|
|
52
|
$llist->[LIST__CURR_START]=$first; |
143
|
|
|
|
|
|
|
|
144
|
27
|
|
|
|
|
53
|
$llist->[LIST__PREVIOUS_LINE_LETTER]=[]; |
145
|
27
|
|
|
|
|
101
|
$llist->[LIST__QUANTIFIER_STACK]=[]; |
146
|
27
|
|
|
|
|
52
|
$llist->[LIST__RULE_STACK]=[]; |
147
|
|
|
|
|
|
|
|
148
|
27
|
|
|
|
|
65
|
my $string = $arguments{string}; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# note that each class will define its own "append" method |
152
|
|
|
|
|
|
|
# depending on how many dimensions and connections the class |
153
|
|
|
|
|
|
|
# is trying to model. |
154
|
|
|
|
|
|
|
# the contructor will always call "append". |
155
|
|
|
|
|
|
|
# it is up to the class to override "append" to do the right thing. |
156
|
27
|
|
|
|
|
122
|
$llist->append($llist->[LIST__FIRST_START], $string); |
157
|
|
|
|
|
|
|
|
158
|
27
|
|
|
|
|
159
|
return $llist; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head2 append |
162
|
|
|
|
|
|
|
this gets overloaded by derived classes so base constructor always does the right thing. |
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
sub append{ |
165
|
21
|
|
|
21
|
1
|
37
|
my $obj=shift(@_); |
166
|
21
|
|
|
|
|
87
|
$obj->append_string(@_); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head2 get_location_of_caller |
170
|
|
|
|
|
|
|
If location is defined, just return that. |
171
|
|
|
|
|
|
|
If not, go through caller history and find first file/linenum that is not Parse::Gnaw related. |
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
sub get_location_of_caller{ |
174
|
27
|
|
|
27
|
1
|
49
|
my($llist,$location)=@_; |
175
|
|
|
|
|
|
|
|
176
|
27
|
50
|
|
|
|
78
|
if($location) { |
177
|
0
|
|
|
|
|
0
|
return $location; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
27
|
|
|
|
|
40
|
my @caller; |
181
|
27
|
|
|
|
|
62
|
foreach my $callbackdepth (1..10){ |
182
|
81
|
|
|
|
|
587
|
@caller=caller($callbackdepth); |
183
|
81
|
|
|
|
|
157
|
my $package=$caller[0]; |
184
|
81
|
100
|
|
|
|
293
|
last if(not($package =~ m{Parse::Gnaw})); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
27
|
|
50
|
|
|
130
|
my $sourcefilename = $caller[1] || 'unknown'; |
188
|
27
|
|
50
|
|
|
90
|
my $sourcelinenum = $caller[2] || 'unknown'; |
189
|
|
|
|
|
|
|
|
190
|
27
|
|
|
|
|
87
|
$location = "file $sourcefilename, line $sourcelinenum"; |
191
|
|
|
|
|
|
|
|
192
|
27
|
|
|
|
|
110
|
return $location; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head2 append_string |
196
|
|
|
|
|
|
|
append a single dimension line of text. |
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
sub append_string{ |
199
|
44
|
|
|
44
|
1
|
90
|
my($llist, $lettertoappendto, $stringtoappend, $location)=@_; |
200
|
|
|
|
|
|
|
|
201
|
44
|
100
|
|
|
|
122
|
if(not(defined($location))){ |
202
|
21
|
|
|
|
|
76
|
$location = $llist->get_location_of_caller($location); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
#warn "append_string llist=$llist, lettertoappendto=$lettertoappendto, stringtoappend=$stringtoappend, location=$location"; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
#die "$location"; |
208
|
|
|
|
|
|
|
|
209
|
44
|
|
|
|
|
194
|
my @characters=split(//, $stringtoappend); |
210
|
44
|
|
|
|
|
83
|
my $last_x_val = scalar(@characters)-1; |
211
|
44
|
|
|
|
|
86
|
my $first_letter_of_line; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
my @ltrobjs; |
214
|
|
|
|
|
|
|
|
215
|
44
|
|
|
|
|
145
|
for(my $x=0; $x<=$last_x_val; $x++){ |
216
|
209
|
|
|
|
|
302
|
my $character=$characters[$x]; |
217
|
209
|
|
|
|
|
447
|
my $charlocation = "$location, column $x"; |
218
|
|
|
|
|
|
|
|
219
|
209
|
|
|
|
|
524
|
my $newletter=$llist->append_character($lettertoappendto, $character, $charlocation); |
220
|
|
|
|
|
|
|
|
221
|
209
|
|
|
|
|
306
|
push(@ltrobjs,$newletter); |
222
|
209
|
|
|
|
|
676
|
$lettertoappendto=$newletter; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
44
|
|
|
|
|
173
|
for(my $x=0; $x<=$last_x_val; $x++){ |
226
|
|
|
|
|
|
|
|
227
|
209
|
|
|
|
|
275
|
my $centerletter=$ltrobjs[$x]; |
228
|
|
|
|
|
|
|
|
229
|
209
|
100
|
|
|
|
476
|
if($x>0){ |
230
|
165
|
|
|
|
|
230
|
my $leftletter=$ltrobjs[$x-1]; |
231
|
|
|
|
|
|
|
# connect the interconnections of the new/center letter to the letters on either side. |
232
|
165
|
|
|
|
|
570
|
$leftletter->link_two_letters_via_interconnection($centerletter,0); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# now that we're done adding this line, we can update the object "start of previoius line" |
239
|
|
|
|
|
|
|
# to be the first letter of the line we just added |
240
|
44
|
|
|
|
|
102
|
$llist->[LIST__PREVIOUS_LINE_LETTER]->[0]=$first_letter_of_line; |
241
|
|
|
|
|
|
|
|
242
|
44
|
|
|
|
|
177
|
return $lettertoappendto; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 append_character |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $newletter = $llist->append_character($lettertoappendto, $single_character_to_append, $location); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Note that the order in which you append individual characters becomes the default |
251
|
|
|
|
|
|
|
order for the next_start method. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=cut |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub append_character{ |
256
|
209
|
|
|
209
|
1
|
329
|
my($llist, $lettertoappendto, $single_character_to_append, $location)=@_; |
257
|
|
|
|
|
|
|
|
258
|
209
|
50
|
|
|
|
451
|
if(not(defined($location))){ |
259
|
0
|
|
|
|
|
0
|
$location = $llist->get_location_of_caller($location); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# we have lettertoappendto -> rightstartletter |
263
|
|
|
|
|
|
|
# we make lettertoappendto -> centerletter -> rightstartletter |
264
|
|
|
|
|
|
|
# before we do anything, get the rightstartletter so we can remember it. |
265
|
209
|
|
|
|
|
300
|
my $rightstartletter = $lettertoappendto->[LETTER__NEXT_START]; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# create the new letter, the center letter. |
268
|
209
|
|
|
|
|
287
|
my $letter_pkg = $llist->[LIST__LETTER_PACKAGE]; |
269
|
209
|
|
|
|
|
582
|
my $centerletter = $letter_pkg->new($llist, $single_character_to_append, $location); |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# connect the start position of center letter to the letters on either side |
272
|
209
|
|
|
|
|
593
|
$lettertoappendto->link_two_letters_via_next_start($centerletter); |
273
|
209
|
|
|
|
|
454
|
$centerletter->link_two_letters_via_next_start($rightstartletter); |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
209
|
|
|
|
|
540
|
return $centerletter; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head2 create_interconnections_for_newly_appended_character |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
for base class, don't make any connections automatically. |
282
|
|
|
|
|
|
|
let user, or derived class, make connections. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub create_interconnections_for_newly_appended_character{ |
287
|
0
|
|
|
0
|
1
|
0
|
my($llist,$prevletter,$justaddedletter)=@_; |
288
|
0
|
|
|
|
|
0
|
return; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head2 display |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
print out a formatted version of linked list object. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub display { |
299
|
6
|
|
|
6
|
1
|
47
|
my ($llist)=@_; |
300
|
|
|
|
|
|
|
|
301
|
6
|
|
|
|
|
921
|
print "Dumping LinkedList object\n"; |
302
|
|
|
|
|
|
|
|
303
|
6
|
|
|
|
|
462
|
print "LETPKG => ".($llist->[LIST__LETTER_PACKAGE])." # package name of letter objects\n"; |
304
|
|
|
|
|
|
|
|
305
|
6
|
|
|
|
|
466
|
print "CONNMIN1 => ".($llist->[LIST__CONNECTIONS_MINUS_ONE])." # max number of connections, minus 1\n"; |
306
|
|
|
|
|
|
|
|
307
|
6
|
|
|
|
|
669
|
print "HEADING_DIRECTION_INDEX => ".($llist->[LIST__HEADING_DIRECTION_INDEX])."\n"; |
308
|
6
|
|
|
|
|
413
|
print "HEADING_PREVNEXT_INDEX => ".($llist->[LIST__HEADING_PREVNEXT_INDEX]) ."\n"; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
|
311
|
6
|
|
|
|
|
417
|
print "FIRSTSTART => \n"; |
312
|
|
|
|
|
|
|
|
313
|
6
|
|
|
|
|
54
|
$llist->[LIST__FIRST_START]->display(); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
|
316
|
6
|
|
|
|
|
474
|
print "LASTSTART => \n"; |
317
|
|
|
|
|
|
|
|
318
|
6
|
|
|
|
|
39
|
$llist->[LIST__LAST_START]->display(); |
319
|
|
|
|
|
|
|
|
320
|
6
|
|
|
|
|
501
|
print "CURRPTR => \n"; |
321
|
|
|
|
|
|
|
|
322
|
6
|
|
|
|
|
34
|
$llist->[LIST__CURR_START]->display(); |
323
|
|
|
|
|
|
|
|
324
|
6
|
|
|
|
|
15
|
my $letterobj=$llist->[LIST__FIRST_START]; |
325
|
|
|
|
|
|
|
|
326
|
6
|
|
|
|
|
4753
|
print "\nletters, by order of next_start_position()\n"; |
327
|
|
|
|
|
|
|
|
328
|
6
|
|
|
|
|
31
|
my $count=0; |
329
|
|
|
|
|
|
|
|
330
|
6
|
|
66
|
|
|
85
|
while(($letterobj) and ($letterobj->[LETTER__DATA_PAYLOAD] ne 'LASTSTART')){ |
331
|
|
|
|
|
|
|
|
332
|
74
|
|
|
|
|
123
|
$letterobj=$letterobj->[LETTER__NEXT_START]; |
333
|
74
|
|
|
|
|
220
|
$letterobj->display(); |
334
|
|
|
|
|
|
|
|
335
|
74
|
50
|
|
|
|
556
|
last if($count++ > 24); |
336
|
|
|
|
|
|
|
#if($letterobj->[LETTER__DATA_PAYLOAD] eq 'p'){last;} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=head2 get_connection_iterator |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
return an array of connections we can iterate. should be something like this: |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
[ |
348
|
|
|
|
|
|
|
[0,0], |
349
|
|
|
|
|
|
|
[0,1], |
350
|
|
|
|
|
|
|
[1,0], |
351
|
|
|
|
|
|
|
[1,1], |
352
|
|
|
|
|
|
|
[2,0], |
353
|
|
|
|
|
|
|
[2,1], |
354
|
|
|
|
|
|
|
] |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
and so on. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=cut |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub get_connection_iterator{ |
361
|
0
|
|
|
0
|
1
|
0
|
my($llist)=@_; |
362
|
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
0
|
my $arrref=[]; |
364
|
0
|
|
|
|
|
0
|
my $cm1 = ($llist->[LIST__CONNECTIONS_MINUS_ONE])+0; |
365
|
|
|
|
|
|
|
#warn "connections minus one is '$cm1' "; |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
0
|
foreach my $dimension (0 .. $cm1){ |
368
|
0
|
|
|
|
|
0
|
for my $direction (0..1){ |
369
|
0
|
|
|
|
|
0
|
push(@$arrref, [$dimension,$direction]); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
#warn "conn iter "; print Dumper $arrref; |
374
|
0
|
|
|
|
|
0
|
return $arrref; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head2 get_more_letters |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Note that by default, this method simply dies. |
385
|
|
|
|
|
|
|
We assume that for this class, we won't be parsing a stream, |
386
|
|
|
|
|
|
|
that all letters will be in memory. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
If we want to handle parsing a stream, override this method to read text from a file and append it to the letter given. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
$which will be "CONNECTIONS" or "NEXTSTART", depending on who ran out of letters. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
$llist->get_more_letters($thisletter,$which,$axis); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=cut |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub get_more_letters{ |
397
|
0
|
|
|
0
|
1
|
0
|
my($llist,$thisletter,$which,$axis)=@_; |
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
0
|
die "GRAMMARFAIL"; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head2 run_coderef_and_catch_grammar_fail |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
call this subroutine and pass in a coderef. This sub will call coderef and trap grammarfailures. |
406
|
|
|
|
|
|
|
if grammar failed, return 0. |
407
|
|
|
|
|
|
|
if grammar passed, return 1. |
408
|
|
|
|
|
|
|
if grammar died for any other reason, pass the die along. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=cut |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub run_coderef_and_catch_grammar_fail{ |
413
|
0
|
|
|
0
|
1
|
0
|
my($llist, $coderef)=@_; |
414
|
0
|
0
|
|
|
|
0
|
unless(ref($coderef) eq 'CODE'){ |
415
|
0
|
|
|
|
|
0
|
confess "ERROR: run_subroutine_and_catch_grammar_fail expects first parameter to be a code ref. found $coderef"; |
416
|
|
|
|
|
|
|
} |
417
|
0
|
|
|
|
|
0
|
eval{ |
418
|
0
|
|
|
|
|
0
|
$coderef->(); |
419
|
|
|
|
|
|
|
}; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# if we died, |
422
|
0
|
0
|
|
|
|
0
|
if($@){ |
423
|
|
|
|
|
|
|
# if we died because of GRAMMARFAIL, then that just means we didn't match |
424
|
0
|
0
|
|
|
|
0
|
if($@ =~ m{GRAMMARFAIL}){ |
425
|
0
|
|
|
|
|
0
|
return 0; |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# otherwise we died of some sort of real crash/error. |
428
|
|
|
|
|
|
|
} else { |
429
|
0
|
|
|
|
|
0
|
die $@; # some other kind of error. |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# if we didn't die, return success |
433
|
|
|
|
|
|
|
} else { |
434
|
0
|
|
|
|
|
0
|
return 1; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head2 convert_rule_name_to_rule_reference |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
Given a grammar rule and a string: |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
rule('firstrule', 'a', call('subrule'), 'd'); |
447
|
|
|
|
|
|
|
my $ab_string=Parse::Gnaw::LinkedList->new('abcdefg'); |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Users can call parse() multiple ways. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
The first way to call it is by passing in the array reference to the rule. |
453
|
|
|
|
|
|
|
Every rule defined creates an array reference in the caller's package namespace. |
454
|
|
|
|
|
|
|
And that array reference is the same name as the rule, and contains the rule structure. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
$ab_string->parse($firstrule) |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
The second way to call it is by passing in the name of the rule as a string. |
459
|
|
|
|
|
|
|
This can either be a simple name without the package specifier: |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
$ab_string->parse('firstrule'); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Or it can be a fully package specified name: |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
$ab_string->parse('main::firstrule'); |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=cut |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub convert_rule_name_to_rule_reference{ |
472
|
|
|
|
|
|
|
|
473
|
54
|
|
|
54
|
1
|
95
|
my($llist,$rulename)=@_; |
474
|
|
|
|
|
|
|
|
475
|
54
|
50
|
|
|
|
146
|
unless(defined($rulename)){ |
476
|
0
|
|
|
|
|
0
|
croak "ERROR: need to pass in a defined rule name"; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# this subroutine takes in the name of a rule, such as "Verilog::Module" |
480
|
|
|
|
|
|
|
# and returns the package variable $Verilog::Module, which must be an array reference. |
481
|
|
|
|
|
|
|
# if $grammarname is already an array reference, just return it. |
482
|
54
|
100
|
|
|
|
131
|
if(ref($rulename)){ |
483
|
9
|
50
|
|
|
|
30
|
if(ref($rulename) eq 'ARRAY'){ |
484
|
9
|
|
|
|
|
27
|
return $rulename; |
485
|
|
|
|
|
|
|
} else { |
486
|
0
|
|
|
|
|
0
|
print Dumper $rulename; |
487
|
0
|
|
|
|
|
0
|
confess "ERROR: called convert_rule_name_to_rule_reference and passed in a reference, and I can't handle it '$rulename'"; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
} else { |
490
|
45
|
|
|
|
|
59
|
my $ref; |
491
|
45
|
100
|
|
|
|
150
|
if($rulename =~ m{\:\:}){ |
492
|
32
|
|
|
|
|
76
|
my $eval='$ref= $'.$rulename.';'; |
493
|
32
|
|
|
|
|
2723
|
eval($eval); |
494
|
32
|
|
|
|
|
168
|
return $ref; |
495
|
|
|
|
|
|
|
} else { |
496
|
13
|
|
|
|
|
18
|
my $iter=1; |
497
|
13
|
|
|
|
|
22
|
ITERATOR : while(1){ |
498
|
13
|
|
|
|
|
85
|
my @caller=caller($iter++); |
499
|
13
|
50
|
|
|
|
45
|
if(scalar(@caller)<3){ |
500
|
0
|
|
|
|
|
0
|
confess "ERROR: tried to use caller($iter) but appears to be broken"; |
501
|
|
|
|
|
|
|
} |
502
|
13
|
|
|
|
|
21
|
my $package=$caller[0]; |
503
|
13
|
50
|
|
|
|
34
|
if($package =~ m{Parse::Gnaw}){ |
504
|
0
|
|
|
|
|
0
|
next ITERATOR; |
505
|
|
|
|
|
|
|
} |
506
|
13
|
|
|
|
|
18
|
my $ref; |
507
|
13
|
|
|
|
|
34
|
my $eval='$ref = $'.$package.'::'.$rulename.';'; |
508
|
|
|
|
|
|
|
#warn "eval is '$eval'"; |
509
|
13
|
|
|
|
|
905
|
eval($eval); |
510
|
13
|
50
|
33
|
|
|
109
|
unless( defined($ref) and (ref($ref) eq 'ARRAY') ){ |
511
|
0
|
|
|
|
|
0
|
confess "ERROR: unable to fine rule '$rulename' in package '$package'"; |
512
|
|
|
|
|
|
|
} |
513
|
13
|
|
|
|
|
59
|
return $ref; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head2 parse |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
$llist->parse($grammar); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Try to match the grammar to the llist, starting from where the CURR pointer points to. |
527
|
|
|
|
|
|
|
Do not try from any other location. |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=cut |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub parse{ |
535
|
22
|
|
|
22
|
1
|
118
|
my($llobj, $ruletocall)=@_; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# get a reference to original rule with this name. |
538
|
22
|
|
|
|
|
86
|
my $grammarref=$llobj->convert_rule_name_to_rule_reference($ruletocall); |
539
|
22
|
|
|
|
|
119
|
my @grammarcopy=@$grammarref; # make a shallow copy of rule. |
540
|
22
|
|
|
|
|
52
|
my $grammarcopyref=\@grammarcopy; # this is a reference to copy of rule |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
# the "parse" function always starts from the very beginning of the string. |
543
|
|
|
|
|
|
|
# so first thing we need to do is reset the current-pointer |
544
|
22
|
|
|
|
|
57
|
$llobj->[LIST__CURR_START] = $llobj->[LIST__FIRST_START]->[LETTER__NEXT_START]; |
545
|
|
|
|
|
|
|
|
546
|
22
|
|
|
|
|
40
|
my $save_start = $llobj->[LIST__CURR_START]; |
547
|
|
|
|
|
|
|
|
548
|
22
|
|
|
|
|
32
|
eval{ |
549
|
22
|
|
|
|
|
157
|
$llobj->parse_grammarref($grammarcopyref, ''); |
550
|
|
|
|
|
|
|
}; |
551
|
|
|
|
|
|
|
|
552
|
22
|
100
|
|
|
|
81
|
if($@){ |
553
|
|
|
|
|
|
|
#print "parse died with '$@'\n"; |
554
|
9
|
|
|
|
|
19
|
$llobj->[LIST__CURR_START] = $save_start; # failed or crashed, either way, restore pointer. |
555
|
|
|
|
|
|
|
|
556
|
9
|
50
|
|
|
|
42
|
if($@ =~ m{GRAMMARFAIL}){ |
557
|
9
|
|
|
|
|
63
|
return 0; |
558
|
|
|
|
|
|
|
} else { |
559
|
|
|
|
|
|
|
#print "parse other error\n"; |
560
|
0
|
|
|
|
|
0
|
die $@; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
} else { |
563
|
|
|
|
|
|
|
#print "parse matched\n"; |
564
|
|
|
|
|
|
|
|
565
|
13
|
|
|
|
|
113
|
return 1; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
=head2 match |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
$llist->match($grammar); |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Try to match the grammar to the llist, starting from where the CURR pointer points to, |
578
|
|
|
|
|
|
|
and trying every position until get a match or we hit the end of the llist. |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=cut |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
# possible issue here: |
583
|
|
|
|
|
|
|
# if we start out with an empty list, or with the currpointer at the last letter, |
584
|
|
|
|
|
|
|
# then we should really try to get more data first, then check to see if currptr equals LASTSTART. |
585
|
|
|
|
|
|
|
# if we check equality first, then match could fail before even trying. |
586
|
|
|
|
|
|
|
sub match{ |
587
|
0
|
|
|
0
|
1
|
0
|
my($myllist, $mygrammarref)=@_; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# the only way CURR would equal LAST would be if we ran out of text and couldn't append any new text. |
590
|
0
|
|
|
|
|
0
|
while($myllist->get_current_start() ne $myllist->get_last_start()){ |
591
|
|
|
|
|
|
|
|
592
|
0
|
0
|
|
|
|
0
|
if($myllist->parse($mygrammarref)){ |
593
|
0
|
|
|
|
|
0
|
return 1; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
0
|
|
|
|
|
0
|
$myllist->set_current_start( $myllist->get_current_start()->next_start_position()); # this will get more text if needed and if it can |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
1; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
|