line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lingua::Romana::Perligata; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.601'; |
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
2754
|
use Filter::Util::Call; |
|
2
|
|
|
|
|
1755
|
|
|
2
|
|
|
|
|
125
|
|
6
|
2
|
|
|
2
|
|
1194
|
use IO::Handle; |
|
2
|
|
|
|
|
11296
|
|
|
2
|
|
|
|
|
138
|
|
7
|
2
|
|
|
2
|
|
1389
|
use Data::Dumper 'Dumper'; |
|
2
|
|
|
|
|
17482
|
|
|
2
|
|
|
|
|
6178
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
my $offset = 0; |
10
|
|
|
|
|
|
|
my $translate = 0; |
11
|
|
|
|
|
|
|
my $debug = 0; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub import { |
14
|
2
|
|
|
2
|
|
36
|
filter_add({}); |
15
|
2
|
|
|
|
|
80
|
$offset = (caller)[2]+1; |
16
|
2
|
|
|
|
|
9
|
$translate = grep /^converte?$/i, @_[1..$#_]; |
17
|
2
|
|
|
|
|
7
|
$debug = grep /^investiga?$/i, @_[1..$#_]; |
18
|
2
|
|
|
|
|
6
|
$lex = grep /^discribe?$/i, @_[1..$#_]; |
19
|
2
|
|
|
|
|
27
|
1; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$translator = q{ |
23
|
|
|
|
|
|
|
BEGIN { |
24
|
|
|
|
|
|
|
$SIG{__DIE__} = sub { die Lingua::Romana::Perligata::readversum($_[0]) }; |
25
|
|
|
|
|
|
|
$SIG{__WARN__} = sub { return if $_[0] =~ /(...) interpreted as function/; |
26
|
|
|
|
|
|
|
warn Lingua::Romana::Perligata::readversum($_[0]) }; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
0
|
|
0
|
sub unimport { filter_del() } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub filter { |
33
|
4
|
|
|
4
|
0
|
120
|
my($self) = @_ ; |
34
|
|
|
|
|
|
|
|
35
|
4
|
|
|
|
|
8
|
my $status = 1; |
36
|
4
|
|
|
|
|
93
|
$status = filter_read(100_000); |
37
|
4
|
50
|
|
|
|
16
|
return $status if $status<0; |
38
|
4
|
|
|
|
|
10
|
s/\A#!.*\n//; |
39
|
4
|
|
|
|
|
15
|
$tokens = tokenize($_); |
40
|
|
|
|
|
|
|
|
41
|
4
|
|
|
|
|
8
|
my @commands; |
42
|
4
|
|
|
|
|
17
|
push @commands, conn_command($tokens,'END') while @$tokens; |
43
|
4
|
|
|
|
|
8
|
$_ = join ";\n", map { $_->translate } @commands; |
|
4
|
|
|
|
|
13
|
|
44
|
|
|
|
|
|
|
|
45
|
4
|
0
|
33
|
|
|
28
|
if ($translate) { print and exit } |
|
0
|
50
|
|
|
|
0
|
|
|
|
50
|
|
|
|
|
|
46
|
|
|
|
|
|
|
elsif ($debug && /\S/) { |
47
|
0
|
|
|
|
|
0
|
print "=" x 72, |
48
|
|
|
|
|
|
|
"\nTranslated to:\n\n$_\n", |
49
|
|
|
|
|
|
|
"=" x 72; |
50
|
|
|
|
|
|
|
} |
51
|
4
|
|
|
|
|
25
|
$_ = "$translator\n#line $offset\n;$_"; |
52
|
4
|
|
|
|
|
3537
|
return $status; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
#==========TOKENIZER============ |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
0
|
0
|
0
|
sub adversum { " ad versum " . to_rn($_[0]->{line}) . "\n" } |
58
|
4
|
50
|
|
4
|
0
|
166
|
sub readversum { $_[0] =~ m{(.*)at\s+(\S+)\s+line\s+(\d+)(.*)}s or return $_[0]; |
59
|
0
|
|
|
|
|
0
|
return $1 . " ad $2 versum " . to_rn($3) . $4 } |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub make_range { |
62
|
20
|
|
|
20
|
0
|
27
|
my ($unit, $five, $ten) = @_; |
63
|
20
|
|
|
|
|
32
|
my ($two, $three) = ($unit x 2, $unit x 3); |
64
|
20
|
|
|
|
|
84
|
return [ "", $unit, $two, $three, $unit.$five, $five, |
65
|
|
|
|
|
|
|
$five.$unit, $five.$two, $five.$three, $unit.$ten ]; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my @order = ( |
69
|
|
|
|
|
|
|
make_range(qw{ I V X }), |
70
|
|
|
|
|
|
|
make_range(qw{ X L C }), |
71
|
|
|
|
|
|
|
make_range(qw{ C D M }), |
72
|
|
|
|
|
|
|
make_range(qw{ M I)) ((I)) }), |
73
|
|
|
|
|
|
|
make_range(qw{ ((I)) I))) (((I))) }), |
74
|
|
|
|
|
|
|
make_range(qw{ (((I))) I)))) ((((I)))) }), |
75
|
|
|
|
|
|
|
make_range(qw{ ((((I)))) I))))) (((((I))))) }), |
76
|
|
|
|
|
|
|
make_range(qw{ (((((I))))) I)))))) ((((((I)))))) }), |
77
|
|
|
|
|
|
|
make_range(qw{ ((((((I)))))) I))))))) (((((((I))))))) }), |
78
|
|
|
|
|
|
|
make_range(qw{ (((((((I))))))) I)))))))) ((((((((I)))))))) }), |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my %val; |
82
|
|
|
|
|
|
|
foreach my $power (0..$#order) { |
83
|
|
|
|
|
|
|
@val{@{$order[$power]}} = map {$_*10**$power} 0..9; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $roman = '(' . join(")(", map {join("|",map { quotemeta } reverse(@$_))} reverse @order) . '|)'; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub from_rn { |
89
|
2
|
|
|
2
|
0
|
5
|
my $val = shift; |
90
|
2
|
|
|
|
|
589
|
@numerals = $val =~ /(?:$roman)/ix; |
91
|
2
|
50
|
|
|
|
45
|
join("",@numerals) eq $val or return $val; |
92
|
2
|
|
|
|
|
5
|
my $an = 0; |
93
|
2
|
|
|
|
|
15
|
$an += $val{$_} foreach @numerals; |
94
|
2
|
|
|
|
|
9
|
return $an; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub __beautify__ { |
98
|
0
|
|
|
0
|
|
0
|
my ($text) = @_; |
99
|
0
|
|
|
|
|
0
|
$text =~ s/\b(\d+)\b/to_rn($1)/ge; |
|
0
|
|
|
|
|
0
|
|
100
|
0
|
|
|
|
|
0
|
return $text; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub to_rn { |
104
|
0
|
0
|
|
0
|
0
|
0
|
return "nullum" if $_[0] == 0; |
105
|
0
|
|
|
|
|
0
|
@digits = split '', $_[0]; |
106
|
0
|
0
|
|
|
|
0
|
return $_[0] if grep {/\D/} @digits; |
|
0
|
|
|
|
|
0
|
|
107
|
0
|
|
|
|
|
0
|
my $power = 0; |
108
|
0
|
|
|
|
|
0
|
my $rn = ""; |
109
|
0
|
|
0
|
|
|
0
|
$rn = $order[$power++][$_||0] . $rn foreach reverse @digits; |
110
|
0
|
|
|
|
|
0
|
return $rn; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub getline { |
114
|
0
|
|
|
0
|
0
|
0
|
my ($fh) = @_; |
115
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
116
|
0
|
|
|
|
|
0
|
my @lines = IO::Handle::getlines($fh); |
117
|
0
|
0
|
|
|
|
0
|
s/\b($roman)\b/$1 ? from_rn($1) : $1/ge for @lines; |
|
0
|
|
|
|
|
0
|
|
118
|
0
|
|
|
|
|
0
|
return @lines; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
else { |
121
|
0
|
|
|
|
|
0
|
my $line = IO::Handle::getline($fh); |
122
|
0
|
0
|
|
|
|
0
|
$line =~ s/\b($roman)\b/$1 ? from_rn($1) : $1/ge; |
|
0
|
|
|
|
|
0
|
|
123
|
0
|
|
|
|
|
0
|
return $line; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub multibless(\%$$) |
128
|
|
|
|
|
|
|
{ |
129
|
66
|
|
|
66
|
0
|
82
|
my ($hash,$blesstype,$lextype) = @_; |
130
|
66
|
|
|
|
|
223
|
foreach my $key (keys %$hash) |
131
|
|
|
|
|
|
|
{ |
132
|
1500
|
|
|
|
|
1284
|
$hash->{$key}{lex} = $lextype; |
133
|
1500
|
|
|
|
|
1496
|
bless $hash->{$key}, $blesstype; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub addres(\%$$) |
138
|
|
|
|
|
|
|
{ |
139
|
16
|
|
|
16
|
0
|
21
|
my ($hash,$blesstype,$lextype) = @_; |
140
|
16
|
|
|
|
|
12
|
my (%acc, %dat); |
141
|
16
|
|
|
|
|
44
|
foreach my $key (keys %$hash) |
142
|
|
|
|
|
|
|
{ |
143
|
256
|
|
|
|
|
195
|
$acc{$key.'mentum'} = { %{$hash->{$key}} }; |
|
256
|
|
|
|
|
744
|
|
144
|
256
|
|
|
|
|
228
|
$acc{$key.'menta'} = { %{$hash->{$key}} }; |
|
256
|
|
|
|
|
625
|
|
145
|
256
|
|
|
|
|
225
|
$dat{$key.'mento'} = { %{$hash->{$key}} }; |
|
256
|
|
|
|
|
635
|
|
146
|
256
|
|
|
|
|
207
|
$dat{$key.'mentis'} = { %{$hash->{$key}} }; |
|
256
|
|
|
|
|
751
|
|
147
|
|
|
|
|
|
|
} |
148
|
16
|
|
|
|
|
46
|
multibless %acc, $blesstype, $lextype.'_ACCUSATIVE'; |
149
|
16
|
|
|
|
|
92
|
multibless %dat, $blesstype, $lextype.'_DATIVE'; |
150
|
16
|
|
|
|
|
691
|
%$hash = ( %$hash, %acc, %dat ); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub add_genitives(\%$$$) |
154
|
|
|
|
|
|
|
{ |
155
|
6
|
|
|
6
|
0
|
16
|
my ($hash, $blesstype, $from, $to) = @_; |
156
|
6
|
|
|
|
|
26
|
foreach my $key (keys %$hash) |
157
|
|
|
|
|
|
|
{ |
158
|
228
|
|
|
|
|
171
|
my $genkey = $key; |
159
|
228
|
100
|
|
|
|
664
|
$genkey =~ s/$from$/$to/ or next; |
160
|
68
|
|
|
|
|
814
|
$hash->{$genkey} = bless { %{$hash->{$key}}, |
|
68
|
|
|
|
|
301
|
|
161
|
|
|
|
|
|
|
lex => 'GENITIVE' }, |
162
|
|
|
|
|
|
|
$blesstype; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my %literals = |
167
|
|
|
|
|
|
|
( |
168
|
|
|
|
|
|
|
'novumversum' => { perl => '"\n"' }, |
169
|
|
|
|
|
|
|
'biguttam' => { perl => '":"' }, |
170
|
|
|
|
|
|
|
'lacunam' => { perl => '" "' }, |
171
|
|
|
|
|
|
|
'stadium' => { perl => '"\t"' }, |
172
|
|
|
|
|
|
|
'parprimum' => { perl => '$1' }, |
173
|
|
|
|
|
|
|
'pardecimum' => { perl => '$10' }, |
174
|
|
|
|
|
|
|
'parsecundum' => { perl => '$2' }, |
175
|
|
|
|
|
|
|
'partertium' => { perl => '$3' }, |
176
|
|
|
|
|
|
|
'parquartum' => { perl => '$4' }, |
177
|
|
|
|
|
|
|
'parquintum' => { perl => '$5' }, |
178
|
|
|
|
|
|
|
'parsextum' => { perl => '$6' }, |
179
|
|
|
|
|
|
|
'parseptimum' => { perl => '$7' }, |
180
|
|
|
|
|
|
|
'paroctavum' => { perl => '$8' }, |
181
|
|
|
|
|
|
|
'parnonum' => { perl => '$9' }, |
182
|
|
|
|
|
|
|
'nomen' => { perl => '$<' }, |
183
|
|
|
|
|
|
|
); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
multibless %literals, 'Literal', 'ACCUSATIVE'; |
186
|
|
|
|
|
|
|
add_genitives %literals, 'Literal', 'um' => 'i'; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
my %numerals = |
190
|
|
|
|
|
|
|
( |
191
|
|
|
|
|
|
|
'nullum' => { perl => '0' }, |
192
|
|
|
|
|
|
|
'unum' => { perl => '1' }, |
193
|
|
|
|
|
|
|
'unam' => { perl => '1' }, |
194
|
|
|
|
|
|
|
'duo' => { perl => '2' }, |
195
|
|
|
|
|
|
|
'duas' => { perl => '2' }, |
196
|
|
|
|
|
|
|
'tres' => { perl => '3' }, |
197
|
|
|
|
|
|
|
'quattuor' => { perl => '4' }, |
198
|
|
|
|
|
|
|
'quinque' => { perl => '5' }, |
199
|
|
|
|
|
|
|
'sex' => { perl => '6' }, |
200
|
|
|
|
|
|
|
'septem' => { perl => '7' }, |
201
|
|
|
|
|
|
|
'octo' => { perl => '8' }, |
202
|
|
|
|
|
|
|
'novem' => { perl => '9' }, |
203
|
|
|
|
|
|
|
'decem' => { perl => '10' }, |
204
|
|
|
|
|
|
|
); |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
multibless %numerals, 'Literal', 'NUMERAL'; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
my %ordinals_a = |
210
|
|
|
|
|
|
|
( |
211
|
|
|
|
|
|
|
'nullimum' => { perl => '0' }, |
212
|
|
|
|
|
|
|
'primum' => { perl => '1' }, |
213
|
|
|
|
|
|
|
'secundum' => { perl => '2' }, |
214
|
|
|
|
|
|
|
'tertium' => { perl => '3' }, |
215
|
|
|
|
|
|
|
'quartum' => { perl => '4' }, |
216
|
|
|
|
|
|
|
'quintum' => { perl => '5' }, |
217
|
|
|
|
|
|
|
'sextum' => { perl => '6' }, |
218
|
|
|
|
|
|
|
'septimum' => { perl => '7' }, |
219
|
|
|
|
|
|
|
'octavum' => { perl => '8' }, |
220
|
|
|
|
|
|
|
'nonum' => { perl => '9' }, |
221
|
|
|
|
|
|
|
'decimum' => { perl => '10' }, |
222
|
|
|
|
|
|
|
); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
foreach ( map substr($_,0,-2), keys %ordinals_a ) { |
225
|
|
|
|
|
|
|
$ordinals_a{"${_}os"} = $ordinals_a{"${_}um"}; # MASC. PLURALS |
226
|
|
|
|
|
|
|
$ordinals_a{"${_}am"} = $ordinals_a{"${_}um"}; # FEMININE |
227
|
|
|
|
|
|
|
$ordinals_a{"${_}as"} = $ordinals_a{"${_}um"}; # FEM. PLURALS |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
multibless %ordinals_a, 'Ordinal', 'ORDINAL'; |
231
|
|
|
|
|
|
|
add_genitives %ordinals_a, 'Ordinal', 'um' => 'i'; |
232
|
|
|
|
|
|
|
add_genitives %ordinals_a, 'Ordinal', 'am' => 'ae'; |
233
|
|
|
|
|
|
|
# add_genitives %ordinals_a, 'Ordinal', 'os' => 'orum'; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my %ordinals_d = |
236
|
|
|
|
|
|
|
( |
237
|
|
|
|
|
|
|
'nullimo' => { perl => '0' }, |
238
|
|
|
|
|
|
|
'primo' => { perl => '1' }, |
239
|
|
|
|
|
|
|
'secundo' => { perl => '2' }, |
240
|
|
|
|
|
|
|
'tertio' => { perl => '3' }, |
241
|
|
|
|
|
|
|
'quarto' => { perl => '4' }, |
242
|
|
|
|
|
|
|
'quinto' => { perl => '5' }, |
243
|
|
|
|
|
|
|
'sexto' => { perl => '6' }, |
244
|
|
|
|
|
|
|
'septimo' => { perl => '7' }, |
245
|
|
|
|
|
|
|
'octavo' => { perl => '8' }, |
246
|
|
|
|
|
|
|
'nono' => { perl => '9' }, |
247
|
|
|
|
|
|
|
'decimo' => { perl => '10' }, |
248
|
|
|
|
|
|
|
); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
multibless %ordinals_d, 'Ordinal', 'ORDINAL_DATIVE'; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
my %underscores = |
253
|
|
|
|
|
|
|
( |
254
|
|
|
|
|
|
|
'hoc' => { perl => '$_', lex => 'ACCUSATIVE'}, |
255
|
|
|
|
|
|
|
'huius' => { perl => '$_', lex => 'GENITIVE'}, |
256
|
|
|
|
|
|
|
'huic' => { perl => '$_', lex => 'DATIVE'}, |
257
|
|
|
|
|
|
|
'haec' => { perl => '@_', lex => 'ACCUSATIVE'}, |
258
|
|
|
|
|
|
|
'horum' => { perl => '@_', lex => 'GENITIVE'}, |
259
|
|
|
|
|
|
|
'his' => { perl => '@_', lex => 'DATIVE'}, |
260
|
|
|
|
|
|
|
'ianitorem' => { perl => '$/', lex => 'ACCUSATIVE' }, |
261
|
|
|
|
|
|
|
'ianitoris' => { perl => '$/', lex => 'GENITIVE' }, |
262
|
|
|
|
|
|
|
'ianitori' => { perl => '$/', lex => 'DATIVE' }, |
263
|
|
|
|
|
|
|
); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
for my $key ( keys %underscores ) |
266
|
|
|
|
|
|
|
{ |
267
|
|
|
|
|
|
|
bless $underscores{$key}, 'Literal'; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
my %varmods = |
271
|
|
|
|
|
|
|
( |
272
|
|
|
|
|
|
|
'loco' => bless ({ perl => 'local', lex => 'OWNER_D' }, |
273
|
|
|
|
|
|
|
'ScalarMod'), |
274
|
|
|
|
|
|
|
'locis' => bless ({ perl => 'local', lex => 'OWNER_D' }, |
275
|
|
|
|
|
|
|
'ArrMod'), |
276
|
|
|
|
|
|
|
'meo' => bless ({ perl => 'my', lex => 'OWNER_D' }, |
277
|
|
|
|
|
|
|
'ScalarMod'), |
278
|
|
|
|
|
|
|
'meis' => bless ({ perl => 'my', lex => 'OWNER_D' }, |
279
|
|
|
|
|
|
|
'ArrMod'), |
280
|
|
|
|
|
|
|
'nostro' => bless ({ perl => 'our', lex => 'OWNER_D' }, |
281
|
|
|
|
|
|
|
'ScalarMod'), |
282
|
|
|
|
|
|
|
'nostris' => bless ({ perl => 'our', lex => 'OWNER_D' }, |
283
|
|
|
|
|
|
|
'ArrMod'), |
284
|
|
|
|
|
|
|
); |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
my %streams = |
287
|
|
|
|
|
|
|
( |
288
|
|
|
|
|
|
|
'vestibulo' => { perl => '*STDIN' }, |
289
|
|
|
|
|
|
|
'egresso' => { perl => 'STDOUT' }, |
290
|
|
|
|
|
|
|
'oraculo' => { perl => 'STDERR' }, |
291
|
|
|
|
|
|
|
'nuntio' => { perl => '*Lingua::Romana::Perligata::DATA' }, |
292
|
|
|
|
|
|
|
); |
293
|
|
|
|
|
|
|
multibless %streams, 'Literal', 'DATIVE'; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my %matchops = |
296
|
|
|
|
|
|
|
( |
297
|
|
|
|
|
|
|
'compara' => { perl => 'm' }, |
298
|
|
|
|
|
|
|
'substitue' => { perl => 's' }, |
299
|
|
|
|
|
|
|
'converte' => { perl => 'tr' }, |
300
|
|
|
|
|
|
|
); |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
multibless %matchops, 'MatchOperator', 'SUBNAME'; |
303
|
|
|
|
|
|
|
addres %matchops, 'MatchOperator', 'SUBNAME'; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
my %ops = |
306
|
|
|
|
|
|
|
( |
307
|
|
|
|
|
|
|
'adde' => { perl => '+' }, |
308
|
|
|
|
|
|
|
'deme' => { perl => '-' }, |
309
|
|
|
|
|
|
|
'multiplica' => { perl => '*' }, |
310
|
|
|
|
|
|
|
'itera' => { perl => 'x' }, |
311
|
|
|
|
|
|
|
'divide' => { perl => '/' }, |
312
|
|
|
|
|
|
|
'recide' => { perl => '%' }, |
313
|
|
|
|
|
|
|
'eleva' => { perl => '**' }, |
314
|
|
|
|
|
|
|
'consocia' => { perl => '&' }, |
315
|
|
|
|
|
|
|
'interseca' => { perl => '|' }, |
316
|
|
|
|
|
|
|
'discerne' => { perl => '^' }, |
317
|
|
|
|
|
|
|
'depone' => { perl => '' , prefix => 1 }, |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
$ops{$_}{operator} = 1 foreach keys %ops; |
321
|
|
|
|
|
|
|
multibless %ops, 'Operator', 'SUBNAME_A'; |
322
|
|
|
|
|
|
|
addres %ops, 'Operator', 'SUBNAME_A'; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
my %lops = |
325
|
|
|
|
|
|
|
( |
326
|
|
|
|
|
|
|
'da' => { perl => '=', operator => 1 }, |
327
|
|
|
|
|
|
|
); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
multibless %lops, 'Operator', 'SUBNAME_AD'; |
330
|
|
|
|
|
|
|
addres %lops, 'Operator', 'SUBNAME_AD'; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my %invarops = |
333
|
|
|
|
|
|
|
( |
334
|
|
|
|
|
|
|
'atque' => { perl => '&&' }, |
335
|
|
|
|
|
|
|
'vel' => { perl => '||' }, |
336
|
|
|
|
|
|
|
'praestantiam' => { perl => '<' }, |
337
|
|
|
|
|
|
|
'non praestantiam' => { perl => '>=' }, |
338
|
|
|
|
|
|
|
'praestantias' => { perl => 'lt' }, |
339
|
|
|
|
|
|
|
'non praestantias' => { perl => 'ge' }, |
340
|
|
|
|
|
|
|
'aequalitam' => { perl => '==' }, |
341
|
|
|
|
|
|
|
'non aequalitam' => { perl => '!=' }, |
342
|
|
|
|
|
|
|
'aequalitas' => { perl => 'eq' }, |
343
|
|
|
|
|
|
|
'non aequalitas' => { perl => 'ne' }, |
344
|
|
|
|
|
|
|
'comparitiam' => { perl => '<=>' }, |
345
|
|
|
|
|
|
|
'comparitias' => { perl => 'cmp' }, |
346
|
|
|
|
|
|
|
'non comparitiam' => { perl => '!<=>' }, |
347
|
|
|
|
|
|
|
'non comparitias' => { perl => '!cmp' }, |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
'non' => { perl => '!', prefix => 1 }, |
350
|
|
|
|
|
|
|
'nega' => { perl => '-', prefix => 1 }, |
351
|
|
|
|
|
|
|
); |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$invarops{$_}{operator} = 1 foreach keys %invarops; |
354
|
|
|
|
|
|
|
multibless %invarops, 'Operator', 'SUBNAME_A_ACCUSATIVE'; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
my %connectives = |
357
|
|
|
|
|
|
|
( |
358
|
|
|
|
|
|
|
'que' => { perl => 'and' }, |
359
|
|
|
|
|
|
|
've' => { perl => 'or' }, |
360
|
|
|
|
|
|
|
); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
@{$connectives{$_}}{'operator','raw'} = (1,-$_) foreach keys %connectives; |
363
|
|
|
|
|
|
|
multibless %connectives, 'Operator', 'CONNECTIVE'; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
my %funcs_td = |
366
|
|
|
|
|
|
|
( |
367
|
|
|
|
|
|
|
'excerpe' => { perl => 'substr' }, # SPECIAL: SEE BELOW |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
'cumula' => { perl => 'push' }, |
370
|
|
|
|
|
|
|
'capita' => { perl => 'unshift' }, |
371
|
|
|
|
|
|
|
'iunge' => { perl => 'splice' }, |
372
|
|
|
|
|
|
|
'digere' => { perl => 'sort' }, |
373
|
|
|
|
|
|
|
'retexe' => { perl => 'reverse' }, |
374
|
|
|
|
|
|
|
'evolute' => { perl => 'open' }, |
375
|
|
|
|
|
|
|
'lege' => { perl => 'read' }, |
376
|
|
|
|
|
|
|
'scribe' => { perl => 'print' }, |
377
|
|
|
|
|
|
|
'describe' => { perl => 'printf' }, |
378
|
|
|
|
|
|
|
'subscribe' => { perl => 'write' }, |
379
|
|
|
|
|
|
|
'conquire' => { perl => 'seek' }, |
380
|
|
|
|
|
|
|
'benedice' => { perl => 'bless' }, |
381
|
|
|
|
|
|
|
'liga' => { perl => 'tie' }, |
382
|
|
|
|
|
|
|
'modera' => { perl => 'fcntl' }, |
383
|
|
|
|
|
|
|
'conflue' => { perl => 'flock' }, |
384
|
|
|
|
|
|
|
'impera' => { perl => 'ioctl' }, |
385
|
|
|
|
|
|
|
'trunca' => { perl => 'truncate' }, |
386
|
|
|
|
|
|
|
); |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
multibless %funcs_td, 'Function', 'SUBNAME_AD'; |
389
|
|
|
|
|
|
|
addres %funcs_td, 'Function', 'SUBNAME_AD'; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# "bless" HAS A COMMON LATIN CONTRACTION... |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
$funcs_td{benedictum} = $funcs_td{benedicementum}; |
394
|
|
|
|
|
|
|
$funcs_td{benedicto} = $funcs_td{benedicemento}; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# THE FOLLOWING IS LVALUABLE, SO ARG MUST AGREE IN CASE WITH FUNCTION'S CASE... |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
for (qw( excerpe )) { |
399
|
|
|
|
|
|
|
$funcs_td{"${_}mentum"}{lex} = 'SUBNAME_A_ACCUSATIVE'; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
my %funcs_bd = |
404
|
|
|
|
|
|
|
( |
405
|
|
|
|
|
|
|
'vanne' => { perl => 'grep' }, |
406
|
|
|
|
|
|
|
'applica' => { perl => 'map' }, |
407
|
|
|
|
|
|
|
'digere' => { perl => 'sort' }, |
408
|
|
|
|
|
|
|
); |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
multibless %funcs_bd, 'Function', 'SUBNAME_AB'; |
411
|
|
|
|
|
|
|
addres %funcs_bd, 'Function', 'SUBNAME_AB'; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my %funcs_b = |
414
|
|
|
|
|
|
|
( |
415
|
|
|
|
|
|
|
'factorem' => { perl => 'sub' }, |
416
|
|
|
|
|
|
|
'factori' => { perl => 'sub' }, |
417
|
|
|
|
|
|
|
); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
multibless %funcs_b, 'Function', 'SUBNAME_B_ACCUSATIVE'; |
420
|
|
|
|
|
|
|
$funcs_b{'factori'}{lex} = 'SUBNAME_B_DATIVE'; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
my %funcs_t = |
424
|
|
|
|
|
|
|
( |
425
|
|
|
|
|
|
|
'morde' => { perl => 'chomp' }, |
426
|
|
|
|
|
|
|
'praecide' => { perl => 'chop' }, |
427
|
|
|
|
|
|
|
'stude' => { perl => 'study' }, |
428
|
|
|
|
|
|
|
'iani' => { perl => 'undef' }, |
429
|
|
|
|
|
|
|
'lusta' => { perl => 'reset' }, |
430
|
|
|
|
|
|
|
'decumula' => { perl => 'pop' }, |
431
|
|
|
|
|
|
|
'decapita' => { perl => 'shift' }, |
432
|
|
|
|
|
|
|
'claude' => { perl => 'close' }, |
433
|
|
|
|
|
|
|
'perlege' => { perl => 'Lingua::Romana::Perligata::getline' }, |
434
|
|
|
|
|
|
|
'sublege' => { perl => 'getc' }, |
435
|
|
|
|
|
|
|
'enunta' => { perl => 'tell' }, |
436
|
|
|
|
|
|
|
'dele' => { perl => 'delete' }, |
437
|
|
|
|
|
|
|
'quisque' => { perl => 'each' }, |
438
|
|
|
|
|
|
|
'adfirma' => { perl => 'exists' }, |
439
|
|
|
|
|
|
|
'solvere' => { perl => 'untie' }, |
440
|
|
|
|
|
|
|
'preincresce' => { perl => '++', prefix => 1, operator => 1 }, |
441
|
|
|
|
|
|
|
'postincresce' => { perl => '++', prefix => 0, operator => 1 }, |
442
|
|
|
|
|
|
|
'predecresce' => { perl => '--', prefix => 1, operator => 1 }, |
443
|
|
|
|
|
|
|
'postdecresce' => { perl => '--', prefix => 0, operator => 1 }, |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
'reperi' => { perl => 'pos' }, # SPECIAL: SEE BELOW |
446
|
|
|
|
|
|
|
'nomina' => { perl => 'keys' }, # SPECIAL: SEE BELOW |
447
|
|
|
|
|
|
|
); |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
multibless %funcs_t, 'Function', 'SUBNAME_D'; |
450
|
|
|
|
|
|
|
addres %funcs_t, 'Function', 'SUBNAME_D'; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# THE FOLLOWING ARE LVALUABLE, SO ARG MUST AGREE IN CASE WITH FUNCTION'S CASE... |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
for (qw( reperi nomina )) { |
456
|
|
|
|
|
|
|
$funcs_t{"${_}mentum"}{lex} = 'SUBNAME_A_ACCUSATIVE'; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
my %funcs_d = |
460
|
|
|
|
|
|
|
( |
461
|
|
|
|
|
|
|
'admeta' => { perl => 'Lingua::Romana::Perligata::__lastelem__' }, |
462
|
|
|
|
|
|
|
'inque' => { perl => 'Lingua::Romana::Perligata::__enquote__' }, |
463
|
|
|
|
|
|
|
'conscribe' => { perl => 'Lingua::Romana::Perligata::__enlist__' }, |
464
|
|
|
|
|
|
|
'come' => { perl => 'Lingua::Romana::Perligata::__beautify__' }, |
465
|
|
|
|
|
|
|
'priva' => { perl => 'abs' }, |
466
|
|
|
|
|
|
|
'angula' => { perl => 'atan2' }, |
467
|
|
|
|
|
|
|
'oppone' => { perl => 'sin' }, |
468
|
|
|
|
|
|
|
'accuba' => { perl => 'cos' }, |
469
|
|
|
|
|
|
|
'decolla' => { perl => 'int' }, |
470
|
|
|
|
|
|
|
'succide' => { perl => 'log' }, |
471
|
|
|
|
|
|
|
'fode' => { perl => 'sqrt' }, |
472
|
|
|
|
|
|
|
'conice' => { perl => 'rand' }, |
473
|
|
|
|
|
|
|
'prosemina' => { perl => 'srand' }, |
474
|
|
|
|
|
|
|
'inde' => { perl => 'chr' }, |
475
|
|
|
|
|
|
|
'senidemi' => { perl => 'hex' }, |
476
|
|
|
|
|
|
|
'octoni' => { perl => 'oct' }, |
477
|
|
|
|
|
|
|
'numera' => { perl => 'ord' }, |
478
|
|
|
|
|
|
|
'deminue' => { perl => 'lc' }, |
479
|
|
|
|
|
|
|
'minue' => { perl => 'lcfirst' }, |
480
|
|
|
|
|
|
|
'amplifica' => { perl => 'uc' }, |
481
|
|
|
|
|
|
|
'amplia' => { perl => 'ucfirst' }, |
482
|
|
|
|
|
|
|
'excipe' => { perl => 'quotemeta' }, |
483
|
|
|
|
|
|
|
'huma' => { perl => 'crypt' }, |
484
|
|
|
|
|
|
|
'meta' => { perl => 'length' }, |
485
|
|
|
|
|
|
|
'convasa' => { perl => 'pack' }, |
486
|
|
|
|
|
|
|
'deconvasa' => { perl => 'unpack' }, |
487
|
|
|
|
|
|
|
'scinde' => { perl => 'split' }, |
488
|
|
|
|
|
|
|
'scruta' => { perl => 'index' }, |
489
|
|
|
|
|
|
|
'coniunge' => { perl => 'join' }, |
490
|
|
|
|
|
|
|
'confirma' => { perl => 'defined' }, |
491
|
|
|
|
|
|
|
'secerna' => { perl => 'scalar' }, |
492
|
|
|
|
|
|
|
'argue' => { perl => 'values' }, |
493
|
|
|
|
|
|
|
'extremus' => { perl => 'eof' }, |
494
|
|
|
|
|
|
|
'deside' => { perl => 'wantarray' }, |
495
|
|
|
|
|
|
|
'aestima' => { perl => 'eval' }, |
496
|
|
|
|
|
|
|
'exi' => { perl => 'exit' }, |
497
|
|
|
|
|
|
|
'redde' => { perl => 'return' }, |
498
|
|
|
|
|
|
|
'mori' => { perl => 'die' }, |
499
|
|
|
|
|
|
|
'mone' => { perl => 'warn' }, |
500
|
|
|
|
|
|
|
'coaxa' => { perl => 'Carp::croak' }, |
501
|
|
|
|
|
|
|
'carpe' => { perl => 'Carp::carp' }, |
502
|
|
|
|
|
|
|
'memora' => { perl => 'caller' }, |
503
|
|
|
|
|
|
|
'agnosce' => { perl => 'ref' }, |
504
|
|
|
|
|
|
|
'exhibere' => { perl => 'tied' }, |
505
|
|
|
|
|
|
|
'require' => { perl => 'require' }, |
506
|
|
|
|
|
|
|
'demigrare' => { perl => 'chdir' }, |
507
|
|
|
|
|
|
|
'permitte' => { perl => 'chmod' }, |
508
|
|
|
|
|
|
|
'vende' => { perl => 'chown' }, |
509
|
|
|
|
|
|
|
'inveni' => { perl => 'glob' }, |
510
|
|
|
|
|
|
|
'copula' => { perl => 'link' }, |
511
|
|
|
|
|
|
|
'decopula' => { perl => 'unlink' }, |
512
|
|
|
|
|
|
|
'aedifica' => { perl => 'mkdir' }, |
513
|
|
|
|
|
|
|
'renomina' => { perl => 'rename' }, |
514
|
|
|
|
|
|
|
'excide' => { perl => 'rmdir' }, |
515
|
|
|
|
|
|
|
'exprime' => { perl => 'stat' }, |
516
|
|
|
|
|
|
|
'terre' => { perl => 'alarm' }, |
517
|
|
|
|
|
|
|
'mitte' => { perl => 'dump' }, |
518
|
|
|
|
|
|
|
'commuta' => { perl => 'exec' }, |
519
|
|
|
|
|
|
|
'furca' => { perl => 'fork' }, |
520
|
|
|
|
|
|
|
'interfice' => { perl => 'kill' }, |
521
|
|
|
|
|
|
|
'dormi' => { perl => 'sleep' }, |
522
|
|
|
|
|
|
|
'obsecra' => { perl => 'system' }, |
523
|
|
|
|
|
|
|
'dissimula' => { perl => 'umask' }, |
524
|
|
|
|
|
|
|
'manta' => { perl => 'wait' }, |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
'inscribe' => { perl => ':' }, # SPECIAL: SEE BELOW |
527
|
|
|
|
|
|
|
'arcesse' => { perl => '${' }, # SPECIAL: SEE BELOW |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
'sere' => { perl => 'Lingua::Romana::Perligata::__encatenate__' }, |
530
|
|
|
|
|
|
|
); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
multibless %funcs_d, 'Function', 'SUBNAME_A'; |
533
|
|
|
|
|
|
|
addres %funcs_d, 'Function', 'SUBNAME_A'; |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
# 'inscribe' IS SPECIAL: ONLY IMPERATIVE |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
delete @funcs_d{grep /^inscribement/, keys %funcs_d}; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# 'arcesse' IS SPECIAL: NO IMPERATIVE AND EXTRA (PSEUDO-)RESULTATIVES |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
delete $funcs_d{'arcesse'}; |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
# SCALAR AS NON-TERMINAL INDEX |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
$funcs_d{'arcessementi'} = { %{$funcs_d{'arcessementum'}}, |
546
|
|
|
|
|
|
|
lex => 'SUBNAME_A_GENITIVE' }; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# ARRAY DEREFERENCE |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
$funcs_d{'arcessementa'}{perl} = '@{'; |
551
|
|
|
|
|
|
|
$funcs_d{'arcessementis'}{perl} = '@{'; |
552
|
|
|
|
|
|
|
$funcs_d{'arcessementorum'} = { %{$funcs_d{'arcessementa'}}, |
553
|
|
|
|
|
|
|
lex => 'SUBNAME_A_GENITIVE' }; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
$funcs_d{'arcessementus'} = { %{$funcs_d{'arcessementa'}}, perl => '%{' }; |
556
|
|
|
|
|
|
|
$funcs_d{'arcessementibus'} = { %{$funcs_d{'arcessementis'}}, perl => '%{' }; |
557
|
|
|
|
|
|
|
$funcs_d{'arcessementuum'} = { %{$funcs_d{'arcessementus'}}, |
558
|
|
|
|
|
|
|
lex => 'SUBNAME_A_GENITIVE'}; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
my %funcs_dl = |
562
|
|
|
|
|
|
|
( |
563
|
|
|
|
|
|
|
'adi' => { perl => 'goto' }, |
564
|
|
|
|
|
|
|
'confectus' => { perl => 'continue' }, |
565
|
|
|
|
|
|
|
'domus' => { perl => 'package' }, |
566
|
|
|
|
|
|
|
'ute' => { perl => 'use' }, |
567
|
|
|
|
|
|
|
); |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
multibless %funcs_dl, 'Function_Lit', 'SUBNAME_A'; |
570
|
|
|
|
|
|
|
addres %funcs_dl, 'Function_Lit', 'SUBNAME_A'; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
my %funcs_dlo = |
573
|
|
|
|
|
|
|
( |
574
|
|
|
|
|
|
|
'ultimus' => { perl => 'last' }, |
575
|
|
|
|
|
|
|
'posterus' => { perl => 'next' }, |
576
|
|
|
|
|
|
|
'reconnatus' => { perl => 'redo' }, |
577
|
|
|
|
|
|
|
); |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
multibless %funcs_dlo, 'Function_Lit', 'SUBNAME_OA'; |
580
|
|
|
|
|
|
|
# addres %funcs_dl, 'Function_Lit', 'SUBNAME_OA'; |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my %misc = |
583
|
|
|
|
|
|
|
( |
584
|
|
|
|
|
|
|
'fac' => { lex => 'DO', perl => 'do' }, |
585
|
|
|
|
|
|
|
'per' => { lex => 'FOR', perl => 'for' }, |
586
|
|
|
|
|
|
|
'per quisque' => { lex => 'FOR', perl => 'foreach' }, |
587
|
|
|
|
|
|
|
'si' => { lex => 'CONTROL', perl => 'if' }, |
588
|
|
|
|
|
|
|
'nisi' => { lex => 'CONTROL', perl => 'unless' }, |
589
|
|
|
|
|
|
|
'donec' => { lex => 'CONTROL', perl => 'until' }, |
590
|
|
|
|
|
|
|
'dum' => { lex => 'CONTROL', perl => 'while' }, |
591
|
|
|
|
|
|
|
'cum' => { lex => 'WITH', perl => '' }, |
592
|
|
|
|
|
|
|
'intra' => { lex => 'WITHIN', perl => '::' }, |
593
|
|
|
|
|
|
|
'apud' => { lex => 'ARROW', perl => '->' }, |
594
|
|
|
|
|
|
|
'tum' => { lex => 'COMMA', perl => ',' }, |
595
|
|
|
|
|
|
|
'in' => { lex => 'IN', perl => '' }, |
596
|
|
|
|
|
|
|
'sic' => { lex => 'BEGIN', perl => '{' }, |
597
|
|
|
|
|
|
|
'cis' => { lex => 'END', perl => '}' }, |
598
|
|
|
|
|
|
|
'princeps' => { lex => 'NAME', raw=>'main',perl => 'main' }, |
599
|
|
|
|
|
|
|
'ad' => { lex => 'ADDRESS', perl => '\\' }, |
600
|
|
|
|
|
|
|
); |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my %tokens = |
603
|
|
|
|
|
|
|
( |
604
|
|
|
|
|
|
|
%literals, %numerals, %underscores, |
605
|
|
|
|
|
|
|
%numerals, %ordinals_a, %ordinals_d, |
606
|
|
|
|
|
|
|
%varmods, %matchops, %ops, %lops, %invarops, |
607
|
|
|
|
|
|
|
%funcs_td, %funcs_bd, %funcs_b, %funcs_t, |
608
|
|
|
|
|
|
|
%funcs_d, %funcs_dl, %funcs_dlo, |
609
|
|
|
|
|
|
|
%misc, %streams, |
610
|
|
|
|
|
|
|
); |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
# Handle likely captialization variations... |
613
|
|
|
|
|
|
|
@tokens{map {ucfirst} keys %tokens} = values %tokens; |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
foreach my $key ( keys %tokens ) |
616
|
|
|
|
|
|
|
{ |
617
|
|
|
|
|
|
|
$tokens{$key}{raw} = $key |
618
|
|
|
|
|
|
|
unless $tokens{$key}{raw}; |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
my $distokens = join '|', reverse sort keys %tokens; |
622
|
|
|
|
|
|
|
my $tokens = "\\A\\s*($distokens)\\b"; |
623
|
|
|
|
|
|
|
my $tokensque = "\\A\\s*($distokens)que\\b"; |
624
|
|
|
|
|
|
|
my $tokensve = "\\A\\s*($distokens)ve\\b"; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
sub token($$$$) |
627
|
|
|
|
|
|
|
{ |
628
|
16
|
|
|
16
|
0
|
37
|
my ($raw, $lex, $perl, $blesstype) = @_; |
629
|
16
|
|
|
|
|
87
|
return bless { raw => $raw, lex => $lex, perl => $perl }, $blesstype; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub tokdup |
633
|
|
|
|
|
|
|
{ |
634
|
38
|
|
|
38
|
0
|
45
|
my ($archetype) = @_; |
635
|
38
|
|
|
|
|
311
|
bless { %$archetype }, $archetype->{lex}; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub tokenize |
639
|
|
|
|
|
|
|
{ |
640
|
4
|
|
|
4
|
0
|
6
|
my ($text) = @_; |
641
|
4
|
|
|
|
|
7
|
my @tokens; |
642
|
4
|
|
|
|
|
5
|
my $bad = ""; |
643
|
4
|
|
|
|
|
10
|
my $lines = $text =~ tr/\n/\n/; |
644
|
|
|
|
|
|
|
|
645
|
4
|
|
|
|
|
13
|
while (length $text) |
646
|
|
|
|
|
|
|
{ |
647
|
56
|
|
|
|
|
160
|
$text =~ s/\A\s+//; |
648
|
56
|
|
|
|
|
102
|
my $line = $lines - ($text =~ tr/\n/\n/) + $offset; |
649
|
56
|
50
|
33
|
|
|
30002
|
if ($text =~ s/\A(adnota.*)//i) |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
650
|
|
|
|
|
|
|
{ |
651
|
|
|
|
|
|
|
# ignore comments |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
elsif ($text =~ s/\A(nuntius|finis)[ \t]*[.]?[ \t]*\n(.*)//smi) |
654
|
|
|
|
|
|
|
{ |
655
|
|
|
|
|
|
|
# set up DATA stream |
656
|
2
|
|
|
2
|
|
16
|
use vars '*DATA'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
5543
|
|
657
|
0
|
|
|
|
|
0
|
local *Lingua::Romana::Perlidata::DATASRC; |
658
|
0
|
|
|
|
|
0
|
my $pipe = pipe \*Lingua::Romana::Perligata::DATA, |
659
|
|
|
|
|
|
|
\*Lingua::Romana::Perlidata::DATASRC; |
660
|
|
|
|
|
|
|
|
661
|
0
|
|
|
|
|
0
|
print Lingua::Romana::Perlidata::DATASRC $2; |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
elsif ($text =~ s/\Adic(?:emen)?tum(que|ve|)\s+sic\s+\b(.*?)\s+cis\b//si) |
664
|
|
|
|
|
|
|
{ |
665
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $1} if $1; |
666
|
0
|
|
|
|
|
0
|
push @tokens, token($2,'NAME',"$2",'Name'); |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
elsif ($text =~ s/\Asic(que|ve|)\s+(.*?)\s+cis\s+dic(?:emen)?tum\b//si) |
669
|
|
|
|
|
|
|
{ |
670
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $1} if $1; |
671
|
0
|
|
|
|
|
0
|
push @tokens, token($2,'NAME',"$2",'Name'); |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
elsif ($text =~ s/\A(atque|vel)\b//i) |
674
|
|
|
|
|
|
|
{ |
675
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $misc{'tum'}; |
676
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $invarops{lc $1}; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
elsif ($text =~ s/\A(($roman)im(?:o|ae)(que|ve|))\b//ix && length $2) |
679
|
|
|
|
|
|
|
{ |
680
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $+} if $+; |
681
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'ORDINAL_DATIVE',from_rn($2),'ORDINAL_DATIVE'); |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
elsif ($text =~ s/\A(($roman)im(?:um|os|am|as)(que|ve|))\b//ix && length $2) |
684
|
|
|
|
|
|
|
{ |
685
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $+} if $+; |
686
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'ORDINAL',from_rn($2),'ORDINAL'); |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
elsif ($text =~ s/\A(($roman)(que|ve|))\b//ix && length $2) |
689
|
|
|
|
|
|
|
{ |
690
|
2
|
50
|
|
|
|
11
|
push @tokens, tokdup $connectives{lc $+} if $+; |
691
|
2
|
|
|
|
|
9
|
push @tokens, token($1,'NUMERAL',from_rn($2),'NUMERAL');; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
elsif ($text =~ s/$tokensque//i) |
694
|
|
|
|
|
|
|
{ |
695
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $connectives{'que'}; |
696
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $tokens{lc $1}; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
elsif ($text =~ s/$tokensve//i) |
699
|
|
|
|
|
|
|
{ |
700
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $connectives{'ve'}; |
701
|
0
|
|
|
|
|
0
|
push @tokens, tokdup $tokens{lc $1}; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
elsif ($text =~ s/$tokens//i) |
704
|
|
|
|
|
|
|
{ |
705
|
38
|
|
|
|
|
145
|
push @tokens, tokdup $tokens{lc $1}; |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+?)(um|)ementum)(que|ve|)\b//i) |
708
|
|
|
|
|
|
|
{ |
709
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $4} if $4; |
710
|
0
|
0
|
|
|
|
0
|
my $perl = $3 ? "\$$2->" : $2; |
711
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'SUBNAME_OA_ACCUSATIVE',$perl,'Literal'); |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+?)(um|)ementa)(que|ve|)\b//i) |
714
|
|
|
|
|
|
|
{ |
715
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $4} if $4; |
716
|
0
|
0
|
|
|
|
0
|
my $perl = $3 ? "\$$2->" : $2; |
717
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'SUBNAME_OA_ACCUSATIVE',$perl,'Literal'); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+?)(um|)emento)(que|ve|)\b//i) |
720
|
|
|
|
|
|
|
{ |
721
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $4} if $4; |
722
|
0
|
0
|
|
|
|
0
|
my $perl = $3 ? "\$$2->" : $2; |
723
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'SUBNAME_OA_DATIVE',$perl,'Literal'); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+?)(um|)ementis)(que|ve|)\b//i) |
726
|
|
|
|
|
|
|
{ |
727
|
0
|
|
|
|
|
0
|
$bad .= "'-mentis' illicitum: '$1'" |
728
|
|
|
|
|
|
|
. adversum({line=>$line}); |
729
|
|
|
|
|
|
|
# One day this may be: |
730
|
|
|
|
|
|
|
# |
731
|
|
|
|
|
|
|
# push @tokens, tokdup $connectives{lc $4} if $4; |
732
|
|
|
|
|
|
|
# my $perl = $3 ? "\$$2->" : $2; |
733
|
|
|
|
|
|
|
# push @tokens, token($1,'SUBNAME_OA_DATIVE',$perl,'Literal'); |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)orum)(que|ve|)\b//i) |
736
|
|
|
|
|
|
|
{ |
737
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
738
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'GENITIVE',"\@$2",'Literal'); |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)uum)(que|ve|)\b//i) |
741
|
|
|
|
|
|
|
{ |
742
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
743
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'GENITIVE',"\%$2",'Literal'); |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)um)(que|ve|)\b//i) |
746
|
|
|
|
|
|
|
{ |
747
|
4
|
50
|
|
|
|
17
|
push @tokens, tokdup $connectives{lc $3} if $3; |
748
|
4
|
|
|
|
|
19
|
push @tokens, token($1,'ACCUSATIVE',"\$$2",'Literal'); |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)a)(que|ve|)\b//i) |
751
|
|
|
|
|
|
|
{ |
752
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
753
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'ACCUSATIVE',"\@$2",'Literal'); |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)ibus)(que|ve|)\b//i) |
756
|
|
|
|
|
|
|
{ |
757
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
758
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'DATIVE',"\%$2",'Literal'); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)us)(que|ve|)\b//i) |
761
|
|
|
|
|
|
|
{ |
762
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
763
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'ACCUSATIVE',"\%$2",'Literal'); |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)o)(que|ve|)\b//i) |
766
|
|
|
|
|
|
|
{ |
767
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
768
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'DATIVE',"\$$2",'Literal'); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)is)(que|ve|)\b//i) |
771
|
|
|
|
|
|
|
{ |
772
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
773
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'DATIVE',"\@$2",'Literal'); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)tori)(que|ve|)\b//i) |
776
|
|
|
|
|
|
|
{ |
777
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
778
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'DATIVE',"\\&$2",'Literal'); |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)i)(que|ve|)\b//i) |
781
|
|
|
|
|
|
|
{ |
782
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
783
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'GENITIVE',"\$$2",'Literal'); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)ere)(que|ve|)\b//i) |
786
|
|
|
|
|
|
|
{ |
787
|
2
|
50
|
|
|
|
10
|
push @tokens, tokdup $connectives{lc $3} if $3; |
788
|
2
|
|
|
|
|
9
|
push @tokens, token($1,'INFINITIVE',"$2",'Literal'); |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+?)(um|)e)(que|ve|)\b//i) |
791
|
|
|
|
|
|
|
{ |
792
|
2
|
50
|
|
|
|
10
|
push @tokens, tokdup $connectives{lc $4} if $4; |
793
|
2
|
50
|
|
|
|
7
|
my $perl = $3 ? "\$$2->" : $2; |
794
|
2
|
|
|
|
|
9
|
push @tokens, token($1,'SUBNAME',$perl,'Literal'); |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
elsif ($text =~ s/\A(([a-z]+)torem)(que|ve|)\b//i) |
797
|
|
|
|
|
|
|
{ |
798
|
0
|
0
|
|
|
|
0
|
push @tokens, tokdup $connectives{lc $3} if $3; |
799
|
0
|
|
|
|
|
0
|
push @tokens, token($1,'ACCUSATIVE',"\\&$2",'Literal'); |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
elsif ($text =~ s/\A([.])//) |
802
|
|
|
|
|
|
|
{ |
803
|
4
|
|
|
|
|
12
|
push @tokens, token($1,'PERIOD',";",'Separator'); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
elsif ($text =~ s/\A(\S+)(que|ve|)\b//) |
806
|
|
|
|
|
|
|
{ |
807
|
2
|
50
|
|
|
|
10
|
push @tokens, tokdup $connectives{lc $2} if $2; |
808
|
2
|
50
|
|
|
|
24
|
push @tokens, token($1,'NAME',"$1",'Name') if $1; |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
else |
811
|
|
|
|
|
|
|
{ |
812
|
2
|
50
|
|
|
|
18
|
$text =~ s/\A(\S+)// or next; |
813
|
0
|
|
|
|
|
0
|
my $error = $1; |
814
|
0
|
|
|
|
|
0
|
$bad .= "Aliquod barbarum inveni: '$error'" |
815
|
|
|
|
|
|
|
. adversum({line=>$line}); |
816
|
|
|
|
|
|
|
} |
817
|
54
|
50
|
|
|
|
2159
|
$tokens[-1]->{line} = $line if @tokens; |
818
|
|
|
|
|
|
|
} |
819
|
4
|
50
|
33
|
|
|
30
|
if (($lex ||$debug) && @tokens) { |
|
|
|
33
|
|
|
|
|
820
|
0
|
|
|
|
|
0
|
my $format = "%-20s %-10s %-20s\n"; |
821
|
0
|
|
|
|
|
0
|
printf $format, qw(Word Role Meaning); |
822
|
0
|
|
|
|
|
0
|
printf $format, qw(==== ==== =======); |
823
|
0
|
|
|
|
|
0
|
foreach ( @tokens ) { |
824
|
0
|
|
|
|
|
0
|
printf $format, @{$_}{qw(raw lex perl)}; |
|
0
|
|
|
|
|
0
|
|
825
|
|
|
|
|
|
|
} |
826
|
0
|
|
|
|
|
0
|
print "\n", "="x72, "\n\n"; |
827
|
0
|
0
|
|
|
|
0
|
die "\n" if $lex; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
4
|
50
|
|
|
|
10
|
die $bad if $bad; |
831
|
4
|
|
|
|
|
19
|
return [@tokens]; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
2
|
|
|
2
|
|
16
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
12008
|
|
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub conn_command { |
837
|
10
|
|
|
10
|
0
|
16
|
my ($toks, $eatend, $noeatend) = @_; |
838
|
10
|
|
|
|
|
34
|
my $command = &command; |
839
|
10
|
|
66
|
|
|
45
|
while (@$toks && $toks->[0]{lex} eq 'CONNECTIVE') { |
840
|
0
|
|
|
|
|
0
|
local $Lingua::Romana::Perligata::connective = shift @$toks; |
841
|
0
|
|
|
|
|
0
|
$connective->{L} = $command; |
842
|
0
|
|
|
|
|
0
|
$connective->{R} = &command; |
843
|
0
|
|
|
|
|
0
|
$command = $connective; |
844
|
|
|
|
|
|
|
} |
845
|
10
|
|
|
|
|
24
|
return $command; |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
sub command { |
850
|
10
|
|
|
10
|
0
|
11
|
my ($toks, $eatend, $noeatend) = @_; |
851
|
10
|
|
|
|
|
27
|
my @Astack = { data => [], complete => 1 }; #SENTINEL ACCUSATIVE FRAME |
852
|
10
|
|
|
|
|
12
|
my (@Bstack, @Dstack, @Vstack, $Vdone); |
853
|
10
|
|
|
|
|
9
|
my $Dindir = 0; |
854
|
10
|
|
|
|
|
11
|
my @lastsubstantive; |
855
|
10
|
|
|
|
|
8
|
my $empty = 1; |
856
|
|
|
|
|
|
|
|
857
|
10
|
|
|
|
|
7
|
my $reduce; |
858
|
|
|
|
|
|
|
my $Astack_push = sub { |
859
|
14
|
100
|
|
14
|
|
51
|
if ($Astack[-1]{complete}) { |
860
|
6
|
50
|
|
|
|
16
|
$reduce->($_[0]) if @Astack > 1; |
861
|
6
|
|
|
|
|
14
|
push @Astack, { data => [ $_[0] ] }; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
else { |
864
|
8
|
|
|
|
|
9
|
push @{$Astack[-1]{data}}, $_[0]; |
|
8
|
|
|
|
|
16
|
|
865
|
|
|
|
|
|
|
} |
866
|
14
|
|
|
|
|
17
|
$Astack[-1]{complete} = 1; |
867
|
10
|
|
|
|
|
45
|
}; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
$reduce = sub { |
870
|
24
|
|
|
24
|
|
27
|
my ($lookahead) = @_; |
871
|
24
|
100
|
|
|
|
45
|
if (! @Vstack) { |
872
|
12
|
50
|
50
|
|
|
42
|
if (@Dstack && ($Dstack[-1]{V}{lex}||"") eq 'OWNER_D') { |
|
|
|
66
|
|
|
|
|
873
|
0
|
|
|
|
|
0
|
$Vdone = pop @Dstack; |
874
|
0
|
|
|
|
|
0
|
return 1 |
875
|
|
|
|
|
|
|
} |
876
|
12
|
|
|
|
|
19
|
return 0; |
877
|
|
|
|
|
|
|
} |
878
|
12
|
100
|
100
|
|
|
109
|
return 0 if $Vstack[-1]{lex} =~ /^SUBNAME_?A?D?$/ && $lookahead->{lex} !~ /PERIOD|DO|END|CONNECTIVE/ |
|
|
|
66
|
|
|
|
|
879
|
|
|
|
|
|
|
|| ref $Vstack[-1] eq "STATEMENT"; |
880
|
6
|
|
|
|
|
8
|
my $verb = $Vstack[-1]; |
881
|
6
|
|
|
|
|
22
|
my ($needA, $needD) = $verb->{lex} =~ /_(O?A?)([BD])?/; |
882
|
6
|
50
|
66
|
|
|
24
|
$needA ||= $verb->{lex} eq 'SUBNAME' ? "OA" : ""; |
883
|
6
|
|
100
|
|
|
18
|
$needD ||= ""; |
884
|
|
|
|
|
|
|
return 0 if $needA && $needA ne "OA" && (@Astack<=1 || !$Astack[-1]{complete}) |
885
|
6
|
50
|
66
|
|
|
80
|
|| $needD eq 'D' && !@Dstack |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
886
|
|
|
|
|
|
|
|| $needD eq 'B' && !@Bstack; |
887
|
6
|
50
|
|
|
|
15
|
my $dat = $needD eq 'D' ? pop(@Dstack) |
|
|
100
|
|
|
|
|
|
888
|
|
|
|
|
|
|
: $needD eq 'B' ? pop(@Bstack) |
889
|
|
|
|
|
|
|
: undef; |
890
|
6
|
50
|
33
|
|
|
34
|
my $acc = $needA && @Astack>1 ? pop(@Astack)->{data} : undef; |
891
|
6
|
|
|
|
|
28
|
my $statement = bless { V=>pop(@Vstack), A=>$acc, D=>$dat }, "STATEMENT"; |
892
|
6
|
50
|
33
|
|
|
66
|
if ($verb->{lex} =~ /SUBNAME_.*_ACCUSATIVE/ |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
893
|
|
|
|
|
|
|
|| $Dindir && $verb->{lex} =~ /SUBNAME_.*_DATIVE|OWNER_D/ ) |
894
|
|
|
|
|
|
|
{ |
895
|
0
|
0
|
|
|
|
0
|
if ($verb->{lex} =~ /SUBNAME_.*_DATIVE|OWNER_D/) { |
896
|
0
|
|
|
|
|
0
|
$statement->{R} = $Dindir; |
897
|
0
|
|
|
|
|
0
|
$Dindir = 0; |
898
|
|
|
|
|
|
|
} |
899
|
0
|
|
|
|
|
0
|
$Astack_push->($statement); |
900
|
0
|
|
|
|
|
0
|
push @lastsubstantive, $Astack[-1]{data}; |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
elsif ($verb->{lex} =~ /SUBNAME_.*_DATIVE|OWNER_D/ ) { |
903
|
2
|
|
|
|
|
4
|
push @Dstack, $statement; |
904
|
2
|
|
|
|
|
4
|
push @lastsubstantive, \@Dstack; |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
elsif ($verb->{lex} =~ /SUBNAME_.*_GENITIVE/ ) { |
907
|
0
|
|
|
|
|
0
|
my $lastsubstantive = pop @lastsubstantive; |
908
|
0
|
0
|
|
|
|
0
|
die "Genitivum non junctum: '$ord->{raw}'" |
909
|
|
|
|
|
|
|
. adversum($verb) |
910
|
|
|
|
|
|
|
unless $lastsubstantive; |
911
|
0
|
|
|
|
|
0
|
$ord = $lastsubstantive[-1][-1]; |
912
|
|
|
|
|
|
|
die "Index '$ord->{raw}' ordinalis non est" |
913
|
|
|
|
|
|
|
. adversum($ord) |
914
|
0
|
0
|
0
|
|
|
0
|
if $ord->{lex} && $ord->{lex} eq 'NUMERAL'; |
915
|
0
|
|
|
|
|
0
|
push @{$ord->{G}}, $statement; |
|
0
|
|
|
|
|
0
|
|
916
|
0
|
|
|
|
|
0
|
push @lastsubstantive, $Astack[-1]{data}; |
917
|
|
|
|
|
|
|
} |
918
|
4
|
|
|
|
|
6
|
else { $Vdone = $statement } |
919
|
6
|
50
|
|
|
|
17
|
if ($debug) { |
920
|
0
|
|
|
|
|
0
|
print "reduced: ", Data::Dumper->Dump([$statement]); |
921
|
|
|
|
|
|
|
} |
922
|
6
|
|
|
|
|
41
|
return 1; |
923
|
10
|
|
|
|
|
44
|
}; |
924
|
|
|
|
|
|
|
|
925
|
10
|
|
|
|
|
10
|
my $tok; |
926
|
10
|
|
|
|
|
26
|
while ( $tok = $toks->[0] ) { |
927
|
42
|
50
|
|
|
|
54
|
if ($debug) { |
928
|
0
|
|
|
|
|
0
|
print "Next: '$toks->[0]{raw}' ($toks->[0]{lex}):\n"; |
929
|
|
|
|
|
|
|
} |
930
|
42
|
100
|
33
|
|
|
566
|
if ($tok->{lex} =~ /^(NUMERAL|ORDINAL)$/ |
|
|
50
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
931
|
|
|
|
|
|
|
|| $Dindir && $tok->{lex} eq 'ORDINAL_DATIVE') |
932
|
6
|
|
|
|
|
7
|
{ shift @$toks; |
933
|
6
|
50
|
66
|
|
|
33
|
if ($1 eq 'NUMERAL' && $toks->[0]{lex} eq 'ORDINAL') { |
934
|
0
|
|
|
|
|
0
|
$tok->{raw} .= " " . $toks->[0]{raw}; |
935
|
0
|
|
|
|
|
0
|
$tok->{perl} /= $toks->[0]{perl}; |
936
|
0
|
|
|
|
|
0
|
shift @$toks; |
937
|
|
|
|
|
|
|
} |
938
|
6
|
50
|
|
|
|
14
|
if ($tok->{lex} eq 'ORDINAL_DATIVE') { |
939
|
0
|
|
|
|
|
0
|
$tok->{R} = $Dindir; |
940
|
0
|
|
|
|
|
0
|
$Dindir = 0; |
941
|
|
|
|
|
|
|
} |
942
|
6
|
|
|
|
|
13
|
$Astack_push->($tok); |
943
|
6
|
|
|
|
|
7
|
$lastownable = $Astack[-1]{data}; |
944
|
6
|
|
|
|
|
10
|
push @lastsubstantive, $lastownable; |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
elsif ($tok->{lex} eq 'ORDINAL_DATIVE') |
947
|
0
|
|
|
|
|
0
|
{ shift @$toks; |
948
|
0
|
|
|
|
|
0
|
$reduce->($tok); |
949
|
0
|
|
|
|
|
0
|
push @Dstack, $tok; |
950
|
0
|
|
|
|
|
0
|
$lastownable = \@Dstack; |
951
|
0
|
|
|
|
|
0
|
push @lastsubstantive, $lastownable; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
elsif ($tok->{lex} eq 'WITH') { |
954
|
0
|
|
|
|
|
0
|
push @Astack, { data=>[], complete=>0 }; |
955
|
0
|
|
|
|
|
0
|
shift @$toks; |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
elsif ($tok->{lex} =~ /^(?:ACCUSATIVE|NAME)$/ |
958
|
|
|
|
|
|
|
|| $Dindir && $tok->{lex} eq 'DATIVE') |
959
|
8
|
50
|
|
|
|
16
|
{ if ($tok->{lex} eq 'DATIVE') { |
960
|
0
|
|
|
|
|
0
|
$tok->{R} = $Dindir; |
961
|
0
|
|
|
|
|
0
|
$Dindir = 0; |
962
|
|
|
|
|
|
|
} |
963
|
8
|
|
|
|
|
13
|
$Astack_push->($tok); |
964
|
8
|
|
|
|
|
9
|
shift @$toks; |
965
|
8
|
|
|
|
|
10
|
$lastownable = $Astack[-1]{data}; |
966
|
8
|
|
|
|
|
9
|
push @lastsubstantive, $lastownable; |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'ARROW' ) { |
969
|
0
|
|
|
|
|
0
|
my $owner = $toks->[1]; |
970
|
|
|
|
|
|
|
my $perl = $owner->{perl} =~ /^\W/ |
971
|
|
|
|
|
|
|
? $owner->{perl} |
972
|
0
|
0
|
|
|
|
0
|
: "$owner->{raw}::"; |
973
|
|
|
|
|
|
|
$lastownable->[-1]->{perl} |
974
|
0
|
|
|
|
|
0
|
=~ s{^}{$perl->}; |
975
|
0
|
|
|
|
|
0
|
splice @$toks, 0, 2; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'WITHIN' ) { |
978
|
0
|
|
|
|
|
0
|
my $owner = $toks->[1]; |
979
|
|
|
|
|
|
|
$lastownable->[-1]->{raw} |
980
|
0
|
|
|
|
|
0
|
=~ s{^(\W*)}{$1$owner->{raw}::}; |
981
|
|
|
|
|
|
|
$lastownable->[-1]->{perl} |
982
|
0
|
|
|
|
|
0
|
=~ s{^(\W*)}{$1$owner->{raw}::}; |
983
|
0
|
|
|
|
|
0
|
splice @$toks, 0, 2; |
984
|
|
|
|
|
|
|
} |
985
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'GENITIVE' ) { |
986
|
2
|
|
|
|
|
6
|
$reduce->($tok); |
987
|
2
|
|
|
|
|
4
|
my $gen = shift @$toks; |
988
|
2
|
50
|
|
|
|
6
|
die "Genitivum indominum: '$ord->{raw}'" |
989
|
|
|
|
|
|
|
. adversum($gen) |
990
|
|
|
|
|
|
|
unless @lastsubstantive; |
991
|
2
|
|
|
|
|
3
|
$ord = $lastsubstantive[-1][-1]; |
992
|
|
|
|
|
|
|
die "Index '$ord->{raw}' ordinalis non est" |
993
|
|
|
|
|
|
|
. adversum($ord) |
994
|
2
|
50
|
33
|
|
|
16
|
if $ord->{lex} && $ord->{lex} eq 'NUMERAL'; |
995
|
2
|
|
|
|
|
2
|
push @{$ord->{G}}, $gen; |
|
2
|
|
|
|
|
8
|
|
996
|
2
|
|
|
|
|
4
|
$lastownable = $ord->{G}; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'INFINITIVE' ) |
999
|
2
|
|
|
|
|
5
|
{ $reduce->($tok); $Vdone = subdefn($toks); last } |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
3
|
|
1000
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'CONTROL' ) |
1001
|
0
|
|
|
|
|
0
|
{ $reduce->($tok); $Vdone = control($toks, \@Bstack); last } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1002
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'FOR' ) |
1003
|
2
|
|
|
|
|
5
|
{ $reduce->($tok); $Vdone = for_control($toks, \@Bstack); last } |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
2
|
|
1004
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'BEGIN' ) |
1005
|
0
|
|
|
|
|
0
|
{ push @Bstack, block($toks) } |
1006
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'OWNER_D' ) |
1007
|
0
|
|
|
|
|
0
|
{ $reduce->($tok); push @Vstack, $tok; shift @$toks; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1008
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'COMMA' ) |
1009
|
|
|
|
|
|
|
{ $reduce->($tok) |
1010
|
|
|
|
|
|
|
unless $lastownable && @Astack>1 && |
1011
|
8
|
100
|
33
|
|
|
56
|
$lastownable == $Astack[-1]{data}; |
|
|
|
66
|
|
|
|
|
1012
|
|
|
|
|
|
|
die "'$tok->{raw}' immaturum est " . adversum($tok) |
1013
|
8
|
50
|
33
|
|
|
29
|
unless @Astack>1 && $Astack[-1]{complete}; |
1014
|
8
|
|
|
|
|
10
|
$Astack[-1]{complete} = 0; |
1015
|
8
|
|
|
|
|
10
|
shift @$toks; |
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'ADDRESS' ) |
1018
|
0
|
|
|
|
|
0
|
{ $reduce->($tok); |
1019
|
0
|
|
|
|
|
0
|
$Dindir++; |
1020
|
0
|
|
|
|
|
0
|
shift @$toks; |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
elsif ( $tok->{lex} eq 'DATIVE' ) |
1023
|
2
|
|
|
|
|
5
|
{ $reduce->($tok); push @Dstack, $tok; shift @$toks; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
3
|
|
1024
|
2
|
|
|
|
|
3
|
$lastownable = \@Dstack; |
1025
|
2
|
|
|
|
|
3
|
push @lastsubstantive, $lastownable; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
elsif ( $tok->{lex} =~ /^SUBNAME/ ) # WAS: /SUBNAME_ |
1028
|
6
|
50
|
|
|
|
13
|
{ if ($Astack[-1]{complete}) { |
|
|
0
|
|
|
|
|
|
1029
|
6
|
|
|
|
|
13
|
$reduce->($tok) |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
elsif ($tok->{perl} !~ /^(and|or|[&|]{2})$/) { |
1032
|
0
|
|
|
|
|
0
|
push @Astack, { data=>[] }; |
1033
|
|
|
|
|
|
|
} |
1034
|
6
|
|
|
|
|
13
|
push @Vstack, $tok; shift @$toks; |
|
6
|
|
|
|
|
8
|
|
1035
|
6
|
|
|
|
|
14
|
$lastownable = \@Vstack; |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
# elsif ( $tok->{lex} =~ /^SUBNAME$/ ) |
1038
|
|
|
|
|
|
|
# { if ($Astack[-1]{complete}) { |
1039
|
|
|
|
|
|
|
# $reduce->($tok) |
1040
|
|
|
|
|
|
|
# } |
1041
|
|
|
|
|
|
|
# elsif ($tok->{perl} !~ /^[&|]{2}$/ { |
1042
|
|
|
|
|
|
|
# push @Astack, { data=>[] }; |
1043
|
|
|
|
|
|
|
# } |
1044
|
|
|
|
|
|
|
# push @Vstack, $tok; shift @$toks; |
1045
|
|
|
|
|
|
|
# $lastownable = \@Vstack; |
1046
|
|
|
|
|
|
|
# } |
1047
|
|
|
|
|
|
|
elsif ( $tok->{lex} =~ /PERIOD/ ) |
1048
|
4
|
|
33
|
|
|
10
|
{ 1 while $reduce->($tok) && !$Vdone; |
1049
|
|
|
|
|
|
|
$Vdone = pop(@Astack)->{data} |
1050
|
4
|
50
|
0
|
|
|
13
|
if $Lingua::Romana::Perligata::connective |
|
|
|
33
|
|
|
|
|
1051
|
|
|
|
|
|
|
&& !($Vdone || @Astack <= 1); |
1052
|
4
|
|
|
|
|
5
|
shift @$toks; |
1053
|
|
|
|
|
|
|
last |
1054
|
4
|
|
|
|
|
6
|
} |
1055
|
|
|
|
|
|
|
elsif ( $tok->{lex} =~ /CONNECTIVE/ ) |
1056
|
0
|
|
0
|
|
|
0
|
{ 1 while $reduce->($tok) && !$Vdone; |
1057
|
|
|
|
|
|
|
$Vdone = pop(@Astack)->{data} |
1058
|
0
|
0
|
0
|
|
|
0
|
unless $Vdone || @Astack <= 1; |
1059
|
0
|
|
|
|
|
0
|
last } |
1060
|
|
|
|
|
|
|
elsif ( $eatend && $tok->{lex} =~ /$eatend/ ) |
1061
|
2
|
|
|
|
|
8
|
{ 1 while $reduce->($tok); |
1062
|
|
|
|
|
|
|
$Vdone or $Vdone = @Astack > 1 |
1063
|
|
|
|
|
|
|
? pop(@Astack)->{data} |
1064
|
2
|
50
|
|
|
|
11
|
: pop @Dstack; |
|
|
50
|
|
|
|
|
|
1065
|
2
|
|
|
|
|
3
|
shift @$toks; last } |
|
2
|
|
|
|
|
4
|
|
1066
|
|
|
|
|
|
|
elsif ( $noeatend && $tok->{lex} =~ /$noeatend/ ) |
1067
|
0
|
|
|
|
|
0
|
{ 1 while $reduce->($tok); |
1068
|
|
|
|
|
|
|
$Vdone or $Vdone = pop(@Astack)->{data} |
1069
|
0
|
0
|
0
|
|
|
0
|
|| pop @Dstack; |
1070
|
0
|
|
|
|
|
0
|
last } |
1071
|
|
|
|
|
|
|
else { |
1072
|
0
|
|
|
|
|
0
|
die "Non intellexi: '$tok->{raw}'" . adversum($tok); |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
continue { |
1076
|
32
|
|
|
|
|
27
|
$empty = 0; |
1077
|
32
|
50
|
|
|
|
102
|
if ($debug) { |
1078
|
0
|
|
|
|
|
0
|
print "After '$tok->{raw}' ($tok->{lex}):\n"; |
1079
|
0
|
|
|
|
|
0
|
print Data::Dumper->Dump([\@Vstack, \@Astack, \@Bstack, \@Dstack, \@lastsubstantive, \$lastownable, \$Vdone], [qw{Vstack Astack Bstack Dstack LastS LastO Vdone}]); |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
die "Iussum nefastum: '$Vstack[-1]{raw}'" . adversum($Vstack[-1]) |
1083
|
10
|
0
|
33
|
|
|
43
|
. ( $Vstack[-1]{lex} !~ /(ACCUSATIVE|DATIVE)$/ |
|
|
50
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
? "(Vellesne '$Vstack[-1]{raw}mentum' unumve ceteri)\n" |
1085
|
|
|
|
|
|
|
: "" ) |
1086
|
|
|
|
|
|
|
if $Vdone && @Vstack; |
1087
|
|
|
|
|
|
|
die "Accusativum non junctum: '" |
1088
|
0
|
|
|
|
|
0
|
. join(" tum ", map {$_->{raw}} @{$Astack[-1]{data}}) |
|
0
|
|
|
|
|
0
|
|
1089
|
|
|
|
|
|
|
. "'" |
1090
|
10
|
50
|
33
|
|
|
25
|
. adversum($Astack[-1]{data}[0]) |
1091
|
|
|
|
|
|
|
if @Astack > 1 && !@Vstack; |
1092
|
10
|
50
|
33
|
|
|
22
|
die "Dativum non junctum: '$Dstack[-1]{raw}'" . adversum($Dstack[-1]) |
1093
|
|
|
|
|
|
|
if @Dstack && !@Vstack; |
1094
|
10
|
50
|
33
|
|
|
24
|
die "Sententia imperfecta prope '$tok->{raw}'" . adversum($tok) |
1095
|
|
|
|
|
|
|
unless $Vdone || $empty; |
1096
|
10
|
50
|
|
|
|
66
|
return $empty ? $tok |
|
|
100
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
: ref $Vdone eq 'ARRAY' ? $Vdone->[0] |
1098
|
|
|
|
|
|
|
: $Vdone; |
1099
|
|
|
|
|
|
|
} |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
sub block |
1102
|
|
|
|
|
|
|
{ |
1103
|
4
|
|
|
4
|
0
|
6
|
my ($toks) = @_; |
1104
|
4
|
|
|
|
|
5
|
my @self; |
1105
|
4
|
|
|
|
|
6
|
my $next = shift @$toks; |
1106
|
|
|
|
|
|
|
die "Exspectavi 'sic' sed inveni '$next->{raw}'" . adversum($next) |
1107
|
4
|
50
|
|
|
|
10
|
unless $next->{lex} eq 'BEGIN'; |
1108
|
4
|
|
|
|
|
11
|
while ($toks->[0]{lex} ne 'END') { |
1109
|
4
|
|
|
|
|
10
|
my $command = conn_command($_[0],'PERIOD','END'); |
1110
|
4
|
50
|
|
|
|
20
|
push @self, $command if $command; |
1111
|
|
|
|
|
|
|
} |
1112
|
4
|
|
|
|
|
7
|
$next = shift @$toks; |
1113
|
|
|
|
|
|
|
die "Exspectavi 'cis' sed inveni '$next->{raw}'" . adversum($next) |
1114
|
4
|
50
|
|
|
|
23
|
unless $next->{lex} eq 'END'; |
1115
|
4
|
|
|
|
|
25
|
return bless \@self, 'BLOCK'; |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
sub subdefn |
1119
|
|
|
|
|
|
|
{ |
1120
|
2
|
|
|
2
|
0
|
3
|
my ($toks) = @_; |
1121
|
2
|
|
|
|
|
5
|
my $self = shift @$toks; |
1122
|
2
|
|
|
|
|
6
|
$self->{B} = block($toks); |
1123
|
2
|
|
|
|
|
4
|
return $self; |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
sub for_control |
1127
|
|
|
|
|
|
|
{ |
1128
|
2
|
|
|
2
|
0
|
30
|
my ($toks, $Bstack) = @_; |
1129
|
2
|
|
|
|
|
5
|
my $self = shift @$toks; |
1130
|
2
|
|
|
|
|
3
|
my $var; |
1131
|
|
|
|
|
|
|
$var = $toks->[0]{lex} eq 'ACCUSATIVE' |
1132
|
|
|
|
|
|
|
? shift @$toks |
1133
|
|
|
|
|
|
|
: $toks->[0]{lex} ne 'IN' |
1134
|
|
|
|
|
|
|
? die "Exspectavi accusativum post 'per' sed inveni '$toks->[0]{raw}'" . adversum($toks->[0]) |
1135
|
2
|
0
|
|
|
|
8
|
: tokdup $tokens{'huic'}; |
|
|
50
|
|
|
|
|
|
1136
|
2
|
|
|
|
|
5
|
my $in = shift @$toks; |
1137
|
|
|
|
|
|
|
die "'in' pro 'per' afuit" . adversum($in) |
1138
|
2
|
50
|
|
|
|
9
|
unless $in->{lex} eq 'IN'; |
1139
|
2
|
|
|
|
|
6
|
$self->{D} = $var; |
1140
|
2
|
|
|
|
|
10
|
$self->{C} = conn_command($toks,'DO', 'PERIOD'); |
1141
|
2
|
50
|
33
|
|
|
21
|
unless (($self->{C}{lex}||$self->{C}{V}{lex}) =~ /DATIVE|OWNER_D/) { |
1142
|
|
|
|
|
|
|
my ($badraw, $bad) = $self->{C}{lex} |
1143
|
|
|
|
|
|
|
? ($self->{C}{raw}, $self->{C}) |
1144
|
0
|
0
|
|
|
|
0
|
: ($self->{C}{V}{raw}, $self->{C}{V}); |
1145
|
0
|
|
|
|
|
0
|
die "'$badraw' dativus non est in 'per'" . adversum($bad); |
1146
|
|
|
|
|
|
|
} |
1147
|
2
|
50
|
|
|
|
9
|
if ($toks->[0]{lex} =~ /PERIOD|CONNECTIVE/) { |
1148
|
0
|
0
|
|
|
|
0
|
die "Iussa absentia per '$self->{raw}'" . adversum($self) |
1149
|
|
|
|
|
|
|
unless @$Bstack; |
1150
|
0
|
|
|
|
|
0
|
$self->{B} = pop @$Bstack; |
1151
|
0
|
0
|
|
|
|
0
|
shift @$toks unless $toks->[0]{lex} eq 'CONNECTIVE'; |
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
else { |
1154
|
2
|
|
|
|
|
7
|
$self->{B} = block($toks); |
1155
|
|
|
|
|
|
|
} |
1156
|
2
|
|
|
|
|
12
|
return $self; |
1157
|
|
|
|
|
|
|
} |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
sub control |
1160
|
|
|
|
|
|
|
{ |
1161
|
0
|
|
|
0
|
1
|
0
|
my ($toks, $Bstack) = @_; |
1162
|
0
|
|
|
|
|
0
|
my $self = shift @$toks; |
1163
|
0
|
|
|
|
|
0
|
$self->{C} = conn_command($toks,'DO'); |
1164
|
0
|
0
|
0
|
|
|
0
|
if (($self->{perl}||"") eq 'while' && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1165
|
|
|
|
|
|
|
($self->{C}{V}{perl}||"") eq 'Lingua::Romana::Perligata::getline') { |
1166
|
0
|
|
|
|
|
0
|
$self->{C}{V}{diamond} = 1; |
1167
|
|
|
|
|
|
|
} |
1168
|
0
|
0
|
0
|
|
|
0
|
if (!@$toks || $toks->[0]{lex} =~ /PERIOD|CONNECTIVE/) { |
1169
|
0
|
0
|
|
|
|
0
|
die "Iussa absentia per '$self->{raw}'" . adversum($self) |
1170
|
|
|
|
|
|
|
unless @$Bstack; |
1171
|
0
|
|
|
|
|
0
|
$self->{B} = pop @$Bstack; |
1172
|
0
|
0
|
|
|
|
0
|
shift @$toks unless $toks->[0]{lex} eq 'CONNECTIVE'; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
else { |
1175
|
0
|
|
|
|
|
0
|
$self->{B} = block($toks); |
1176
|
|
|
|
|
|
|
} |
1177
|
0
|
|
|
|
|
0
|
return $self; |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
sub __enlist__ { |
1182
|
2
|
|
|
2
|
|
56
|
return ($_[0]..$_[1]); |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
sub __enquote__ { |
1186
|
0
|
|
|
0
|
|
0
|
return join " ", @_; |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
sub __encatenate__ { |
1190
|
0
|
|
|
0
|
|
0
|
return join "", @_; |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
sub __lastelem__(\@) { |
1194
|
0
|
|
|
0
|
|
0
|
return $#{$_[0]}; |
|
0
|
|
|
|
|
0
|
|
1195
|
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
my %lb = ( '@'=>'[', '%'=>'{' ); |
1198
|
|
|
|
|
|
|
my %rb = ( '@'=>']', '%'=>'}' ); |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
sub STATEMENT::translate { |
1201
|
6
|
|
|
6
|
|
15
|
my $verb = $_[0]{V}->translate; |
1202
|
6
|
|
|
|
|
8
|
my $prefix = $_[0]{V}{prefix}; |
1203
|
6
|
|
|
|
|
16
|
my $hasblock = $verb =~ m{^(grep|map)$}; |
1204
|
|
|
|
|
|
|
my $noparen = $_[0]{V}{lex} eq 'OWNER_D' && $_[0]{V}{raw} =~ /o$/ |
1205
|
6
|
|
33
|
|
|
53
|
|| $_[0]{V}{raw} =~ /^(finis|nuntius|factor(em|i))$/ |
1206
|
|
|
|
|
|
|
|| $hasblock; |
1207
|
|
|
|
|
|
|
my $dative = defined $_[0]{D} |
1208
|
|
|
|
|
|
|
? $_[0]{D}->translate |
1209
|
6
|
100
|
|
|
|
19
|
: ""; |
1210
|
6
|
50
|
33
|
|
|
20
|
my $Dref = $verb =~ /^(bless)$/ && $dative =~ /^[%@]/ ? "\\" : ""; |
1211
|
6
|
100
|
|
|
|
14
|
$dative = $Dref . $dative if $dative; |
1212
|
6
|
50
|
33
|
|
|
66
|
my $Dcomma = $dative && defined $_[0]{A} && !$hasblock && $verb !~ /^(print|printf)$/ ? "," : ""; |
1213
|
6
|
50
|
0
|
|
|
50
|
if ($verb =~ /^(package|use)$/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1214
|
0
|
|
|
|
|
0
|
return "$verb $_[0]{A}[0]{raw} "; |
1215
|
|
|
|
|
|
|
} |
1216
|
|
|
|
|
|
|
elsif ($verb eq ':') { # LABEL |
1217
|
0
|
|
|
|
|
0
|
return " $_[0]{A}[0]{raw}: "; |
1218
|
|
|
|
|
|
|
} |
1219
|
|
|
|
|
|
|
elsif ($_[0]{V}{diamond}) { |
1220
|
0
|
|
|
|
|
0
|
$result = "<" . substr($dative,1) . ">"; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
elsif ($verb =~ /^[\$%@]\{$/) { |
1223
|
0
|
|
|
|
|
0
|
$result = $verb . $_[0]{A}[0]->translate . '}'; |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
elsif (! $_[0]{V}{operator}) { |
1226
|
|
|
|
|
|
|
$result = "$verb " |
1227
|
|
|
|
|
|
|
. ($noparen ? "" : "(") |
1228
|
|
|
|
|
|
|
. $dative . $Dcomma |
1229
|
|
|
|
|
|
|
. " " |
1230
|
6
|
50
|
|
|
|
25
|
. (defined $_[0]{A} ? join ", ", map({ $_->translate($_[0]{V}) } @{$_[0]{A}}) : "") |
|
14
|
50
|
|
|
|
31
|
|
|
6
|
50
|
|
|
|
13
|
|
1231
|
|
|
|
|
|
|
. ($noparen ? "" : ")") ; |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
elsif ($prefix && $dative) { |
1234
|
0
|
|
|
|
|
0
|
$result = " $verb $dative "; |
1235
|
|
|
|
|
|
|
} |
1236
|
|
|
|
|
|
|
elsif ($prefix) { |
1237
|
0
|
|
|
|
|
0
|
$result = " $verb (" . $_[0]{A}[0]->translate . ")"; |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
elsif ( $verb eq '=' ) { |
1240
|
|
|
|
|
|
|
$result = " " |
1241
|
|
|
|
|
|
|
. $dative |
1242
|
|
|
|
|
|
|
. " $verb " |
1243
|
0
|
|
|
|
|
0
|
. ( @{$_[0]{A}} > 1 |
1244
|
0
|
|
|
|
|
0
|
? "(" . join(",", map($_->translate, @{$_[0]{A}})) . ")" |
1245
|
0
|
0
|
|
|
|
0
|
: $_[0]{A}[0]->translate |
1246
|
|
|
|
|
|
|
); |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
else |
1249
|
|
|
|
|
|
|
{ |
1250
|
0
|
0
|
|
|
|
0
|
my $Acount = @{$_[0]{A}||[]}; |
|
0
|
|
|
|
|
0
|
|
1251
|
0
|
0
|
|
|
|
0
|
my $neg = $verb =~ s/^!(<=>|cmp)/$1/ ? "!" : ""; |
1252
|
|
|
|
|
|
|
$result = " $neg(" |
1253
|
|
|
|
|
|
|
. ( $dative ? $dative |
1254
|
0
|
|
|
|
|
0
|
: $Acount-- ? shift(@{$_[0]{A}})->translate |
1255
|
|
|
|
|
|
|
: "") |
1256
|
|
|
|
|
|
|
. " $verb " |
1257
|
0
|
0
|
|
|
|
0
|
. ( $Acount ? $_[0]{A}[0]->translate : "") |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
. ")"; |
1259
|
|
|
|
|
|
|
} |
1260
|
6
|
50
|
|
|
|
20
|
if ($_[0]->{G}) { |
1261
|
0
|
|
|
|
|
0
|
my $perl = pop(@{$_[0]->{G}})->{perl}; # LAST GENITIVE IS THE VARIABLE |
|
0
|
|
|
|
|
0
|
|
1262
|
0
|
|
|
|
|
0
|
$perl =~ s/^([\%\@])/\$/; |
1263
|
0
|
|
|
|
|
0
|
my $type = $1; |
1264
|
0
|
|
|
|
|
0
|
while (my $next = pop @{$_[0]->{G}}) { |
|
0
|
|
|
|
|
0
|
|
1265
|
0
|
|
|
|
|
0
|
$perl .= $lb{$type} . $next->translate . $rb{$type}; |
1266
|
|
|
|
|
|
|
} |
1267
|
0
|
|
|
|
|
0
|
$result = $perl . $lb{$type} . $result . $rb{$type}; |
1268
|
|
|
|
|
|
|
} |
1269
|
6
|
|
50
|
|
|
61
|
return '\\'x($_[0]{R}||0) . $result; |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
sub BLOCK::translate { |
1273
|
|
|
|
|
|
|
return "{" |
1274
|
4
|
|
|
4
|
|
7
|
. join(";\n", map {$_->translate} @{$_[0]}) |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
15
|
|
1275
|
|
|
|
|
|
|
. "}" ; |
1276
|
|
|
|
|
|
|
} |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
sub CONNECTIVE::translate { |
1279
|
0
|
|
|
0
|
|
0
|
return $_[0]{L}->translate . " $_[0]{perl} " . $_[0]{R}->translate; |
1280
|
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub Separator::translate { |
1283
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
sub SUBNAME::translate { |
1287
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
sub SUBNAME_OA::translate { |
1291
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
sub SUBNAME_A::translate { |
1295
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
sub SUBNAME_D::translate { |
1299
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
sub SUBNAME_AD::translate { |
1303
|
2
|
|
|
2
|
|
4
|
return $_[0]{perl}; |
1304
|
|
|
|
|
|
|
} |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
sub SUBNAME_AB::translate { |
1307
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
sub SUBNAME_ACCUSATIVE::translate { |
1311
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1312
|
|
|
|
|
|
|
} |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
sub SUBNAME_A_ACCUSATIVE::translate { |
1315
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
sub SUBNAME_D_ACCUSATIVE::translate { |
1319
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1320
|
|
|
|
|
|
|
} |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
sub SUBNAME_AD_ACCUSATIVE::translate { |
1323
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
sub SUBNAME_AB_ACCUSATIVE::translate { |
1327
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1328
|
|
|
|
|
|
|
} |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
sub SUBNAME_B_ACCUSATIVE::translate { |
1331
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
sub SUBNAME_DATIVE::translate { |
1335
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
sub SUBNAME_A_DATIVE::translate { |
1339
|
2
|
|
|
2
|
|
5
|
return $_[0]{perl}; |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
sub SUBNAME_D_DATIVE::translate { |
1343
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub SUBNAME_AD_DATIVE::translate { |
1347
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
sub SUBNAME_AB_DATIVE::translate { |
1351
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
sub SUBNAME_B_DATIVE::translate { |
1355
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1356
|
|
|
|
|
|
|
} |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
sub DATIVE::translate { |
1359
|
2
|
|
|
2
|
|
3
|
my ($self) = @_; |
1360
|
2
|
|
|
|
|
5
|
my $perl = $self->{perl}; |
1361
|
2
|
50
|
|
|
|
7
|
if ($self->{G}) { |
1362
|
0
|
|
|
|
|
0
|
my $gen = pop(@{$self->{G}})->{perl}; # LAST GENITIVE IS THE VARIABLE |
|
0
|
|
|
|
|
0
|
|
1363
|
0
|
|
|
|
|
0
|
$gen =~ s/^([\%\@])/\$/; |
1364
|
0
|
|
|
|
|
0
|
my $type = $1; |
1365
|
0
|
|
|
|
|
0
|
while (my $next = pop @{$self->{G}}) { |
|
0
|
|
|
|
|
0
|
|
1366
|
0
|
|
|
|
|
0
|
$gen .= $lb{$type} . $next->translate . $rb{$type}; |
1367
|
|
|
|
|
|
|
} |
1368
|
0
|
|
|
|
|
0
|
$perl = $gen . $lb{$type} . $perl . $rb{$type}; |
1369
|
|
|
|
|
|
|
} |
1370
|
2
|
|
|
|
|
4
|
return $perl; |
1371
|
|
|
|
|
|
|
} |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
sub OWNER_D::translate { |
1374
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1375
|
|
|
|
|
|
|
} |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
sub ACCUSATIVE::translate { |
1378
|
4
|
|
|
4
|
|
6
|
my ($self) = @_; |
1379
|
4
|
|
|
|
|
6
|
my $perl = $self->{perl}; |
1380
|
4
|
50
|
|
|
|
12
|
if ($self->{G}) { |
1381
|
0
|
|
|
|
|
0
|
my $gen = pop(@{$self->{G}})->{perl}; # LAST GENITIVE IS THE VARIABLE |
|
0
|
|
|
|
|
0
|
|
1382
|
0
|
|
|
|
|
0
|
$gen =~ s/^([\%\@])/\$/; |
1383
|
0
|
|
|
|
|
0
|
my $type = $1; |
1384
|
0
|
|
|
|
|
0
|
while (my $next = pop @{$self->{G}}) { |
|
0
|
|
|
|
|
0
|
|
1385
|
0
|
|
|
|
|
0
|
$gen .= $lb{$type} . $next->translate . $rb{$type}; |
1386
|
|
|
|
|
|
|
} |
1387
|
0
|
|
|
|
|
0
|
$perl = $gen . $lb{$type} . $perl . $rb{$type}; |
1388
|
|
|
|
|
|
|
} |
1389
|
4
|
|
50
|
|
|
29
|
return '\\'x($_[0]{R}||0) . $perl; |
1390
|
|
|
|
|
|
|
} |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
sub CONTROL::translate { |
1393
|
|
|
|
|
|
|
return $_[0]{perl} |
1394
|
|
|
|
|
|
|
. " (" . $_[0]{C}->translate . ") " |
1395
|
|
|
|
|
|
|
. $_[0]{B}->translate |
1396
|
0
|
|
|
0
|
|
0
|
. "\n"; |
1397
|
|
|
|
|
|
|
} |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
sub FOR::translate { |
1400
|
|
|
|
|
|
|
return $_[0]{perl} |
1401
|
|
|
|
|
|
|
. " " . $_[0]{D}->translate |
1402
|
|
|
|
|
|
|
. " (" . $_[0]{C}->translate . ") " |
1403
|
|
|
|
|
|
|
. $_[0]{B}->translate |
1404
|
2
|
|
|
2
|
|
11
|
. "\n"; |
1405
|
|
|
|
|
|
|
} |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
sub NUMERAL::translate { |
1408
|
4
|
|
|
4
|
|
4
|
my ($self) = @_; |
1409
|
|
|
|
|
|
|
# if ($self->{G}) { |
1410
|
|
|
|
|
|
|
# return $self->{G}->index($self->{perl}); |
1411
|
|
|
|
|
|
|
# } |
1412
|
4
|
|
|
|
|
19
|
return $self->{perl}; |
1413
|
|
|
|
|
|
|
} |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
sub ORDINAL::translate { |
1416
|
2
|
|
|
2
|
|
3
|
my ($self) = @_; |
1417
|
2
|
50
|
|
|
|
8
|
return $self->{perl} unless $self->{G}; |
1418
|
2
|
|
|
|
|
3
|
my $perl = pop(@{$self->{G}})->translate; # LAST GENITIVE IS THE VARIABLE |
|
2
|
|
|
|
|
7
|
|
1419
|
2
|
|
|
|
|
92
|
$perl =~ s/^([\%\@])/\$/; |
1420
|
2
|
|
|
|
|
5
|
my $type = $1; |
1421
|
2
|
|
|
|
|
5
|
while (my $next = pop @{$self->{G}}) { |
|
2
|
|
|
|
|
9
|
|
1422
|
0
|
|
|
|
|
0
|
$perl .= $lb{$type} . $next->translate . $rb{$type}; |
1423
|
|
|
|
|
|
|
} |
1424
|
2
|
|
|
|
|
9
|
return $perl . $lb{$type} . $self->{perl} . $rb{$type}; |
1425
|
|
|
|
|
|
|
} |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
*ORDINAL_DATIVE::translate = *ORDINAL::translate; |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
sub DISJUNCTION::translate { |
1430
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1431
|
|
|
|
|
|
|
} |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
sub CONJUNCTION::translate { |
1434
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
sub Literal::translate { |
1438
|
8
|
|
|
8
|
|
10
|
my ($self, $context) = @_; |
1439
|
8
|
|
|
|
|
9
|
my $perl; |
1440
|
8
|
50
|
66
|
|
|
45
|
if ($context && $context->{raw} =~ /^inque/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1441
|
0
|
|
|
|
|
0
|
$perl = qq{'$_[0]{raw}'} |
1442
|
|
|
|
|
|
|
} |
1443
|
|
|
|
|
|
|
elsif ( $self->{lex} eq 'GENITIVE' ) { |
1444
|
0
|
|
|
|
|
0
|
$perl = $self->GENITIVE::translate; |
1445
|
|
|
|
|
|
|
} |
1446
|
|
|
|
|
|
|
elsif ( $self->{lex} eq 'SUBNAME_A_GENITIVE' ) { |
1447
|
0
|
|
|
|
|
0
|
$perl = $self->SUBNAME_A_GENITIVE::translate; |
1448
|
|
|
|
|
|
|
} |
1449
|
|
|
|
|
|
|
elsif ( $self->{lex} eq 'INFINITIVE' ) { |
1450
|
2
|
|
|
|
|
8
|
$perl = "sub $_[0]{perl}\n" . $_[0]{B}->translate; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
else { |
1453
|
|
|
|
|
|
|
$perl = '\\'x($_[0]{R}||0) . $_[0]{perl} |
1454
|
6
|
|
50
|
|
|
29
|
} |
1455
|
8
|
50
|
|
|
|
17
|
if ($self->{G}) { |
1456
|
0
|
|
|
|
|
0
|
my $gen = pop(@{$self->{G}})->{perl}; # LAST GENITIVE IS THE VARIABLE |
|
0
|
|
|
|
|
0
|
|
1457
|
0
|
|
|
|
|
0
|
$gen =~ s/^([\%\@])/\$/; |
1458
|
0
|
|
|
|
|
0
|
my $type = $1; |
1459
|
0
|
|
|
|
|
0
|
while (my $next = pop @{$self->{G}}) { |
|
0
|
|
|
|
|
0
|
|
1460
|
0
|
|
|
|
|
0
|
$gen .= $lb{$type} . $next->translate . $rb{$type}; |
1461
|
|
|
|
|
|
|
} |
1462
|
0
|
|
|
|
|
0
|
$perl = $gen . $lb{$type} . $perl . $rb{$type}; |
1463
|
|
|
|
|
|
|
} |
1464
|
8
|
|
|
|
|
32
|
return $perl; |
1465
|
|
|
|
|
|
|
} |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
sub GENITIVE::translate { |
1468
|
2
|
|
|
2
|
|
4
|
return $_[0]{perl}; |
1469
|
|
|
|
|
|
|
}; |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
sub SUBNAME_A_GENITIVE::translate { |
1472
|
0
|
|
|
0
|
|
0
|
return $_[0]{perl}; |
1473
|
|
|
|
|
|
|
}; |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
sub Name::translate { |
1476
|
2
|
|
|
2
|
|
9
|
return qq{'$_[0]{raw}'} |
1477
|
|
|
|
|
|
|
} |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
1; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
__END__ |