File Coverage

blib/lib/Lingua/Zompist/Cuezi.pm
Criterion Covered Total %
statement 66 298 22.1
branch 47 250 18.8
condition 11 180 6.1
subroutine 6 16 37.5
pod 7 13 53.8
total 137 757 18.1


line stmt bran cond sub pod time code
1             package Lingua::Zompist::Cuezi;
2             # vim:set sw=2 et encoding=utf-8 fileencoding=utf-8 keymap=cuezi:
3              
4 7     7   202887 use 5.005;
  7         26  
  7         408  
5 7     7   39 use strict;
  7         14  
  7         354  
6              
7             require Exporter;
8 7     7   46 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %verb);
  7         13  
  7         155220  
9             @ISA = qw(Exporter);
10              
11             # Items to export into callers namespace by default. Note: do not export
12             # names by default without a very good reason. Use EXPORT_OK instead.
13             # Do not simply export all your public functions/methods/constants.
14              
15             # This allows declaration use Lingua::Zompist::Cuezi ':all';
16             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
17             # will save memory.
18             %EXPORT_TAGS = (
19             'all' => [ qw(
20             %verb
21             inf
22             part
23             noun
24             root
25             adj
26             comp
27             comb
28             ) ],
29             );
30              
31             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
32              
33             @EXPORT = qw(
34            
35             );
36             $VERSION = '0.01';
37              
38              
39             my @persons = qw(sēo/sēi led/lei tāu/tāi tazū/letazū māux cayū);
40              
41             my @cases = qw(nom gen acc dat abl ins);
42              
43             my @numbers = qw(sing pl);
44              
45             my @genders = qw(masc neut fem);
46              
47             my $voiced = qr/[bdgvzmn]/; # stops don't assimilate before laterals l r,
48             # according to Mark
49             my $unvoiced = qr/[ptcfsx]/;
50             my $consonant = qr/[ptcbdgfsxvzmnlr]/;
51             my $stop = qr/[ptcbdg]/;
52             my $vstop = qr/[bdg]/;
53             my $ustop = qr/[ptc]/;
54             my $labial = qr/[mbpl]/;
55             my $dental = qr/[tdcgx]/;
56             my $vowel = qr/[aeiou]/;
57             my $anyvowel = qr/(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/;
58             my $vlong = qr/(?:ā|ē|ī|ō|ū)/;
59             my $vcirc = qr/(?:â|ê|î|ô|û)/;
60             my $alteri = qr/[tcgx]/;
61             my $altere = qr/[tcg]/;
62             my $altered = qr/[syc]/;
63              
64             my %voiced = (
65             'p' => 'b',
66             't' => 'd',
67             'c' => 'g',
68             'f' => 'v',
69             's' => 'z',
70             );
71              
72             my %unvoiced = reverse %voiced;
73              
74             my %alter = (
75             't' => 's',
76             'c' => 's',
77             'g' => 'y',
78             'x' => 'c',
79             );
80              
81             # change root to...
82             my %rootchange = (
83             s => {
84             'orbesiu' => 'c', # noun
85             'lusi' => 't', # noun
86             'brisê' => 't', # verb
87             'babrisê' => 't', # verb
88             'cammisi' => 'c', # adjective
89             'dosi' => 't', # noun
90             'lācasi' => 't', # noun
91             'lusi' => 't', # noun
92             'pīsi' => 't', # verb
93             'bapīsi' => 't', # verb
94             'pose' => 't', # adjective
95             'rāsi' => 't', # noun
96             'ruyise' => 't', # adjective
97             'salese' => 't', # verb
98             'basalese' => 't', # verb
99             'sāsi' => 'c', # verb
100             'basāsi' => 'c', # verb
101             'xosê' => 't', # verb
102             'baxosê' => 't', # verb
103             },
104             y => {
105             'bêyi' => 'g', # verb
106             'babêyi' => 'g', # verb
107             'clāye' => 'g', # verb
108             'baclāye' => 'g', # verb
109             'creyê' => 'g', # verb
110             'bacreyê' => 'g', # verb
111             'drayê' => 'g', # verb
112             'badrayê' => 'g', # verb
113             'exdrayê' => 'g', # verb
114             'baexdrayê' => 'g',# verb
115             'fabēyi' => 'g', # verb
116             'bafabēyi' => 'g', # verb
117             'usayi' => 'g', # noun
118             'xlayê' => 'g', # verb
119             'baxlayê' => 'g', # verb
120             'yayê' => 'g', # verb
121             'bayayê' => 'g', # verb
122             },
123             c => {
124             '' => 'x',
125             },
126             );
127              
128              
129             # Which conjugation is a specific verb?
130              
131             my %conj = (
132             'alirê' => 1,
133             'ambrozâ' => 2,
134             'aviê' => 1,
135             'ayisâ' => 2,
136             'bâ' => 2,
137             'babrivori' => 4,
138             'bamoêli' => 4,
139             'banilerê' => 3,
140             'bapomi' => 4,
141             'barīdi' => 4,
142             'bēre' => 1,
143             'bēse' => 1,
144             'bêti' => 4,
145             'bêyi' => 4,
146             'brinâ' => 2,
147             'brisê' => 3,
148             'brosivê' => 1,
149             'brozâ' => 2,
150             'būga' => 2, # before front vowels: ūg --> ūi! (TODO)
151             'cadi' => 4,
152             'cāpi' => 4,
153             'cāurê' => 1,
154             'cisi' => 4,
155             'civê' => 1,
156             'clāye' => 5, # y --> g
157             'coêli' => 4,
158             'cōli' => 4, # cīli is a misconversion, according to Mark
159             'cranivê' => 1,
160             'crêsi' => 4,
161             'creyê' => 3, # y --> g
162             'curi' => 4,
163             'dâ' => 2,
164             'dei' => 4,
165             'diazami' => 4,
166             'drâcê' => 3,
167             'dralāda' => 2,
168             'drayê' => 3, # y --> g
169             'drogâ' => 2, # g -> y TODO
170             'drouvê' => 1,
171             'duli' => 4,
172             'duni' => 4,
173             'duntracê' => 3,
174             'êcuri' => 4,
175             'embesê' => 1, # this has a question mark in the document
176             # 'esc' => 2,
177             'exdrayê' => 1, # y --> g
178             'fabēyi' => 4,
179             'fāsi' => 4,
180             'faleriê' => 3,
181             'fi' => 4,
182             'fūra' => 2,
183             'gāema' => 2,
184             'gâsi' => 4,
185             'gobrinâ' => 2,
186             'gocivê' => 1,
187             'gocuri' => 4,
188             # 'goes' => 2, # conjugates like esc
189             'golôdi' => 4,
190             'îcâ' => 2,
191             'lāda' => 2,
192             'lanê' => 1,
193             'lerê' => 3,
194             'lerisuê' => 3,
195             'lûre' => 5,
196             'lūve' => 1,
197             'mê' => 1,
198             'mētuda' => 2,
199             'mētulerê' => 3,
200             'missê' => 1,
201             'mizida' => 2,
202             'mûstolê' => 3,
203             'nalerê' => 3,
204             'namâsiê' => 3,
205             'natēre' => 5,
206             'nîê' => 3,
207             'nizanê' => 3,
208             'nōue' => 5,
209             'nure' => 5,
210             # 'ogonê' => 'P', # passive voice only
211             'ōibâ' => 2, # or ōiba? It's from ōi + bâ
212             'ōicopa' => 2,
213             'ōinote' => 5,
214             'ōisizi' => 4,
215             # 'omê' => 'P', # passive voice only; < mê (1)
216             # 'onê' => 'P', # passive voice only
217             'ori' => 4,
218             'pelê' => 1,
219             'pêtâ' => 2,
220             'pisi' => 4,
221             'pīsi' => 4,
222             'rēne' => 3,
223             'rêsê' => 3,
224             'retê' => 3,
225             'ridi' => 4,
226             'ripâ' => 2,
227             'risoni' => 4,
228             'rīxa' => 2, # x --> c TODO?
229             'rōci' => 4,
230             'rusê' => 1,
231             'sālāda' => 2,
232             'salese' => 5, # s --> t TODO
233             'sāsi' => 4,
234             'selirê' => '1',
235             'sile' => 5,
236             'sisi' => 4,
237             'sizi' => 4,
238             'sofusê' => 3,
239             'somâ' => 2,
240             'sonure' => 5,
241             'sûduni' => 4,
242             'sulāda' => 2,
243             'sûmissê' => 1,
244             'sunutāne' => 3,
245             'sunōibâ' => 2,
246             'taige' => 5,
247             'tâsi' => 4,
248             'tēre' => 5,
249             # 'ties' => 2, # conjugates like esc
250             'tolê' => 3,
251             'tôsê' => 3,
252             'usāle' => 3,
253             'utāne' => 3,
254             'vissê' => 1,
255             'vissivê' => 1,
256             'vûne' => 3,
257             'xēcuvissê' => 1, # or xēcuvisse? < xēcu + vissê
258             'xlayê' => 1, # y --> g
259             'xosê' => 1, # s --> t TODO
260             'yayê' => 3, # y --> g
261             'zamêrê' => 3,
262             'zicuê' => 3,
263             'zīde' => 3,
264             );
265              
266              
267             # And now, the gigantic horror structure that is the Cuêzi verb!
268              
269             # the actual structure itself.
270             %verb = (
271             normal => {
272             active => {
273             perfect => {
274             definite => {
275             present => sub {
276             # normal active perfect definite present
277             my($verb, $conj) = @_;
278             my $stem = $verb;
279             my $table;
280              
281             return [ qw( sāi sēi ê zāmo zāzi zota ) ] if $verb eq 'esc';
282              
283             # Try to look up the conjugation if we're supposed to guess
284             $conj ||= $conj{$verb};
285              
286             # Do we still not know? Try to guess from the ending
287             # This only works for conjugations 2 (â a) and 4 (i)
288             # -e could be any of 1 3 5; -ê either of 1 3
289             unless(defined $conj) {
290             if($verb =~ m/(?:â|a)$/) {
291             $conj = 2;
292             } elsif($verb =~ m/i$/) {
293             $conj = 4;
294             } else {
295             return;
296             }
297             }
298              
299             if($conj == 1) {
300             $stem =~ s/(?:ê|e)$//;
301             # īmo īzi are misconversions, according to Mark
302             $table = [ map "$stem$_", qw( āo ēo e ōmo ōzi ota ) ];
303             } elsif($conj == 2) {
304             $stem =~ s/(?:â|a)$//;
305             $table = [ map "$stem$_", qw( āi ēi e āmo āzi ota ) ];
306             } elsif($conj == 3) {
307             $stem =~ s/(?:ê|e)$//;
308             $table = [ map "$stem$_", qw( āi ēi e āmo āzi itu ) ];
309             } elsif($conj == 4) {
310             $stem =~ s/i$//;
311             $table = [ map "$stem$_", qw( āu ēu i umo uzi itu ) ];
312             } elsif($conj == 5) {
313             $stem =~ s/e$//;
314             $table = [ map "$stem$_", qw( āu ēu e umo uzi uta ) ];
315             } else {
316             return;
317             }
318              
319             for(@$table) {
320             # change root consonant before -e and -i
321             # except when preceded by another consonant or a circumflexed vowel
322             if(/$alteri(?:i(?:tu)?)$/o
323             && !/(?:$vcirc|$consonant)(?:$alteri)(?:i(?:tu)?)$/o) {
324             s/($alteri)(?=(?:i(?:tu)?)$)/$alter{$1}/o;
325             }
326             if(/$altere(?:e|ē[oiu])$/o
327             && !/(?:$vcirc|$consonant)(?:$altere)(?:e|ē[oiu])$/o) {
328             s/($altere)(?=(?:e|ē[oiu])$)/$alter{$1}/o;
329             }
330              
331             # restore original root consonant before -a -o -u
332             if(/([syc])(?:ō(?:mo|zi)|ota|ā(?:[oiu]|mo|zi)|u(?:mo|zi|ta))$/
333             && exists $rootchange{$1}{$verb})
334             {
335             s/([syc])(?=(?:ō(?:mo|zi)|ota|ā(?:[oiu]|mo|zi)|u(?:mo|zi|ta))$)/$rootchange{$1}{$verb}/;
336             }
337             }
338              
339             return $table;
340             },
341             past => sub {
342             # normal active perfect definite past
343             my($verb, $conj) = @_;
344             my $stem = $verb;
345             my $table;
346              
347             # īmo īzi are misconversions, according to Mark
348             return [ qw( sio sio sā sōmo sōzi sītu ) ] if $verb eq 'esc';
349              
350             # Try to look up the conjugation if we're supposed to guess
351             $conj ||= $conj{$verb};
352              
353             # Do we still not know? Try to guess from the ending
354             # This only works for conjugations 2 (â a) and 4 (i)
355             # -e could be any of 1 3 5; -ê either of 1 3
356             unless(defined $conj) {
357             if($verb =~ m/(?:â|a)$/) {
358             $conj = 2;
359             } elsif($verb =~ m/i$/) {
360             $conj = 4;
361             } else {
362             return;
363             }
364             }
365              
366             if($conj == 1) {
367             $stem =~ s/(?:ê|e)$//;
368             $table = [ map "$stem$_", qw( iu iu ū ūmo ūzi ūta ) ];
369             } elsif($conj == 2) {
370             $stem =~ s/(?:â|a)$//;
371             # īmo īzi are misconversions, according to Mark
372             $table = [ map "$stem$_", qw( io io ā ōmo ōzi ītu ) ];
373             } elsif($conj == 3) {
374             $stem =~ s/(?:ê|e)$//;
375             # īmo īzi are misconversions, according to Mark
376             $table = [ map "$stem$_", qw( io io ā ōmo ōzi ītu ) ];
377             } elsif($conj == 4) {
378             $stem =~ s/i$//;
379             $table = [ map "$stem$_", qw( ie ie ē ēmo ēzi ītu ) ];
380             } elsif($conj == 5) {
381             $stem =~ s/e$//;
382             $table = [ map "$stem$_", qw( ie ie ē ēmo ēzi ītu ) ];
383             } else {
384             return;
385             }
386              
387             for(@$table) {
388             # change root consonant before -e and -i
389             # except when preceded by another consonant or a circumflexed vowel
390             # iu io ie ē ēmo ēzi ītu
391             if(/$alteri(?:i[uoe]|ītu)$/o
392             && !/(?:$vcirc|$consonant)(?:$alteri)(?:i[uoe]|ītu)$/o) {
393             s/($alteri)(?=(?:i[uoe]|ītu)$)/$alter{$1}/o;
394             }
395             if(/$altere(?:ē(?:mo|zi)?)$/o
396             && !/(?:$vcirc|$consonant)(?:$altere)(?:ē(?:mo|zi)?)$/o) {
397             s/($altere)(?=(?:ē(?:mo|zi)?)$)/$alter{$1}/o;
398             }
399              
400             # restore original root consonant before -a -o -u
401             # ū ūmo ūzi ūta ōmo ōzi ā
402             if(/([syc])(?:ō(?:mo|zi)|ā|ū(?:mo|zi|ta)?)$/
403             && exists $rootchange{$1}{$verb})
404             {
405             s/([syc])(?=(?:ō(?:mo|zi)|ā|ū(?:mo|zi|ta)?)$)/$rootchange{$1}{$verb}/;
406             }
407             }
408              
409             return $table;
410             },
411             'past anterior' => sub {
412             # normal active perfect definite past anterior
413             my($verb, $conj) = @_;
414             my $stem = $verb;
415             my $table;
416              
417             ($conj, $verb, $stem) = (2, 'zâ', 'zâ') if $verb eq 'esc';
418              
419             # Try to look up the conjugation if we're supposed to guess
420             $conj ||= $conj{$verb};
421              
422             # Do we still not know? Try to guess from the ending
423             # This only works for conjugations 2 (â a) and 4 (i)
424             # -e could be any of 1 3 5; -ê either of 1 3
425             unless(defined $conj) {
426             if($verb =~ m/(?:â|a)$/) {
427             $conj = 2;
428             } elsif($verb =~ m/i$/) {
429             $conj = 4;
430             } else {
431             return;
432             }
433             }
434              
435             if($conj == 1) {
436             $stem =~ s/(?:ê|e)$/er/;
437             if($stem =~ /$altere(?:er)$/o
438             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
439             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
440             }
441             $table = [ map "$stem$_", qw( iu iu ū ūmo ūzi ūta ) ];
442             } elsif($conj == 2) {
443             $stem =~ s/(?:â|a)$/er/;
444             if($stem =~ /$altere(?:er)$/o
445             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
446             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
447             }
448             # īmo īzi are misconversions, according to Mark
449             $table = [ map "$stem$_", qw( io io ā ōmo ōzi ītu ) ];
450             } elsif($conj == 3) {
451             $stem =~ s/(?:ê|e)$/er/;
452             if($stem =~ /$altere(?:er)$/o
453             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
454             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
455             }
456             # īmo īzi are misconversions, according to Mark
457             $table = [ map "$stem$_", qw( io io ā ōmo ōzi ītu ) ];
458             } elsif($conj == 4) {
459             $stem =~ s/i$/ir/;
460             if($stem =~ /$alteri(?:ir)$/o
461             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:ir)$/o) {
462             $stem =~ s/($alteri)(?=ir$)/$alter{$1}/o;
463             }
464             $table = [ map "$stem$_", qw( ie ie ē ēmo ēzi ītu ) ];
465             } elsif($conj == 5) {
466             $stem =~ s/e$/er/;
467             if($stem =~ /$altere(?:er)$/o
468             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
469             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
470             }
471             $table = [ map "$stem$_", qw( ie ie ē ēmo ēzi ītu ) ];
472             } else {
473             return;
474             }
475              
476             return $table;
477             },
478             future => sub {
479             # normal active perfect definite future
480             my($verb, $conj) = @_;
481             my $stem = $verb;
482             my $table;
483              
484             ($conj, $verb, $stem) = (2, 'zâ', 'zâ') if $verb eq 'esc';
485              
486             # Try to look up the conjugation if we're supposed to guess
487             $conj ||= $conj{$verb};
488              
489             # Do we still not know? Try to guess from the ending
490             # This only works for conjugations 2 (â a) and 4 (i)
491             # -e could be any of 1 3 5; -ê either of 1 3
492             unless(defined $conj) {
493             if($verb =~ m/(?:â|a)$/) {
494             $conj = 2;
495             } elsif($verb =~ m/i$/) {
496             $conj = 4;
497             } else {
498             return;
499             }
500             }
501              
502             if($conj == 1) {
503             $stem =~ s/(?:ê|e)$/il/;
504             if($stem =~ /$alteri(?:il)$/o
505             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
506             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
507             }
508             # īmo īzi are misconversions, according to Mark
509             $table = [ map "$stem$_", qw( āo ēo e ōmo ōzi ota ) ];
510             } elsif($conj == 2) {
511             $stem =~ s/(?:â|a)$/al/;
512             if($stem =~ /([syc])al$/
513             && exists $rootchange{$1}{$verb})
514             {
515             $stem =~ s/([syc])(?=al$)/$rootchange{$1}{$verb}/;
516             }
517             $table = [ map "$stem$_", qw( āi ēi e āmo āzi ota ) ];
518             } elsif($conj == 3) {
519             $stem =~ s/(?:ê|e)$/il/;
520             if($stem =~ /$alteri(?:il)$/o
521             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
522             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
523             }
524             $table = [ map "$stem$_", qw( āi ēi e āmo āzi itu ) ];
525             } elsif($conj == 4) {
526             $stem =~ s/i$/il/;
527             if($stem =~ /$alteri(?:il)$/o
528             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
529             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
530             }
531             $table = [ map "$stem$_", qw( āu ēu i umo uzi itu ) ];
532             } elsif($conj == 5) {
533             $stem =~ s/e$/il/;
534             if($stem =~ /$alteri(?:il)$/o
535             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
536             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
537             }
538             $table = [ map "$stem$_", qw( āu ēu e umo uzi uta ) ];
539             } else {
540             return;
541             }
542              
543             return $table;
544             },
545             },
546             remote => {
547             present => sub {
548             # normal active perfect remote present
549             my($verb, $conj) = @_;
550             my $stem = $verb;
551             my $table;
552              
553             return [ qw( zetāu zesēu zesê zetumi zetezi zesitu ) ] if $verb eq 'esc';
554              
555             # esc is nearly regular, except for zesê instead of zesi.
556             # ($conj, $verb, $stem) = (4, 'zi', 'zi') if $verb eq 'esc';
557              
558             # Try to look up the conjugation if we're supposed to guess
559             $conj ||= $conj{$verb};
560              
561             # Do we still not know? Try to guess from the ending
562             # This only works for conjugations 2 (â a) and 4 (i)
563             # -e could be any of 1 3 5; -ê either of 1 3
564             unless(defined $conj) {
565             if($verb =~ m/(?:â|a)$/) {
566             $conj = 2;
567             } elsif($verb =~ m/i$/) {
568             $conj = 4;
569             } else {
570             return;
571             }
572             }
573              
574             if($conj == 1) {
575             $stem =~ s/(?:ê|e)$//;
576             if($stem =~ /$altere$/o
577             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
578             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
579             }
580             # This is -etīmo and -etīzi in the document, but they are
581             # misconversions of -ō- according to Mark.
582             $table = [ map "$stem$_", qw( etāo esēo ese etōmo etōzi etota ) ];
583             } elsif($conj == 2) {
584             $stem =~ s/(?:â|a)$//;
585             if($stem =~ /$altere$/o
586             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
587             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
588             }
589             $table = [ map "$stem$_", qw( ināi inēi ine ināmo ināzi inota ) ];
590             } elsif($conj == 3) {
591             $stem =~ s/(?:ê|e)$//;
592             if($stem =~ /$altere$/o
593             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
594             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
595             }
596             $table = [ map "$stem$_", qw( ināi inēi ine ināmo ināzi initu ) ];
597             } elsif($conj == 4) {
598             $stem =~ s/i$//;
599             if($stem =~ /$altere$/o
600             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
601             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
602             }
603             $table = [ map "$stem$_", qw( etāu esēu esi etumo etuzi esitu ) ];
604             } elsif($conj == 5) {
605             $stem =~ s/e$//;
606             if($stem =~ /$altere$/o
607             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
608             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
609             }
610             $table = [ map "$stem$_", qw( etāu esēu ese etumo etuzi etuta ) ];
611             } else {
612             return;
613             }
614              
615             return $table;
616             },
617             past => sub {
618             # normal active perfect remote past
619             my($verb, $conj) = @_;
620             my $stem = $verb;
621             my $table;
622              
623             ($conj, $verb, $stem) = (4, 'zi', 'zi') if $verb eq 'esc';
624              
625             # Try to look up the conjugation if we're supposed to guess
626             $conj ||= $conj{$verb};
627              
628             # Do we still not know? Try to guess from the ending
629             # This only works for conjugations 2 (â a) and 4 (i)
630             # -e could be any of 1 3 5; -ê either of 1 3
631             unless(defined $conj) {
632             if($verb =~ m/(?:â|a)$/) {
633             $conj = 2;
634             } elsif($verb =~ m/i$/) {
635             $conj = 4;
636             } else {
637             return;
638             }
639             }
640              
641             if($conj == 1) {
642             $stem =~ s/(?:ê|e)$//;
643             if($stem =~ /$altere$/o
644             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
645             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
646             }
647             $table = [ map "$stem$_", qw( esiu esiu etū etūmo etūzi etūta ) ];
648             } elsif($conj == 2) {
649             $stem =~ s/(?:â|a)$//;
650             if($stem =~ /$altere$/o
651             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
652             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
653             }
654             # īmo īzi are misconversions, according to Mark
655             $table = [ map "$stem$_", qw( inio inio inā inōmo inōzi inītu ) ];
656             } elsif($conj == 3) {
657             $stem =~ s/(?:ê|e)$//;
658             if($stem =~ /$altere$/o
659             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
660             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
661             }
662             # īmo īzi are misconversions, according to Mark
663             $table = [ map "$stem$_", qw( inio inio inā inōmo inōzi inītu ) ];
664             } elsif($conj == 4) {
665             $stem =~ s/i$//;
666             if($stem =~ /$altere$/o
667             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
668             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
669             }
670             $table = [ map "$stem$_", qw( esie esie esē esēmo esēzi esītu ) ];
671             } elsif($conj == 5) {
672             $stem =~ s/e$//;
673             if($stem =~ /$altere$/o
674             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
675             $stem =~ s/($altere)(?=$)/$alter{$1}/o;
676             }
677             $table = [ map "$stem$_", qw( esie esie esē esēmo esēzi esītu ) ];
678             } else {
679             return;
680             }
681              
682             return $table;
683             },
684             'past anterior' => sub {
685             # normal active perfect remote past anterior
686             my($verb, $conj) = @_;
687             my $stem = $verb;
688             my $table;
689              
690             ($conj, $verb, $stem) = (4, 'zi', 'zi') if $verb eq 'esc';
691              
692             # Try to look up the conjugation if we're supposed to guess
693             $conj ||= $conj{$verb};
694              
695             # Do we still not know? Try to guess from the ending
696             # This only works for conjugations 2 (â a) and 4 (i)
697             # -e could be any of 1 3 5; -ê either of 1 3
698             unless(defined $conj) {
699             if($verb =~ m/(?:â|a)$/) {
700             $conj = 2;
701             } elsif($verb =~ m/i$/) {
702             $conj = 4;
703             } else {
704             return;
705             }
706             }
707              
708             if($conj == 1) {
709             $stem =~ s/(?:ê|e)$/er/;
710             if($stem =~ /$altere(?:er)$/o
711             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
712             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
713             }
714             $table = [ map "$stem$_", qw( esiu esiu etū etūmo etūzi etūta ) ];
715             } elsif($conj == 2) {
716             $stem =~ s/(?:â|a)$/er/;
717             if($stem =~ /$altere(?:er)$/o
718             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
719             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
720             }
721             # īmo īzi are misconversions, according to Mark
722             $table = [ map "$stem$_", qw( inio inio inā inōmo inōzi inītu ) ];
723             } elsif($conj == 3) {
724             $stem =~ s/(?:ê|e)$/er/;
725             if($stem =~ /$altere(?:er)$/o
726             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
727             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
728             }
729             # īmo īzi are misconversions, according to Mark
730             $table = [ map "$stem$_", qw( inio inio inā inōmo inōzi inītu ) ];
731             } elsif($conj == 4) {
732             $stem =~ s/i$/ir/;
733             if($stem =~ /$alteri(?:ir)$/o
734             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:ir)$/o) {
735             $stem =~ s/($alteri)(?=ir$)/$alter{$1}/o;
736             }
737             $table = [ map "$stem$_", qw( esie esie esē esēmo esēzi esītu ) ];
738             } elsif($conj == 5) {
739             $stem =~ s/e$/er/;
740             if($stem =~ /$altere(?:er)$/o
741             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
742             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
743             }
744             $table = [ map "$stem$_", qw( esie esie esē esēmo esēzi esītu ) ];
745             } else {
746             return;
747             }
748              
749             return $table;
750             },
751             future => sub {
752             # normal active perfect remote future
753             my($verb, $conj) = @_;
754             my $stem = $verb;
755             my $table;
756              
757             ($conj, $verb, $stem) = (4, 'zi', 'zi') if $verb eq 'esc';
758              
759             # Try to look up the conjugation if we're supposed to guess
760             $conj ||= $conj{$verb};
761              
762             # Do we still not know? Try to guess from the ending
763             # This only works for conjugations 2 (â a) and 4 (i)
764             # -e could be any of 1 3 5; -ê either of 1 3
765             unless(defined $conj) {
766             if($verb =~ m/(?:â|a)$/) {
767             $conj = 2;
768             } elsif($verb =~ m/i$/) {
769             $conj = 4;
770             } else {
771             return;
772             }
773             }
774              
775             if($conj == 1) {
776             $stem =~ s/(?:ê|e)$/il/;
777             if($stem =~ /$alteri(?:il)$/o
778             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
779             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
780             }
781             # īmo īzi are misconversions, according to Mark
782             $table = [ map "$stem$_", qw( etāo esēo ese etōmo etōzi etota ) ];
783             } elsif($conj == 2) {
784             $stem =~ s/(?:â|a)$/al/;
785             if($stem =~ /([syc])al$/
786             && exists $rootchange{$1}{$verb})
787             {
788             $stem =~ s/([syc])(?=al$)/$rootchange{$1}{$verb}/;
789             }
790             $table = [ map "$stem$_", qw( ināi inēi ine ināmo ināzi inota ) ];
791             } elsif($conj == 3) {
792             $stem =~ s/(?:ê|e)$/il/;
793             if($stem =~ /$alteri(?:il)$/o
794             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
795             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
796             }
797             $table = [ map "$stem$_", qw( ināi inēi ine ināmo ināzi initu ) ];
798             } elsif($conj == 4) {
799             $stem =~ s/i$/il/;
800             if($stem =~ /$alteri(?:il)$/o
801             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
802             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
803             }
804             $table = [ map "$stem$_", qw( etāu esēu esi etumo etuzi esitu ) ];
805             } elsif($conj == 5) {
806             $stem =~ s/e$/il/;
807             if($stem =~ /$alteri(?:il)$/o
808             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
809             $stem =~ s/($alteri)(?=il$)/$alter{$1}/o;
810             }
811             $table = [ map "$stem$_", qw( etāu esēu ese etumo etuzi etuta ) ];
812             } else {
813             return;
814             }
815              
816             return $table;
817             },
818             },
819             },
820             imperfect => {
821             definite => {
822             present => \&imperfect,
823             past => \&imperfect,
824             'past anterior' => \&imperfect,
825             future => \&imperfect,
826             },
827             remote => {
828             present => \&imperfect,
829             past => \&imperfect,
830             'past anterior' => \&imperfect,
831             future => \&imperfect,
832             },
833             },
834             },
835             passive => {
836             perfect => {
837             definite => {
838             present => sub {
839             # normal passive perfect definite present
840             my($verb) = @_;
841             my $stem = $verb;
842             my $table;
843              
844             # TODO - Passive root of xuêsi is oxês- not oxuês-
845             # (All passive forms are affected)
846              
847             return if $verb eq 'esc';
848              
849             # Passive root of xuêsi is oxês- not oxuês-
850             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
851              
852             # Replace an initial vowel with o-, or add an o-
853             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
854              
855             # Delete the final vowel
856             $stem =~ s/(?:[eai]|ê|â|î)$//;
857              
858             $table = [ map "$stem$_", qw( āl ēl el mal sal tal ) ];
859              
860             for(@$table) {
861             # change root consonant before -e
862             # except when preceded by another consonant or a circumflexed vowel
863             if(/$altere(?:el|ēl)$/o
864             && !/(?:$vcirc|$consonant)(?:$altere)(?:el|ēl)$/o) {
865             s/($altere)(?=(?:el|ēl)$)/$alter{$1}/o;
866             }
867              
868             # restore original root consonant before -ā or consonant
869             if(/([syc])(?:āl|[mst]al)$/
870             && exists $rootchange{$1}{$verb})
871             {
872             s/([syc])(?=(?:āl|[mst]al)$)/$rootchange{$1}{$verb}/;
873             }
874             }
875              
876             return $table;
877             },
878             past => sub {
879             # normal passive perfect definite past
880             my($verb) = @_;
881             my $stem = $verb;
882             my $table;
883              
884             return if $verb eq 'esc';
885              
886             # Passive root of xuêsi is oxês- not oxuês-
887             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
888              
889             # Replace an initial vowel with o-, or add an o-
890             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
891              
892             # Delete the final vowel
893             $stem =~ s/(?:[eai]|ê|â|î)$//;
894              
895             $table = [ map "$stem$_", qw( il il āl mul sul tul ) ];
896              
897             for(@$table) {
898             # change root consonant before -i
899             # except when preceded by another consonant or a circumflexed vowel
900             if(/$alteri(?:il)$/o
901             && !/(?:$vcirc|$consonant)(?:$alteri)(?:il)$/o) {
902             s/($alteri)(?=(?:il)$)/$alter{$1}/o;
903             }
904              
905             # restore original root consonant before -ā or consonant
906             if(/([syc])(?:āl|[mst]ul)$/
907             && exists $rootchange{$1}{$verb})
908             {
909             s/([syc])(?=(?:āl|[mst]ul)$)/$rootchange{$1}{$verb}/;
910             }
911             }
912              
913             return $table;
914             },
915             'past anterior' => sub {
916             # normal passive perfect definite past anterior
917             my($verb) = @_;
918             my $stem = $verb;
919             my $table;
920              
921             return if $verb eq 'esc';
922              
923             # Passive root of xuêsi is oxês- not oxuês-
924             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
925              
926             # Replace an initial vowel with o-, or add an o-
927             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
928              
929             # Delete the final vowel
930             $stem =~ s/(?:[eai]|ê|â|î)$//;
931              
932             if($stem =~ /$altere$/o
933             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
934             s/($altere)(?=$)/$alter{$1}/o;
935             }
936              
937             $table = [ map "$stem$_", qw( eril eril erāl ermul erzul erdul ) ];
938              
939             return $table;
940             },
941             future => sub {
942             # normal passive perfect definite future
943             my($verb) = @_;
944             my $stem = $verb;
945             my $table;
946              
947             # Passive root of xuêsi is oxês- not oxuês-
948             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
949              
950             return if $verb eq 'esc';
951              
952             # Replace an initial vowel with o-, or add an o-
953             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
954              
955             # Delete the final vowel
956             $stem =~ s/(?:[eai]|ê|â|î)$//;
957              
958             if($stem =~ /([syc])$/
959             && exists $rootchange{$1}{$verb})
960             {
961             $stem =~ s/([syc])(?=$)/$rootchange{$1}{$verb}/;
962             }
963              
964             $table = [ map "$stem$_", qw( alāl alēl alel almal alzal aldal ) ];
965              
966             return $table;
967             },
968             },
969             remote => {
970             present => sub {
971             # normal passive perfect remote present
972             my($verb) = @_;
973             my $stem = $verb;
974             my $table;
975              
976             return if $verb eq 'esc';
977              
978             # Passive root of xuêsi is oxês- not oxuês-
979             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
980              
981             # Replace an initial vowel with o-, or add an o-
982             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
983              
984             # Delete the final vowel
985             $stem =~ s/(?:[eai]|ê|â|î)$//;
986              
987             if($stem =~ /$alteri$/o
988             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)$/o) {
989             s/($alteri)(?=$)/$alter{$1}/o;
990             }
991              
992             $table = [ map "$stem$_", qw( ināl inēl inel imal izal idal ) ];
993              
994             return $table;
995             },
996             past => sub {
997             # normal passive perfect remote past
998             my($verb) = @_;
999             my $stem = $verb;
1000             my $table;
1001              
1002             return if $verb eq 'esc';
1003              
1004             # Passive root of xuêsi is oxês- not oxuês-
1005             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1006              
1007             # Replace an initial vowel with o-, or add an o-
1008             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
1009              
1010             # Delete the final vowel
1011             $stem =~ s/(?:[eai]|ê|â|î)$//;
1012              
1013             if($stem =~ /$alteri$/o
1014             && $stem !~ /(?:$vcirc|$consonant)(?:$alteri)$/o) {
1015             s/($alteri)(?=$)/$alter{$1}/o;
1016             }
1017              
1018             $table = [ map "$stem$_", qw( inil inil ināl imul izul idul ) ];
1019              
1020             return $table;
1021             },
1022             'past anterior' => sub {
1023             # normal passive perfect remote past anterior
1024             my($verb) = @_;
1025             my $stem = $verb;
1026             my $table;
1027              
1028             return if $verb eq 'esc';
1029              
1030             # Passive root of xuêsi is oxês- not oxuês-
1031             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1032              
1033             # Replace an initial vowel with o-, or add an o-
1034             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
1035              
1036             # Delete the final vowel
1037             $stem =~ s/(?:[eai]|ê|â|î)$//;
1038              
1039             if($stem =~ /$altere$/o
1040             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)$/o) {
1041             s/($altere)(?=$)/$alter{$1}/o;
1042             }
1043              
1044             $table = [ map "$stem$_", qw( erinil erinil erināl erimul erizul eridul ) ];
1045              
1046             return $table;
1047             },
1048             future => sub {
1049             # normal passive perfect remote future
1050             my($verb) = @_;
1051             my $stem = $verb;
1052             my $table;
1053              
1054             return if $verb eq 'esc';
1055              
1056             # Passive root of xuêsi is oxês- not oxuês-
1057             $stem =~ s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1058              
1059             # Replace an initial vowel with o-, or add an o-
1060             $stem =~ s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || $stem =~ s/^/o/;
1061              
1062             # Delete the final vowel
1063             $stem =~ s/(?:[eai]|ê|â|î)$//;
1064              
1065             if($stem =~ /([syc])$/
1066             && exists $rootchange{$1}{$verb})
1067             {
1068             $stem =~ s/([syc])(?=$)/$rootchange{$1}{$verb}/;
1069             }
1070              
1071             $table = [ map "$stem$_", qw( alināl alinēl alinel alimal alizal alidal ) ];
1072              
1073             return $table;
1074             },
1075             },
1076             },
1077             imperfect => {
1078             definite => {
1079             present => \&passive_imperfect,
1080             past => \&passive_imperfect,
1081             'past anterior' => \&passive_imperfect,
1082             future => \&passive_imperfect,
1083             },
1084             remote => {
1085             present => \&passive_imperfect,
1086             past => \&passive_imperfect,
1087             'past anterior' => \&passive_imperfect,
1088             future => \&passive_imperfect,
1089             },
1090             },
1091             },
1092             },
1093             causative => {
1094             active => {
1095             perfect => {
1096             definite => {
1097             present => sub {
1098             # causative active perfect definite present
1099             my($verb) = @_;
1100             my $stem = $verb;
1101             my $table;
1102              
1103             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1104              
1105             # Delete the final vowel
1106             $stem =~ s/(?:[eai]|ê|â|î|û)$//;
1107              
1108             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1109              
1110             for(@$table) {
1111             # change root consonant before -i
1112             # except when preceded by another consonant or a circumflexed vowel
1113             if(/$alteri(?:ī(?:mo|z[iu]))$/o
1114             && !/(?:$vcirc|$consonant)(?:$alteri)(?:ī(?:mo|z[iu]))$/o) {
1115             s/($alteri)(?=(?:ī(?:mo|z[iu]))$)/$alter{$1}/o;
1116             }
1117              
1118             # restore original root consonant before -u
1119             if(/([syc])(?:ū|u)$/
1120             && exists $rootchange{$1}{$verb})
1121             {
1122             s/([syc])(?=(?:ū|u)$)/$rootchange{$1}{$verb}/;
1123             }
1124             }
1125              
1126             return $table;
1127             },
1128             past => sub {
1129             # causative active perfect definite past
1130             my($verb) = @_;
1131             my $stem = $verb;
1132             my $table;
1133              
1134             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1135              
1136             # Delete the final vowel
1137             $stem =~ s/(?:[eai]|ê|â|î|û)$/eb/;
1138              
1139             if($stem =~ /$altere(?:eb)$/o
1140             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:eb)$/o) {
1141             $stem =~ s/($altere)(?=eb$)/$alter{$1}/o;
1142             }
1143              
1144             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1145              
1146             return $table;
1147             },
1148             'past anterior' => sub {
1149             # causative active perfect definite past anterior
1150             my($verb) = @_;
1151             my $stem = $verb;
1152             my $table;
1153              
1154             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1155              
1156             # Delete the final vowel
1157             $stem =~ s/(?:[eai]|ê|â|î|û)$/er/;
1158              
1159             if($stem =~ /$altere(?:er)$/o
1160             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:er)$/o) {
1161             $stem =~ s/($altere)(?=er$)/$alter{$1}/o;
1162             }
1163              
1164             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1165              
1166             return $table;
1167             },
1168             future => sub {
1169             # causative active perfect definite future
1170             my($verb) = @_;
1171             my $stem = $verb;
1172             my $table;
1173              
1174             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1175              
1176             # Delete the final vowel
1177             $stem =~ s/(?:[eai]|ê|â|î|û)$/al/;
1178              
1179             if($stem =~ /([syc])(?:al)$/
1180             && exists $rootchange{$1}{$verb})
1181             {
1182             $stem =~ s/([syc])(?=(?:al)$)/$rootchange{$1}{$verb}/;
1183             }
1184              
1185             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1186              
1187             return $table;
1188             },
1189             },
1190             remote => {
1191             present => sub {
1192             # causative active perfect remote present
1193             my($verb) = @_;
1194             my $stem = $verb;
1195             my $table;
1196              
1197             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1198              
1199             # Delete the final vowel
1200             $stem =~ s/(?:[eai]|ê|â|î|û)$/et/;
1201              
1202             if($stem =~ /$altere(?:et)$/o
1203             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:et)$/o) {
1204             $stem =~ s/($altere)(?=et$)/$alter{$1}/o;
1205             }
1206              
1207             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1208              
1209             return $table;
1210             },
1211             past => sub {
1212             # causative active perfect remote past
1213             my($verb) = @_;
1214             my $stem = $verb;
1215             my $table;
1216              
1217             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1218              
1219             # Delete the final vowel
1220             $stem =~ s/(?:[eai]|ê|â|î|û)$/eseb/;
1221              
1222             if($stem =~ /$altere(?:eseb)$/o
1223             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:eseb)$/o) {
1224             $stem =~ s/($altere)(?=eseb$)/$alter{$1}/o;
1225             }
1226              
1227             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1228              
1229             return $table;
1230             },
1231             'past anterior' => sub {
1232             # causative active perfect remote past anterior
1233             my($verb) = @_;
1234             my $stem = $verb;
1235             my $table;
1236              
1237             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1238              
1239             # Delete the final vowel
1240             $stem =~ s/(?:[eai]|ê|â|î|û)$/eser/;
1241              
1242             if($stem =~ /$altere(?:eser)$/o
1243             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:eser)$/o) {
1244             $stem =~ s/($altere)(?=eser$)/$alter{$1}/o;
1245             }
1246              
1247             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1248              
1249             return $table;
1250             },
1251             future => sub {
1252             # causative active perfect remote future
1253             my($verb) = @_;
1254             my $stem = $verb;
1255             my $table;
1256              
1257             ($verb, $stem) = ('ezâ', 'ezâ') if $verb eq 'esc';
1258              
1259             # Delete the final vowel
1260             $stem =~ s/(?:[eai]|ê|â|î|û)$/etal/;
1261              
1262             if($stem =~ /$altere(?:etal)$/o
1263             && $stem !~ /(?:$vcirc|$consonant)(?:$altere)(?:etal)$/o) {
1264             $stem =~ s/($altere)(?=etal$)/$alter{$1}/o;
1265             }
1266              
1267             $table = [ map "$stem$_", qw( ū ū u īmo īzi īzu ) ];
1268              
1269             return $table;
1270             },
1271             },
1272             },
1273             imperfect => {
1274             definite => {
1275             present => \&causative_imperfect,
1276             past => \&causative_imperfect,
1277             'past anterior' => \&causative_imperfect,
1278             future => \&causative_imperfect,
1279             },
1280             remote => {
1281             present => \&causative_imperfect,
1282             past => \&causative_imperfect,
1283             'past anterior' => \&causative_imperfect,
1284             future => \&causative_imperfect,
1285             },
1286             },
1287             },
1288             passive => {
1289             perfect => {
1290             definite => {
1291             present => \&causative_passive_perfect,
1292             past => \&causative_passive_perfect,
1293             'past anterior' => \&causative_passive_perfect,
1294             future => \&causative_passive_perfect,
1295             },
1296             remote => {
1297             present => \&causative_passive_perfect,
1298             past => \&causative_passive_perfect,
1299             'past anterior' => \&causative_passive_perfect,
1300             future => \&causative_passive_perfect,
1301             },
1302             },
1303             imperfect => {
1304             definite => {
1305             present => \&causative_imperfect,
1306             past => \&causative_imperfect,
1307             'past anterior' => \&causative_imperfect,
1308             future => \&causative_imperfect,
1309             },
1310             remote => {
1311             present => \&causative_imperfect,
1312             past => \&causative_imperfect,
1313             'past anterior' => \&causative_imperfect,
1314             future => \&causative_imperfect,
1315             },
1316             },
1317             },
1318             },
1319             inceptive => {
1320             active => {
1321             perfect => {
1322             definite => {
1323             present => \&inceptive,
1324             past => \&inceptive,
1325             'past anterior' => \&inceptive,
1326             future => \&inceptive,
1327             },
1328             remote => {
1329             present => \&inceptive,
1330             past => \&inceptive,
1331             'past anterior' => \&inceptive,
1332             future => \&inceptive,
1333             },
1334             },
1335             imperfect => {
1336             definite => {
1337             present => \&inceptive,
1338             past => \&inceptive,
1339             'past anterior' => \&inceptive,
1340             future => \&inceptive,
1341             },
1342             remote => {
1343             present => \&inceptive,
1344             past => \&inceptive,
1345             'past anterior' => \&inceptive,
1346             future => \&inceptive,
1347             },
1348             },
1349             },
1350             passive => {
1351             perfect => {
1352             definite => {
1353             present => \&inceptive,
1354             past => \&inceptive,
1355             'past anterior' => \&inceptive,
1356             future => \&inceptive,
1357             },
1358             remote => {
1359             present => \&inceptive,
1360             past => \&inceptive,
1361             'past anterior' => \&inceptive,
1362             future => \&inceptive,
1363             },
1364             },
1365             imperfect => {
1366             definite => {
1367             present => \&inceptive,
1368             past => \&inceptive,
1369             'past anterior' => \&inceptive,
1370             future => \&inceptive,
1371             },
1372             remote => {
1373             present => \&inceptive,
1374             past => \&inceptive,
1375             'past anterior' => \&inceptive,
1376             future => \&inceptive,
1377             },
1378             },
1379             },
1380             },
1381             );
1382              
1383              
1384             sub imperfect {
1385             # normal active imperfect
1386 0     0 0 0 my($verb, $conj, $info) = @_;
1387 0         0 my $orig = $verb;
1388 0         0 my $table;
1389              
1390 0 0       0 if($verb eq 'esc'
1391             # && $info->{type} eq 'normal'
1392             # && $info->{voice} eq 'active'
1393             # && $info->{mood} eq 'definite'
1394             ) {
1395             # if($info->{tense} eq 'present') {
1396             # return [ qw( fuāi fuēi fuē fuāmo fuāzu fuota ) ];
1397             # } elsif($info->{tense} eq 'past') {
1398             # # īmo īzi are misconversions, according to Mark
1399             # return [ qw( fuio fuio fuā fuōmo fuōzi fuītu ) ];
1400             # }
1401 0         0 ($conj, $verb) = (2, 'fuâ');
1402             }
1403              
1404             # form the normal active perfect tense
1405 0         0 $table = $verb{$info->{type}}
1406             -> {$info->{voice}}
1407             -> {perfect}
1408             -> {$info->{mood}}
1409             -> {$info->{tense}}
1410             -> ($verb, $conj, { %$info, aspect => 'perfect' });
1411              
1412 0 0       0 return unless defined $table;
1413              
1414             # imperfect of 'esc' looks like the perfect of 'fuâ'
1415             # so don't make any changes from here on
1416 0 0       0 return $table if $orig eq 'esc';
1417              
1418             # change -mo to -bo in I.pl., except for present and
1419             # past definite
1420 0 0 0     0 $table->[3] =~ s/mo$/bo/
      0        
1421             unless $info->{mood} eq 'definite'
1422             && ( $info->{tense} eq 'present'
1423             || $info->{tense} eq 'past');
1424              
1425             # add a final -r -r -re -r -r -r
1426 0         0 for(@$table) {
1427 0         0 $_ .= 'r';
1428             }
1429 0         0 $table->[2] .= 'e';
1430              
1431 0         0 return $table;
1432             };
1433              
1434             sub passive_imperfect {
1435             # normal passive imperfect
1436 0     0 0 0 my($verb, $conj, $info) = @_;
1437 0         0 my $table;
1438              
1439 0 0       0 return if $verb eq 'esc';
1440              
1441             # form the normal passive perfect tense
1442 0         0 $table = $verb{$info->{type}}
1443             -> {$info->{voice}}
1444             -> {perfect}
1445             -> {$info->{mood}}
1446             -> {$info->{tense}}
1447             -> ($verb, $conj, { %$info, aspect => 'perfect' });
1448              
1449 0 0       0 return unless defined $table;
1450              
1451             # Change the final -l to -r
1452 0         0 for(@$table) {
1453 0         0 s/l$/r/;
1454             }
1455             # Should III.sg. end in -r or -re?
1456             # $table->[2] .= 'e';
1457             # Mark says it shouldn't.
1458              
1459 0         0 return $table;
1460             };
1461              
1462             sub causative_imperfect {
1463             # causative (active or passive) imperfect
1464 0     0 0 0 my($verb, $conj, $info) = @_;
1465 0         0 my $table;
1466              
1467             # form the causative perfect tense
1468 0         0 $table = $verb{$info->{type}}
1469             -> {$info->{voice}}
1470             -> {perfect}
1471             -> {$info->{mood}}
1472             -> {$info->{tense}}
1473             -> ($verb, $conj, { %$info, aspect => 'perfect' });
1474              
1475 0 0       0 return unless defined $table;
1476              
1477             # Add final -r/-re (for active) or change final -l to -r (for passive)
1478 0 0       0 if($info->{voice} eq 'active') {
    0          
1479 0         0 for(@$table) {
1480 0         0 $_ .= 'r';
1481             }
1482 0         0 $table->[2] .= 'e';
1483             } elsif($info->{voice} eq 'passive') {
1484 0         0 for(@$table) {
1485 0         0 s/l$/r/;
1486             }
1487             } else {
1488 0         0 return;
1489             }
1490              
1491 0         0 return $table;
1492             };
1493              
1494             sub causative_passive_perfect {
1495             # causative passive perfect
1496 0     0 0 0 my($verb, $conj, $info) = @_;
1497 0         0 my $table;
1498              
1499 0 0       0 return if $verb eq 'esc';
1500              
1501             # form the causative active perfect tense
1502 0         0 $table = $verb{$info->{type}}
1503             -> {active}
1504             -> {$info->{aspect}}
1505             -> {$info->{mood}}
1506             -> {$info->{tense}}
1507             -> ($verb, $conj, { %$info, voice => 'active' });
1508              
1509 0 0       0 return unless defined $table;
1510              
1511             # Replace an initial vowel with o-, or add an o-
1512             # Suffix an -l
1513 0         0 for(@$table) {
1514 0 0       0 s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || s/^/o/;
1515 0         0 s/$/l/;
1516              
1517             # Passive root of xuêsi is oxês- not oxuês-
1518 0 0       0 s/xuês/xês/ if $verb eq 'xuêsi';
1519             }
1520              
1521 0         0 return $table;
1522             }
1523              
1524             sub inceptive {
1525             # inceptive (active or passive) (perfect or imperfect)
1526 0     0 0 0 my($verb, $conj, $info) = @_;
1527 0         0 my $table;
1528              
1529 0 0       0 if($verb eq 'esc') {
1530             # form the normal tense
1531 0         0 $table = $verb{normal}
1532             -> {$info->{voice}}
1533             -> {$info->{aspect}}
1534             -> {$info->{mood}}
1535             -> {$info->{tense}}
1536             -> ($verb, $conj, { %$info, type => 'normal' });
1537              
1538             # and add 'ba'
1539 0         0 for(@$table) {
1540 0         0 s/^/ba/;
1541             }
1542              
1543 0         0 return $table;
1544             }
1545              
1546 0 0       0 if($info->{aspect} eq 'perfect') {
    0          
1547             # Add 'ba' or change 'o-' to 'oba-'
1548 0 0 0     0 if($verb eq 'ogonî' ||
      0        
1549             $verb eq 'omî' ||
1550             $verb eq 'onî') {
1551 0         0 substr($verb, 1, 0) = 'ba';
1552             } else {
1553 0         0 substr($verb, 0, 0) = 'ba';
1554             }
1555              
1556             # form the normal tense
1557 0         0 $table = $verb{normal}
1558             -> {$info->{voice}}
1559             -> {$info->{aspect}}
1560             -> {$info->{mood}}
1561             -> {$info->{tense}}
1562             -> ($verb, $conj, { %$info, type => 'normal' });
1563             } elsif($info->{aspect} eq 'imperfect') {
1564             # form the perfect form
1565             # (this will result in a recursive call to this function)
1566 0         0 $table = $verb{$info->{type}}
1567             -> {$info->{voice}}
1568             -> {perfect}
1569             -> {$info->{mood}}
1570             -> {$info->{tense}}
1571             -> ($verb, $conj, { %$info, aspect => 'perfect' });
1572             } else {
1573 0         0 return;
1574             }
1575              
1576 0 0       0 return unless defined $table;
1577              
1578 0 0       0 if($info->{aspect} eq 'perfect') {
    0          
1579             # Remove final vowel if there are two
1580             # (only active; perfect passive is exactly the same as normal)
1581 0 0       0 if($info->{voice} eq 'active') {
1582 0         0 for(@$table) {
1583 0         0 s/([aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)$/$1/;
1584             }
1585             }
1586             } elsif($info->{aspect} eq 'imperfect') {
1587             # Add final -r/-re (for active) or change final -l to -r (for passive)
1588 0 0       0 if($info->{voice} eq 'active') {
    0          
1589 0         0 for(@$table) {
1590 0         0 $_ .= 'r';
1591             }
1592 0         0 $table->[2] .= 'e';
1593             } elsif($info->{voice} eq 'passive') {
1594 0         0 for(@$table) {
1595 0         0 s/l$/r/;
1596             }
1597             } else {
1598 0         0 return;
1599             }
1600             } else {
1601 0         0 return;
1602             }
1603              
1604 0         0 return $table;
1605             };
1606              
1607              
1608             sub inf {
1609 0     0 1 0 my $verb = shift;
1610 0         0 my($active, $passive, $causative, $inceptive, $incpass);
1611              
1612             # active infinitive is simply the base form,
1613             # except for passive-only and causative-only verbs
1614 0 0 0     0 $active = $verb unless $verb eq 'ogonî'
      0        
      0        
1615             || $verb eq 'omî'
1616             || $verb eq 'onî'
1617             || $verb eq 'ēxlûrtû'
1618             ;
1619              
1620             # passive infinitive is o- + root + -i (with long vowel) or -î (otherwise)
1621             # except for causative-only verbs
1622 0 0       0 if($verb ne 'ēxlûrtû') {
1623 0         0 for($passive = $verb) {
1624 0 0       0 s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || s/^/o/;
1625 0         0 s/(?:[eai]|ê|â)$/î/;
1626 0 0       0 s/î$/i/ if /(?:ā|ē|ī|ō|ū)/;
1627              
1628 0 0 0     0 s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1629             }
1630             }
1631              
1632             # causative infinitive is -û or -u, except esc --> ezû
1633 0 0       0 if($verb eq 'esc') {
    0          
1634 0         0 $causative = 'ezû';
1635             } elsif($verb eq 'ēxlûrtû') {
1636 0         0 $causative = $verb;
1637             } else {
1638 0         0 for($causative = $verb) {
1639 0         0 s/(?:[eai]|ê|â)$/û/;
1640 0 0       0 s/û$/u/ if /(?:ā|ē|ī|ō|ū)/;
1641             }
1642             }
1643              
1644             # inceptive active infinitive is ba- + normal infinitive,
1645             # except for passive-only and causative-only verbs, which have none
1646 0 0 0     0 if($verb ne 'ēxlûrtû'
      0        
      0        
1647             && $verb ne 'ogonî'
1648             && $verb ne 'omî'
1649             && $verb ne 'onî'
1650             ) {
1651 0         0 for($inceptive = $verb) {
1652 0         0 s/^/ba/;
1653             }
1654             }
1655              
1656             # inceptive passive infinitive is oba- + normal infinitive + i^/i,
1657             # except for passive-only (oba-) and causative-only (none) verbs
1658 0 0       0 if($verb ne 'ēxlûrtû') {
1659 0         0 for($incpass = $verb) {
1660 0 0 0     0 s/^ogonî$/obagonî/ ||
      0        
1661             s/^omî$/obamî/ ||
1662             s/^onî$/obanî/ ||
1663             s/^/oba/;
1664 0         0 s/(?:[eai]|ê|â)$/î/;
1665 0 0       0 s/î$/i/ if /(?:ā|ē|ī|ō|ū)/;
1666              
1667 0 0 0     0 s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1668             }
1669             }
1670              
1671 0 0       0 return wantarray ? ($active, $passive, $causative, $inceptive, $incpass)
1672             : {
1673             active => $active,
1674             passive => $passive,
1675             causative => $causative,
1676             inceptive => $inceptive,
1677             incpass => $incpass,
1678             };
1679             }
1680              
1681              
1682             sub part {
1683 0     0 1 0 my $verb = shift;
1684              
1685 0         0 my($active, $passive, $agent, $causative) = ($verb) x 4;
1686              
1687             # esc forms its participles from the root ez-,
1688             # and it's nominally 2nd declension in -â.
1689 0 0       0 ($active, $passive, $agent, $causative) = ('ezâ') x 4 if $verb eq 'esc';
1690              
1691 0 0 0     0 if($verb eq 'ogonî' ||
      0        
      0        
1692             $verb eq 'omî' ||
1693             $verb eq 'onî' ||
1694             $verb eq 'ēxlûrtû'
1695             ) {
1696 0         0 $active = undef;
1697             } else {
1698             # active is e- + root + -eto
1699             # e- changes to am- before b
1700             # ee- and eê- both go to ē-
1701 0         0 for($active) {
1702 0 0 0     0 s/^b/amb/ || s/^e/ē/ || s/^ê/ē/ || s/^/e/;
      0        
1703 0         0 s/(?:[eai]|ê|â)$/eto/;
1704 0 0 0     0 if(/$altere(?:eto)$/o
1705             && !/(?:$vcirc|$consonant)(?:$altere)(?:eto)$/o) {
1706 0         0 s/($altere)(?=(?:eto)$)/$alter{$1}/o;
1707             }
1708             }
1709             }
1710              
1711             # passive is o- + root + -elo
1712             # The o- replaces any initial vowel
1713             # o- changes to om- before b
1714 0 0 0     0 if($verb eq 'ēxlûrtû' ||
1715             $verb eq 'esc') {
1716 0         0 $passive = undef;
1717             } else {
1718 0         0 for($passive) {
1719 0 0       0 s/^(?:[aeiou]|ā|ē|ī|ō|ū|â|ê|î|ô|û)/o/ || s/^/o/;
1720 0         0 s/^ob/omb/;
1721 0         0 s/(?:[eai]|ê|â|î)$/elo/;
1722 0 0 0     0 if(/$altere(?:elo)$/o
1723             && !/(?:$vcirc|$consonant)(?:$altere)(?:elo)$/o) {
1724 0         0 s/($altere)(?=(?:elo)$)/$alter{$1}/o;
1725             }
1726              
1727 0 0 0     0 s/xuês/xês/ if $verb eq 'xuêsi' || $verb eq 'baxuêsi';
1728             }
1729             }
1730              
1731 0 0 0     0 if($verb eq 'ogonî' ||
      0        
      0        
1732             $verb eq 'omî' ||
1733             $verb eq 'onî' ||
1734             $verb eq 'ēxlûrtû'
1735             ) {
1736 0         0 $agent = undef;
1737             } else {
1738             # agent is e- + root + -as/-ei
1739             # e- changes to am- before b
1740             # ee- and eê- both go to ē-
1741 0         0 for($agent) {
1742 0 0 0     0 s/^b/amb/ || s/^e/ē/ || s/^ê/ē/ || s/^/e/;
      0        
1743 0         0 s/(?:[eai]|ê|â)$//;
1744             }
1745             # TODO - keep track of root alternations
1746             # e.g. pīsi --> epī*t*as, epīsei
1747 0         0 $agent = [ $agent . 'as', $agent . 'ei' ];
1748              
1749 0 0 0     0 if($agent->[0] =~ /([syc])(?:as)$/
1750             && exists $rootchange{$1}{$verb})
1751             {
1752 0         0 $agent->[0] =~ s/([syc])(?=(?:as)$)/$rootchange{$1}{$verb}/;
1753             }
1754              
1755 0 0 0     0 if($agent->[1] =~ /$altere(?:ei)$/o
1756             && $agent->[1] !~ /(?:$vcirc|$consonant)(?:$altere)(?:ei)$/o) {
1757 0         0 $agent->[1] =~ s/($altere)(?=(?:ei)$)/$alter{$1}/o;
1758             }
1759             }
1760              
1761 0 0 0     0 if($verb eq 'ogonî' ||
      0        
1762             $verb eq 'omî' ||
1763             $verb eq 'onî'
1764             ) {
1765 0         0 $causative = undef;
1766             } else {
1767             # causative is e- + root + -ūzo
1768             # e- changes to am- before b
1769             # ee- and eê- both go to ē-
1770 0         0 for($causative) {
1771 0 0 0     0 s/^b/amb/ || s/^e/ē/ || s/^ê/ē/ || s/^ē/ē/ || s/^/e/;
      0        
      0        
1772 0         0 s/(?:[eai]|ê|â|û)$/ūzo/;
1773 0 0 0     0 if(/([syc])(?:ūzo)$/
1774             && exists $rootchange{$1}{$verb})
1775             {
1776 0         0 s/([syc])(?=(?:ūzo)$)/$rootchange{$1}{$verb}/;
1777             }
1778             }
1779             }
1780              
1781 0 0       0 return wantarray ? ( $active, $passive, $agent, $causative )
1782             : [ $active, $passive, $agent, $causative ];
1783             }
1784              
1785              
1786              
1787             my %masc = (
1788             'beire' => 1,
1789             'ferêde' => 1,
1790             'geōre' => 1, # geīre in the lexicon, but it's a misconversion according to Mark
1791             'lūvore' => 1,
1792             'nōre' => 1, # nīre in the morphology, but it's a misconversion according to Mark
1793             'Inibē' => 1,
1794             'sāclore' => 1,
1795             'sārene' => 1,
1796             'sāule' => 1,
1797             'suale' => 1,
1798             'tīble' => 1,
1799             'yine' => 1,
1800             );
1801              
1802             my %neut = (
1803             );
1804              
1805             my %aetas = (
1806             'āetas' => 1,
1807             'creidas' => 1,
1808             'crindas' => 1,
1809             'dēnedas' => 1,
1810             'mavordas' => 1,
1811             'motas' => 1,
1812             'sambas' => 1,
1813             'sindas' => 1,
1814             'sonurdas' => 1,
1815             'Sūās' => 1,
1816             'tōuresambas' => 1,
1817             'ulidas' => 1,
1818             );
1819              
1820             # t -> s, c -> s, g -> y before -e and -i; x -> c before -i
1821             my %changenoun = (
1822             'āeca' => 1,
1823             'āetas' => 1,
1824             'ambecā' => 1,
1825             'bāxe' => 1,
1826             'brexos' => 1,
1827             'erēineca' => 1,
1828             'fūca' => 1,
1829             'gāex' => 1,
1830             'lācato' => 1, # actually an adjective
1831             'rūtas' => 1,
1832             'sīxe' => 1,
1833             'tauca' => 1,
1834             'usūta' => 1,
1835             'xuecos' => 1,
1836             );
1837              
1838             my %noun = (
1839             # personal pronouns
1840             'sēo' => [ qw( sēo soex etu sēnu sētu sēco ), (undef) x @cases ],
1841             'sēi' => [ qw( sēi soē etu sēnu sēdi sēlu ), (undef) x @cases ],
1842             'led' => [ qw( led loex ēr linu letu leco ), (undef) x @cases ],
1843             'lei' => [ qw( lei loē ēr linu ledi lelu ), (undef) x @cases ],
1844             'tāu' => [ qw( tāu tāuex tāua tāunu tāutu tāuco ), (undef) x @cases ],
1845             'tāi' => [ qw( tāi tāyē tāya tāinu tāidi tāilu ), (undef) x @cases ],
1846             'tazū' => [ qw( tazū tazuē tāe tānu tātu tāco ), (undef) x @cases ],
1847             'letazū' => [ qw( letazū lotazuē ertāe litānu letātu letāco ), (undef) x @cases ],
1848             'māux' => [ qw( māux muē mū mūna mūta mūco ), (undef) x @cases ],
1849             'cayū' => [ qw( cayū cayuē caē caēnu caētu caēco ), (undef) x @cases ],
1850             'rāe' => [ qw( rāe rāex rā rāenu rāetu rāeco
1851             radē radaē rade radanu radatu radaco ), ],
1852              
1853             # tīble has sg.acc. tībal instead of *tībl,
1854             # and an epenthetic vowel in singular dat. abl. ins.
1855             'tīble' => [ qw( tīble tīblex tībal tīblanu tīblatu tīblaco
1856             tībli tībliē tīblī tīblinu tīblitu tīblico ) ],
1857             );
1858              
1859             sub noun {
1860 9     9 1 32 my $noun = shift;
1861 9         14 my $stem = $noun;
1862 9         14 my $type = 'fem';
1863 9         11 my $table;
1864              
1865 9 50 33     65 $type = 'masc' if exists $masc{$noun} || exists $aetas{$noun};
1866 9 50       24 $type = 'neut' if exists $neut{$noun};
1867              
1868 9 100       101 return $noun{$noun} if exists $noun{$noun};
1869              
1870             # masculine
1871 3 100 33     69 if($stem =~ m/[pbtdcgfvzxmnlr]$/) {
    50 33        
    50 33        
    50 33        
    50 33        
    50 0        
    50 0        
    50 0        
    50          
    50          
    100          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
1872 1         1 $type = 'masc';
1873 1         31 $table = [ map "$stem$_", '', 'ex', '', qw( nu tu co i iē i inu itu ico ) ];
1874             } elsif($type eq 'masc' && $stem =~ s/re$//) {
1875 0         0 $table = [ map "$stem$_", 're', 'rex','r', qw( rnu rtu rco i iē ī inu itu ico ) ];
1876             } elsif($type eq 'masc' && $stem =~ s/([nld])?e$/$1/) {
1877 0         0 $table = [ map "$stem$_", 'e', 'ex', '', qw( nu tu co i iē ī inu itu ico ) ];
1878             } elsif($type eq 'masc' && $stem =~ s/ē$//) {
1879 0         0 $table = [ map "$stem$_", qw( ē ēx e enu etu eco ei eiē eii einu eitu eico ) ];
1880             } elsif($stem =~ s/os$//) {
1881 0         0 $type = 'masc';
1882 0         0 $table = [ map "$stem$_", 'os', 'ex', '', qw( nu tu co i iē i inu itu ico ) ];
1883             } elsif(exists $aetas{$noun} && $stem =~ s/as$//) {
1884 0         0 $table = [ map "$stem$_", qw( as ex a anu atu aco āe aē āe ānu ātu āco ) ];
1885             } elsif(exists $aetas{$noun} && $stem =~ s/ās$//) {
1886 0         0 $table = [ map "$stem$_", qw( ās aex ā ānu ātu āco aāe āē aāe aānu aātu aāco ) ];
1887             } elsif($stem =~ s/as$//) {
1888 0         0 $type = 'masc';
1889 0         0 $table = [ map "$stem$_", 'as', 'ex', '', qw( nu tu co i iē i inu itu ico ) ];
1890             }
1891              
1892             # neuter
1893             elsif($stem =~ s/iu$//) {
1894 0         0 $type = 'neut';
1895 0         0 $table = [ map "$stem$_", qw( iu iex i inu itu ico iū uē ū ūna ūta ūco ) ];
1896             } elsif($stem =~ s/āu$//) {
1897 0         0 $type = 'neut';
1898 0         0 $table = [ map "$stem$_", qw( āu aex â anu ato aco ū uē ū ūna ūta ūco ) ];
1899             } elsif($stem =~ s/u$//) {
1900 1         2 $type = 'neut';
1901 1         10 $table = [ map "$stem$_", qw( u ex u nu tu uco ū uē ū ūna ūta ūco ) ];
1902             } elsif($stem =~ s/o$//) {
1903 0         0 $type = 'neut';
1904 0         0 $table = [ map "$stem$_", qw( o ex o onu otu oco ō oē ō ōna ōta ōco ) ];
1905             }
1906              
1907             # feminine
1908             elsif($stem =~ s/a$//) {
1909 1         2 $type = 'fem';
1910 1         13 $table = [ map "$stem$_", qw( a aē ā anu adi alu ē eē ē ēnu ēdi ēlu ) ];
1911             } elsif($stem =~ s/â$//) {
1912 0         0 $type = 'fem';
1913 0         0 $table = [ map "$stem$_", qw( â aē ā ânu âdi âlu ē eē ē ēnu ēdi ēlu ) ];
1914             } elsif($stem =~ s/ā$//) {
1915 0         0 $type = 'fem';
1916 0         0 $table = [ map "$stem$_", qw( ā aē ā ānu ādi ālu ē eē ē ēnu ēdi ēlu ) ];
1917             } elsif($type eq 'fem' && $stem =~ s/e$//) {
1918 0         0 $table = [ map "$stem$_", qw( e eē ê inu edi elu ē eē ē ēnu ēdi ēco ) ];
1919             } elsif($type eq 'fem' && $stem =~ s/ê$//) {
1920 0         0 $table = [ map "$stem$_", qw( ê eē ê inu êdi êlu ē eē ē ēnu ēdi ēco ) ];
1921             } elsif($type eq 'fem' && $stem =~ s/ē$//) {
1922 0         0 $table = [ map "$stem$_", qw( ē eē ē ēnu ēdi ēco ē eē ē ēnu ēdi ēco ) ];
1923             } elsif($stem =~ s/i$//) {
1924 0         0 $type = 'fem';
1925 0         0 $table = [ map "$stem$_", qw( i iē a inu idi iu ā aē ā ānu ādi ālu ) ];
1926             }
1927              
1928             else {
1929 0         0 return;
1930             }
1931              
1932 3 100       17 if($type eq 'masc') {
    100          
    50          
1933             # change root consonant before -ex sg.gen. and -i plural
1934             # except when preceded by another consonant or a long or circumflexed vowel
1935 1         2 for(@$table) {
1936 12 50 33     62 if(/$alteri(?:i(?:ē|i|[nt]u|co)?)$/o
1937             && !/(?:$vlong|$vcirc|$consonant)(?:$alteri)(?:i(?:ē|i|[nt]u|co)?)$/o) {
1938 0         0 s/($alteri)(?=i(?:ē|i|[nt]u|co)?$)/$alter{$1}/o;
1939             }
1940 12 50 33     41 if(/$altere(?:ex)$/o
1941             && !/(?:$vlong|$vcirc|$consonant)(?:$altere)(?:ex)$/o) {
1942 0         0 s/($altere)(?=ex$)/$alter{$1}/o;
1943             }
1944             }
1945              
1946             # change -vas to -f- in the singular except genitive
1947 1 50       5 if($noun =~ /vas$/) {
1948 0         0 for(@{$table}[2..5]) {
  0         0  
1949 0         0 s/v(?=(?:[nt]u|co)?$)/f/;
1950             }
1951             }
1952              
1953             # change -zos to -s-, ditto
1954 1 50       5 if($noun =~ /zos$/) {
1955 0         0 for(@{$table}[2..5]) {
  0         0  
1956 0         0 s/z(?=(?:[nt]u|co)?$)/s/;
1957             }
1958             }
1959              
1960             # assimilate voicing and place of articulation for -nu, -tu, -co forms
1961 1         2 for(@{$table}[3..5]) {
  1         3  
1962 3         25 s/($ustop)(?=$voiced)/$voiced{$1}/g;
1963 3         20 s/($vstop)(?=$unvoiced)/$unvoiced{$1}/g;
1964 3         20 s/n(?=$labial)/m/g;
1965 3         20 s/m(?=$dental)/n/g;
1966             }
1967             } elsif($type eq 'neut') {
1968             # change root consonant before -ex sg.gen. and -ī plural
1969             # except when preceded by another consonant or a long or circumflexed vowel
1970 1         3 for(@$table) {
1971 12 50 33     47 if(/$alteri(?:ī(?:[nt]a|co)?)$/o
1972             && !/(?:$vlong|$vcirc|$consonant)(?:$alteri)(?:ī(?:[nt]a|co)?)$/o) {
1973 0         0 s/($alteri)(?=ī(?:[nt]a|co)?$)/$alter{$1}/o;
1974             }
1975 12 50 33     40 if(/$altere(?:ex)$/o
1976             && !/(?:$vlong|$vcirc|$consonant)(?:$altere)(?:ex)$/o) {
1977 0         0 s/($altere)(?=ex$)/$alter{$1}/o;
1978             }
1979             }
1980              
1981             # change -Viu and -Viū to -Vyu and -Vyū in nom.sg. and nom.pl. of -iu nouns
1982             # also, change altered root consonants back in the plural gen..ins
1983 1 50       4 if($noun =~ /iu$/) {
1984 0         0 $table->[0] =~ s/($vowel)iu$/$1yu/;
1985 0         0 $table->[6] =~ s/($vowel)iū$/$1yū/;
1986              
1987 0         0 for(@{$table}[7..11]) {
  0         0  
1988 0 0 0     0 if(/($altered)(?:uē|ū(?:[nt]a|co)?)$/o && exists $rootchange{$1}{$noun}) {
1989 0         0 s/($altered)(?=(?:uē|ū(?:[nt]a|co)?)$)/$rootchange{$1}{$noun}/o;
1990             }
1991             }
1992             }
1993             } elsif($type eq 'fem') {
1994             # change root consonant before -e or -ē plurals of -a nouns
1995             # except when preceded by another consonant or a long or circumflexed vowel
1996 1 50       5 if($noun =~ /a$/) {
    0          
1997 1         2 for(@{$table}[6..11]) {
  1         4  
1998 6 50 33     54 if(/$altere(?:eē|ē(?:[nl]u|di)?)$/o
1999             && !/(?:$vlong|$vcirc|$consonant)(?:$altere)(?:eē|ē(?:[nl]u|di)?)$/o) {
2000 0         0 s/($altere)(?=(?:eē|ē(?:[nl]u|di)?)$)/$alter{$1}/o;
2001             }
2002             }
2003             }
2004              
2005             # change -Viē to -Vyē in sg.gen. of -i nouns
2006             # also, change altered root consonants back in the sg.acc. and plural
2007             elsif($noun =~ /i$/) {
2008 0         0 $table->[1] =~ s/($vowel)iē$/$1yē/;
2009              
2010 0         0 for(@{$table}[2,6..11]) {
  0         0  
2011 0 0 0     0 if(/($altered)(?:aē|ā(?:[nl]u|di)?)$/o && exists $rootchange{$1}{$noun}) {
2012 0         0 s/($altered)(?=(?:aē|ā(?:[nl]u|di)?)$)/$rootchange{$1}{$noun}/o;
2013             }
2014             }
2015             }
2016             }
2017              
2018 3         22 return $table;
2019             }
2020              
2021             my %root = (
2022             );
2023              
2024             sub root {
2025 0     0 1 0 my $noun = shift;
2026 0         0 my $stem = $noun;
2027 0         0 my $type = 'fem';
2028 0         0 my $table;
2029              
2030 0 0       0 $type = 'masc' if exists $masc{$noun};
2031 0 0       0 $type = 'neut' if exists $neut{$noun};
2032              
2033 0 0       0 return $root{$noun} if exists $root{$noun};
2034              
2035             # masculine
2036 0 0 0     0 if($stem =~ m/[pbtdcgfvzxmnlr]$/) {
    0 0        
    0 0        
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
2037 0         0 $table = $stem . 'i-';
2038             } elsif($type eq 'masc' && $stem =~ s/e$//) {
2039 0         0 $table = $stem . 'i-';
2040             } elsif($stem =~ s/os$//) {
2041 0         0 $table = $stem . 'i-';
2042             } elsif(exists $aetas{$noun} && $stem =~ s/as$//) {
2043 0         0 $table = $stem . 'a-';
2044             } elsif($stem =~ s/as$//) {
2045 0         0 $table = $stem . 'i-';
2046             }
2047              
2048             # neuter
2049             elsif($stem =~ s/iu$//) {
2050 0         0 $table = $stem . 'i-';
2051             } elsif($stem =~ s/u$//) {
2052 0         0 $table = $stem . 'u-';
2053             } elsif($stem =~ s/o$//) {
2054 0         0 $table = $stem . 'o-';
2055             } elsif($stem =~ s/āu$//) {
2056 0         0 $table = $stem . 'a-';
2057             }
2058              
2059             # feminine
2060             elsif($stem =~ s/a$// || $stem =~ s/â$// || $stem =~ s/ā$//) {
2061 0         0 $table = $stem . 'e-';
2062             } elsif($type eq 'fem' && $stem =~ s/e$//) {
2063 0         0 $table = $stem . 'i-';
2064             } elsif($stem =~ s/i$//) {
2065 0         0 $table = $stem . 'i-';
2066             }
2067              
2068             else {
2069 0         0 return;
2070             }
2071              
2072 0         0 for($table) {
2073             # change root consonant before -e and -i
2074             # except when preceded by another consonant or a circumflexed vowel
2075 0 0 0     0 if(/$alteri(?:i-)$/o
2076             && !/(?:$vcirc|$consonant)(?:$alteri)(?:i-)$/o) {
2077 0         0 s/($alteri)(?=(?:i-)$)/$alter{$1}/o;
2078             }
2079 0 0 0     0 if(/$altere(?:e-)$/o
2080             && !/(?:$vcirc|$consonant)(?:$altere)(?:e-)$/o) {
2081 0         0 s/($altere)(?=(?:e-)$)/$alter{$1}/o;
2082             }
2083              
2084             # restore original root consonant before -a -o -u
2085 0 0 0     0 if(/([syc])[aou]-$/
2086             && exists $rootchange{$1}{$noun})
2087             {
2088 0         0 s/([syc])[aou]-$/$rootchange{$1}{$noun}/;
2089             }
2090             }
2091              
2092 0         0 return $table;
2093             }
2094              
2095             my %adj = (
2096             );
2097              
2098             sub adj {
2099 1     1 1 10 my $adj = shift;
2100 1         3 my $stem = $adj;
2101 1         2 my $table;
2102              
2103 1 50       6 return $adj{$adj} if exists $adj{$adj};
2104              
2105 1 50       10 if($stem =~ s/o$//) {
    0          
    0          
    0          
2106 1         83 $table = [ [ map "$stem$_", qw( e ex e nu tu co i iē i inu itu ico ) ],
2107             [ map "$stem$_", qw( o ex o onu otu oco ō oē ō ōna ōta ōco ) ],
2108             [ map "$stem$_", qw( a aē a anu adi alu ē eē ē ēnu ēdi ēlu ) ], ];
2109             } elsif($stem =~ s/e$//) {
2110 0         0 $table = [ [ map "$stem$_", qw( e ex e nu tu co i iē i inu itu ico ) ],
2111             [ map "$stem$_", qw( e ex e inu etu eco ēi eē ēi ēinu ēitu ēico ) ],
2112             [ map "$stem$_", qw( e eē e inu edi elu ē eē ē ēnu ēdi ēlu ) ], ];
2113             } elsif($stem =~ s/ê$//) {
2114 0         0 $table = [ [ map "$stem$_", qw( ê ex ê nu tu co i iē i inu itu ico ) ],
2115             [ map "$stem$_", qw( ê ex ê inu êtu êco ēi eē ēi ēinu ēitu ēico ) ],
2116             [ map "$stem$_", qw( ê eē ê inu êdi êlu ē eē ē ēnu ēdi ēlu ) ], ];
2117             } elsif($stem =~ s/i$//) {
2118 0         0 $table = [ [ map "$stem$_", qw( i iex i inu itu ico ū uē ū ūna ūta ūco ) ],
2119             [ map "$stem$_", qw( i iex i inu itu ico ū uē ū ūna ūta ūco ) ],
2120             [ map "$stem$_", qw( i iē i inu idi iu ā aē ā ānu ādi ālu ) ], ];
2121             } else {
2122 0         0 return;
2123             }
2124              
2125             # TODO - add root changes e.g. -si --> -c- in the plural
2126              
2127 1         46 return $table;
2128             }
2129              
2130              
2131             my %comp = (
2132             );
2133              
2134             sub comp {
2135 9     9 1 27 my $adj = shift;
2136 9         13 my $stem = $adj;
2137 9         11 my $word;
2138              
2139 9 50       24 return $comp{$adj} if exists $comp{$adj};
2140              
2141 9 100       225 if($stem =~ s/o$//) {
    100          
    50          
2142 3 100       20 if($stem =~ /$vlong/o) {
2143 2         29 $word = $stem . 'ate';
2144             } else {
2145 1         3 $word = $stem . 'âte';
2146             }
2147             } elsif($stem =~ s/e$//) {
2148 3 100       200 if($stem =~ /$vlong/o) {
2149 2         5 $word = $stem . 'ase';
2150             } else {
2151 1         2 $word = $stem . 'âse';
2152             }
2153             } elsif($stem =~ s/i$//) {
2154 3 100       14 if($stem =~ /$vlong/o) {
2155 1         2 $word = $stem . 'ise';
2156             } else {
2157 2         4 $word = $stem . 'îse';
2158             }
2159             } else {
2160 0         0 return;
2161             }
2162              
2163 9         1679 return $word;
2164             }
2165              
2166              
2167             my %comb = (
2168             );
2169              
2170             sub comb {
2171 0     0 1   my $adj = shift;
2172 0           my $stem = $adj;
2173              
2174 0 0         return $comb{$adj} if exists $comb{$adj};
2175              
2176 0 0         if($stem =~ m/o$/) {
    0          
    0          
2177 0           return $stem;
2178             } elsif($stem =~ s/e$//) {
2179 0           return $stem . 'i';
2180             } elsif($stem =~ m/i$/) {
2181 0           return $stem;
2182             } else {
2183 0           return;
2184             }
2185             }
2186              
2187              
2188             my %long = (
2189             'a' => 'ā',
2190             'e' => 'ē',
2191             'i' => 'ī',
2192             'o' => 'ō',
2193             'u' => 'ū',
2194             'A' => 'Ā',
2195             'E' => 'Ē',
2196             'I' => 'Ī',
2197             'O' => 'Ō',
2198             'U' => 'Ū',
2199             );
2200              
2201             sub assimilate {
2202 0 0   0 0   return unless ref $_[0];
2203             # Apply sound changes
2204 0           for(@{$_[0]}) {
  0            
2205             # 1. A stop assimilates to a following consonant in voicing
2206 0           s/($ustop)(?=$voiced)/$voiced{$1}/g;
2207 0           s/($vstop)(?=$unvoiced)/$unvoiced{$1}/g;
2208              
2209             # 2. n before m, b, p, l --> m; m before t, d, c, g, x --> n
2210 0           s/n(?=$labial)/m/g;
2211 0           s/m(?=$dental)/n/g;
2212              
2213             # 3. aa --> ā, etc:
2214 0           s/($vowel)\1/$long{$vowel}/g;
2215              
2216             # 4. y before a consonant becomes i;
2217             # i between two other vowels becomes y
2218 0           s/y(?=$consonant)/i/g;
2219 0           s/($vowel)i(?=$vowel)/$1y/g;
2220             }
2221             }
2222              
2223              
2224             1;
2225             __END__