1with STRINGS_PACKAGE; use STRINGS_PACKAGE;
2with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
3pragma ELABORATE(INFLECTIONS_PACKAGE);
4package body DICTIONARY_PACKAGE is
5  use STEM_KEY_TYPE_IO;
6  use TEXT_IO;
7
8  MNPC_IO_DEFAULT_WIDTH : constant NATURAL := 6;
9  NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH : constant NATURAL := 5;
10  KIND_ENTRY_IO_DEFAULT_WIDTH : constant NATURAL := VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
11  --PART_WIDTH : NATURAL;
12
13
14  function NUMBER_OF_STEMS(P : PART_OF_SPEECH_TYPE) return STEM_KEY_TYPE is
15  begin
16    case P is
17      when N       => return 2;
18      when PRON    => return 2;
19      when PACK    => return 2;
20      when ADJ     => return 4;
21      when NUM     => return 4;
22      when ADV     => return 3;
23      when V       => return 4;
24      when VPAR    => return 0;
25      when SUPINE  => return 0;
26      when PREP    => return 1;
27      when CONJ    => return 1;
28      when INTERJ  => return 1;
29      when others  => return 0;
30    end case;
31  end NUMBER_OF_STEMS;
32
33
34
35  package body PARSE_RECORD_IO is
36    use TEXT_IO;
37    use INFLECTION_RECORD_IO;
38    use DICTIONARY_KIND_IO;
39    use MNPC_IO;
40    SPACER : CHARACTER := ' ';
41
42    procedure GET(F : in TEXT_IO.FILE_TYPE; PR: out PARSE_RECORD) is
43    begin
44      GET(F, PR.STEM);
45      GET(F, SPACER);
46      GET(F, PR.IR);
47      GET(F, SPACER);
48      GET(F, PR.D_K);
49      GET(F, SPACER);
50      GET(F, PR.MNPC);
51    end GET;
52
53    procedure GET(PR : out PARSE_RECORD) is
54    begin
55      GET(PR.STEM);
56      GET(SPACER);
57      GET(PR.IR);
58      GET(SPACER);
59      GET(PR.D_K);
60      GET(SPACER);
61      GET(PR.MNPC);
62    end GET;
63
64    procedure PUT(F : in TEXT_IO.FILE_TYPE; PR : in PARSE_RECORD) is
65    begin
66      PUT(F, PR.STEM);
67      PUT(F, ' ');
68      PUT(F, PR.IR);
69      PUT(F, ' ');
70      PUT(F, PR.D_K);
71      PUT(F, ' ');
72      PUT(F, PR.MNPC);
73    end PUT;
74
75    procedure PUT(PR : in PARSE_RECORD) is
76    begin
77      TEXT_IO.PUT(PR.STEM);
78      TEXT_IO.PUT(' ');
79      INFLECTION_RECORD_IO.PUT(PR.IR);
80      TEXT_IO.PUT(' ');
81      DICTIONARY_KIND_IO.PUT(PR.D_K);
82      TEXT_IO.PUT(' ');
83      MNPC_IO.PUT(PR.MNPC);
84    end PUT;
85
86    procedure GET(S : in STRING; PR : out PARSE_RECORD; LAST : out INTEGER) is
87      L : INTEGER := S'FIRST - 1;
88    begin
89      STEM_TYPE_IO.GET(S, PR.STEM, L);
90      L := L + 1;
91      GET(S(L+1..S'LAST), PR.IR, L);
92      L := L + 1;
93      GET(S(L+1..S'LAST), PR.D_K, L);
94      L := L + 1;
95      GET(S(L+1..S'LAST), PR.MNPC, LAST);
96    end GET;
97
98    procedure PUT(S : out STRING; PR : in PARSE_RECORD) is
99      L : INTEGER := 0;
100      M : INTEGER := 0;
101    begin
102      M := L + MAX_STEM_SIZE;
103      S(L+1..M) := PR.STEM;
104      L := M + 1;
105      S(L) :=  ' ';
106      M := L + INFLECTION_RECORD_IO.DEFAULT_WIDTH;
107      PUT(S(L+1..M), PR.IR);
108      L := M + 1;
109      S(L) :=  ' ';
110      M := L + DICTIONARY_KIND_IO.DEFAULT_WIDTH;
111      PUT(S(L+1..M), PR.D_K);
112      L := M + 1;
113      S(L) :=  ' ';
114      M := L + MNPC_IO_DEFAULT_WIDTH;
115      PUT(S(L+1..M), PR.MNPC);
116      S(M+1..S'LAST) := (others => ' ');
117    end PUT;
118
119  end PARSE_RECORD_IO;
120
121package body NOUN_ENTRY_IO is
122  use DECN_RECORD_IO;
123  use GENDER_TYPE_IO;
124  use NOUN_KIND_TYPE_IO;
125  SPACER : CHARACTER := ' ';
126
127
128  procedure GET(F : in FILE_TYPE; N : out NOUN_ENTRY) is
129  begin
130    GET(F, N.DECL);
131    GET(F, SPACER);
132    GET(F, N.GENDER);
133    GET(F, SPACER);
134    GET(F, N.KIND);
135  end GET;
136
137  procedure GET(N : out NOUN_ENTRY) is
138  begin
139    GET(N.DECL);
140    GET(SPACER);
141    GET(N.GENDER);
142    GET(SPACER);
143    GET(N.KIND);
144  end GET;
145
146  procedure PUT(F : in FILE_TYPE; N : in NOUN_ENTRY) is
147  begin
148    PUT(F, N.DECL);
149    PUT(F, ' ');
150    PUT(F, N.GENDER);
151    PUT(F, ' ');
152    PUT(F, N.KIND);
153  end PUT;
154
155  procedure PUT(N : in NOUN_ENTRY) is
156  begin
157    PUT(N.DECL);
158    PUT(' ');
159    PUT(N.GENDER);
160    PUT(' ');
161    PUT(N.KIND);
162  end PUT;
163
164  procedure GET(S : in STRING; N : out NOUN_ENTRY; LAST : out INTEGER) is
165    L : INTEGER := S'FIRST - 1;
166  begin
167    GET(S(L+1..S'LAST), N.DECL, L);
168    L := L + 1;
169    GET(S(L+1..S'LAST), N.GENDER, L);
170    L := L + 1;
171    GET(S(L+1..S'LAST), N.KIND, LAST);
172  end GET;
173
174  procedure PUT(S : out STRING; N : in NOUN_ENTRY) is
175    L : INTEGER := S'FIRST - 1;
176    M : INTEGER := 0;
177  begin
178    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
179    PUT(S(L+1..M), N.DECL);
180    L := M + 1;
181    S(L) :=  ' ';
182    M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
183    PUT(S(L+1..M), N.GENDER);
184    L := M + 1;
185    S(L) :=  ' ';
186    M := L + NOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
187    PUT(S(L+1..M), N.KIND);
188    S(M+1..S'LAST) := (others => ' ');
189  end PUT;
190
191
192end NOUN_ENTRY_IO;
193
194
195package body PRONOUN_ENTRY_IO is
196  use DECN_RECORD_IO;
197  use PRONOUN_KIND_TYPE_IO;
198  SPACER : CHARACTER := ' ';
199
200
201  procedure GET(F : in FILE_TYPE; P : out PRONOUN_ENTRY) is
202  begin
203    GET(F, P.DECL);
204    GET(F, SPACER);
205    GET(F, P.KIND);
206  end GET;
207
208  procedure GET(P : out PRONOUN_ENTRY) is
209  begin
210    GET(P.DECL);
211    GET(SPACER);
212    GET(P.KIND);
213  end GET;
214
215  procedure PUT(F : in FILE_TYPE; P : in PRONOUN_ENTRY) is
216  begin
217    PUT(F, P.DECL);
218    PUT(F, ' ');
219    PUT(F, P.KIND);
220  end PUT;
221
222  procedure PUT(P : in PRONOUN_ENTRY) is
223  begin
224    PUT(P.DECL);
225    PUT(' ');
226    PUT(P.KIND);
227  end PUT;
228
229  procedure GET(S : in STRING; P : out PRONOUN_ENTRY; LAST : out INTEGER) is
230    L : INTEGER := S'FIRST - 1;
231  begin
232    GET(S(L+1..S'LAST), P.DECL, L);
233    L := L + 1;
234    GET(S(L+1..S'LAST), P.KIND, LAST);
235  end GET;
236
237  procedure PUT(S : out STRING; P : in PRONOUN_ENTRY) is
238    L : INTEGER := S'FIRST - 1;
239    M : INTEGER := 0;
240  begin
241    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
242    PUT(S(L+1..M), P.DECL);
243    L := M + 1;
244    S(L) :=  ' ';
245    M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
246    PUT(S(L+1..M), P.KIND);
247    S(M+1..S'LAST) := (others => ' ');
248  end PUT;
249
250
251end PRONOUN_ENTRY_IO;
252
253
254package body PROPACK_ENTRY_IO is
255  use DECN_RECORD_IO;
256  use PRONOUN_KIND_TYPE_IO;
257  SPACER : CHARACTER := ' ';
258
259
260  procedure GET(F : in FILE_TYPE; P : out PROPACK_ENTRY) is
261  begin
262    GET(F, P.DECL);
263    GET(F, SPACER);
264    GET(F, P.KIND);
265  end GET;
266
267  procedure GET(P : out PROPACK_ENTRY) is
268  begin
269    GET(P.DECL);
270    GET(SPACER);
271    GET(P.KIND);
272  end GET;
273
274  procedure PUT(F : in FILE_TYPE; P : in PROPACK_ENTRY) is
275  begin
276    PUT(F, P.DECL);
277    PUT(F, ' ');
278    PUT(F, P.KIND);
279  end PUT;
280
281  procedure PUT(P : in PROPACK_ENTRY) is
282  begin
283    PUT(P.DECL);
284    PUT(' ');
285    PUT(P.KIND);
286  end PUT;
287
288  procedure GET(S : in STRING; P : out PROPACK_ENTRY; LAST : out INTEGER) is
289    L : INTEGER := S'FIRST - 1;
290  begin
291    GET(S(L+1..S'LAST), P.DECL, L);
292    L := L + 1;
293    GET(S(L+1..S'LAST), P.KIND, LAST);
294  end GET;
295
296  procedure PUT(S : out STRING; P : in PROPACK_ENTRY) is
297    L : INTEGER := S'FIRST - 1;
298    M : INTEGER := 0;
299  begin
300    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
301    PUT(S(L+1..M), P.DECL);
302    L := M + 1;
303    S(L) :=  ' ';
304    M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
305    PUT(S(L+1..M), P.KIND);
306    S(M+1..S'LAST) := (others => ' ');
307  end PUT;
308
309
310end PROPACK_ENTRY_IO;
311
312
313package body ADJECTIVE_ENTRY_IO is
314  use DECN_RECORD_IO;
315  use GENDER_TYPE_IO;
316  use CASE_TYPE_IO;
317  use NUMBER_TYPE_IO;
318  use COMPARISON_TYPE_IO;
319  SPACER : CHARACTER := ' ';
320
321
322  procedure GET(F : in FILE_TYPE; A : out ADJECTIVE_ENTRY) is
323  begin
324    GET(F, A.DECL);
325    GET(F, SPACER);
326    GET(F, A.CO);
327  end GET;
328
329  procedure GET(A : out ADJECTIVE_ENTRY) is
330  begin
331    GET(A.DECL);
332    GET(SPACER);
333    GET(A.CO);
334  end GET;
335
336  procedure PUT(F : in FILE_TYPE; A : in ADJECTIVE_ENTRY) is
337  begin
338    PUT(F, A.DECL);
339    PUT(F, ' ');
340    PUT(F, A.CO);
341  end PUT;
342
343  procedure PUT(A : in ADJECTIVE_ENTRY) is
344  begin
345    PUT(A.DECL);
346    PUT(' ');
347    PUT(A.CO);
348  end PUT;
349
350  procedure GET(S : in STRING; A : out ADJECTIVE_ENTRY; LAST : out INTEGER) is
351    L : INTEGER := S'FIRST - 1;
352  begin
353    GET(S(L+1..S'LAST), A.DECL, L);
354    L := L + 1;
355    GET(S(L+1..S'LAST), A.CO, LAST);
356  end GET;
357
358  procedure PUT(S : out STRING; A : in ADJECTIVE_ENTRY) is
359    L : INTEGER := S'FIRST - 1;
360    M : INTEGER := 0;
361  begin
362    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
363    PUT(S(L+1..M), A.DECL);
364    L := M + 1;
365    S(L) :=  ' ';
366    M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH;
367    PUT(S(L+1..M), A.CO);
368    S(M+1..S'LAST) := (others => ' ');
369  end PUT;
370
371
372end ADJECTIVE_ENTRY_IO;
373
374
375
376package body NUMERAL_ENTRY_IO is
377  use DECN_RECORD_IO;
378  use NUMERAL_SORT_TYPE_IO;
379  use INFLECTIONS_PACKAGE.INTEGER_IO;
380  SPACER : CHARACTER := ' ';
381
382  NUM_OUT_SIZE : constant := 5;    --  Set in spec  !!!!!!!!!!!!!!!!!!!!!!!!!
383
384
385  procedure GET(F : in FILE_TYPE; NUM : out NUMERAL_ENTRY) is
386  begin
387    GET(F, NUM.DECL);
388    GET(F, SPACER);
389    GET(F, NUM.SORT);
390    GET(F, SPACER);
391    GET(F, NUM.VALUE);
392  end GET;
393
394  procedure GET(NUM : out NUMERAL_ENTRY) is
395  begin
396    GET(NUM.DECL);
397    GET(SPACER);
398    GET(NUM.SORT);
399    GET(SPACER);
400    GET(NUM.VALUE);
401  end GET;
402
403  procedure PUT(F : in FILE_TYPE; NUM : in NUMERAL_ENTRY) is
404  begin
405    PUT(F, NUM.DECL);
406    PUT(F, ' ');
407    PUT(F, NUM.SORT);
408    PUT(F, ' ');
409    PUT(F, NUM.VALUE, NUM_OUT_SIZE);
410  end PUT;
411
412  procedure PUT(NUM : in NUMERAL_ENTRY) is
413  begin
414    PUT(NUM.DECL);
415    PUT(' ');
416    PUT(NUM.SORT);
417    PUT(' ');
418    PUT(NUM.VALUE, NUM_OUT_SIZE);
419  end PUT;
420
421  procedure GET(S : in STRING; NUM : out NUMERAL_ENTRY; LAST : out INTEGER) is
422    L : INTEGER := S'FIRST - 1;
423  begin
424--TEXT_IO.PUT("+1");
425    GET(S(L+1..S'LAST), NUM.DECL, L);
426--TEXT_IO.PUT("+2");
427    L := L + 1;
428    GET(S(L+1..S'LAST), NUM.SORT, L);
429--TEXT_IO.PUT("+3");
430   L := L + 1;
431    GET(S(L+1..S'LAST), NUM.VALUE, LAST);
432--TEXT_IO.PUT("+4");
433 end GET;
434
435  procedure PUT(S : out STRING; NUM : in NUMERAL_ENTRY) is
436    L : INTEGER := S'FIRST - 1;
437    M : INTEGER := 0;
438  begin
439    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
440    PUT(S(L+1..M), NUM.DECL);
441    L := M + 1;
442    S(L) :=  ' ';
443    M := L + NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH;
444    PUT(S(L+1..M), NUM.SORT);
445    L := M + 1;
446    S(L) :=  ' ';
447    --M := L + NUMERAL_VALUE_TYPE_IO.DEFAULT_WIDTH;
448    M := L + NUM_OUT_SIZE;
449    PUT(S(L+1..M), NUM.VALUE);
450    S(M+1..S'LAST) := (others => ' ');
451  end PUT;
452
453
454end NUMERAL_ENTRY_IO;
455
456
457package body ADVERB_ENTRY_IO is
458  use COMPARISON_TYPE_IO;
459  SPACER : CHARACTER := ' ';
460
461
462  procedure GET(F : in FILE_TYPE; A : out ADVERB_ENTRY) is
463  begin
464    GET(F, A.CO);
465  end GET;
466
467  procedure GET(A : out ADVERB_ENTRY) is
468  begin
469    GET(A.CO);
470  end GET;
471
472  procedure PUT(F : in FILE_TYPE; A : in ADVERB_ENTRY) is
473  begin
474    PUT(F, A.CO);
475  end PUT;
476
477  procedure PUT(A : in ADVERB_ENTRY) is
478  begin
479    PUT(A.CO);
480  end PUT;
481
482  procedure GET(S : in STRING; A : out ADVERB_ENTRY; LAST : out INTEGER) is
483    L : INTEGER := S'FIRST - 1;
484  begin
485    GET(S(L+1..S'LAST), A.CO, LAST);
486  end GET;
487
488  procedure PUT(S : out STRING; A : in ADVERB_ENTRY) is
489    L : INTEGER := S'FIRST - 1;
490    M : INTEGER := 0;
491  begin
492    M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH;
493    PUT(S(L+1..M), A.CO);
494    S(M+1..S'LAST) := (others => ' ');
495  end PUT;
496
497
498end ADVERB_ENTRY_IO;
499
500
501package body VERB_ENTRY_IO is
502  use DECN_RECORD_IO;
503  use VERB_KIND_TYPE_IO;
504  SPACER : CHARACTER := ' ';
505
506
507  procedure GET(F : in FILE_TYPE; V : out VERB_ENTRY) is
508  begin
509    GET(F, V.CON);
510    GET(F, SPACER);
511    GET(F, V.KIND);
512  end GET;
513
514  procedure GET(V : out VERB_ENTRY) is
515  begin
516    GET(V.CON);
517    GET(SPACER);
518    GET(V.KIND);
519  end GET;
520
521  procedure PUT(F : in FILE_TYPE; V : in VERB_ENTRY) is
522  begin
523    PUT(F, V.CON);
524    PUT(F, ' ');
525    PUT(F, V.KIND);
526  end PUT;
527
528  procedure PUT(V : in VERB_ENTRY) is
529  begin
530    PUT(V.CON);
531    PUT(' ');
532    PUT(V.KIND);
533  end PUT;
534
535  procedure GET(S : in STRING; V : out VERB_ENTRY; LAST : out INTEGER) is
536    L : INTEGER := S'FIRST - 1;
537  begin
538    GET(S(L+1..S'LAST), V.CON, L);
539    L := L + 1;
540    GET(S(L+1..S'LAST), V.KIND, LAST);
541  end GET;
542
543  procedure PUT(S : out STRING; V : in VERB_ENTRY) is
544    L : INTEGER := S'FIRST - 1;
545    M : INTEGER := 0;
546  begin
547    M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
548    PUT(S(L+1..M), V.CON);
549    L := M + 1;
550    S(L) :=  ' ';
551    M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
552    PUT(S(L+1..M), V.KIND);
553    S(M+1..S'LAST) := (others => ' ');
554  end PUT;
555
556
557end VERB_ENTRY_IO;
558
559
560package body PREPOSITION_ENTRY_IO is
561  use CASE_TYPE_IO;
562  SPACER : CHARACTER := ' ';
563
564  procedure GET(F : in FILE_TYPE; P : out PREPOSITION_ENTRY) is
565  begin
566    GET(F, P.OBJ);
567  end GET;
568
569  procedure GET(P : out PREPOSITION_ENTRY) is
570  begin
571    GET(P.OBJ);
572  end GET;
573
574  procedure PUT(F : in FILE_TYPE; P : in PREPOSITION_ENTRY) is
575  begin
576    PUT(F, P.OBJ);
577  end PUT;
578
579  procedure PUT(P : in PREPOSITION_ENTRY) is
580  begin
581    PUT(P.OBJ);
582  end PUT;
583
584  procedure GET(S : in STRING; P : out PREPOSITION_ENTRY; LAST : out INTEGER) is
585  begin
586    GET(S, P.OBJ, LAST);
587  end GET;
588
589  procedure PUT(S : out STRING; P : in PREPOSITION_ENTRY) is
590    L : INTEGER := S'FIRST - 1;
591    M : INTEGER := 0;
592  begin
593    M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
594    PUT(S(L+1..M), P.OBJ);
595    S(M+1..S'LAST) := (others => ' ');
596  end PUT;
597
598
599end PREPOSITION_ENTRY_IO;
600
601
602package body CONJUNCTION_ENTRY_IO is
603  NULL_CONJUNCTION_ENTRY : CONJUNCTION_ENTRY;
604  SPACER : CHARACTER := ' ';
605
606
607  procedure GET(F : in FILE_TYPE; C : out CONJUNCTION_ENTRY) is
608  begin
609    C := NULL_CONJUNCTION_ENTRY;
610  end GET;
611
612  procedure GET(C : out CONJUNCTION_ENTRY) is
613  begin
614    C := NULL_CONJUNCTION_ENTRY;
615  end GET;
616
617  procedure PUT(F : in FILE_TYPE; C : in CONJUNCTION_ENTRY) is
618  begin
619    null;
620  end PUT;
621
622  procedure PUT(C : in CONJUNCTION_ENTRY) is
623  begin
624    null;
625  end PUT;
626
627  procedure GET(S : in STRING; C : out CONJUNCTION_ENTRY; LAST : out INTEGER) is
628    L : INTEGER := S'FIRST - 1;
629  begin
630    C := NULL_CONJUNCTION_ENTRY;
631    LAST := L;
632  end GET;
633
634  procedure PUT(S : out STRING; C : in CONJUNCTION_ENTRY) is
635  begin
636    S(S'FIRST..S'LAST) := (others => ' ');
637  end PUT;
638
639
640end CONJUNCTION_ENTRY_IO;
641
642
643package body INTERJECTION_ENTRY_IO is
644  NULL_INTERJECTION_ENTRY : INTERJECTION_ENTRY;
645  SPACER : CHARACTER := ' ';
646
647 procedure GET(F : in FILE_TYPE; I : out INTERJECTION_ENTRY) is
648  begin
649    I := NULL_INTERJECTION_ENTRY;
650  end GET;
651
652  procedure GET(I : out INTERJECTION_ENTRY) is
653  begin
654    I := NULL_INTERJECTION_ENTRY;
655  end GET;
656
657  procedure PUT(F : in FILE_TYPE; I : in INTERJECTION_ENTRY) is
658  begin
659    null;
660  end PUT;
661
662  procedure PUT(I : in INTERJECTION_ENTRY) is
663  begin
664    null;
665  end PUT;
666
667  procedure GET(S : in STRING; I : out INTERJECTION_ENTRY; LAST : out INTEGER) is
668    L : INTEGER := S'FIRST - 1;
669  begin
670    I := NULL_INTERJECTION_ENTRY;
671    LAST := L;
672  end GET;
673
674  procedure PUT(S : out STRING; I : in INTERJECTION_ENTRY) is
675  begin
676    S(S'FIRST..S'LAST) := (others => ' ');
677  end PUT;
678
679
680end INTERJECTION_ENTRY_IO;
681
682
683
684function "<" (LEFT, RIGHT : PART_ENTRY) return BOOLEAN is
685  begin
686    if LEFT.POFS = RIGHT.POFS  then
687    case LEFT.POFS is
688      when N =>
689        if LEFT.N.DECL < RIGHT.N.DECL  or else
690          (LEFT.N.DECL = RIGHT.N.DECL  and then
691           LEFT.N.GENDER < RIGHT.N.GENDER)  or else
692         ((LEFT.N.DECL = RIGHT.N.DECL  and
693           LEFT.N.GENDER = RIGHT.N.GENDER)  and then
694           LEFT.N.KIND < RIGHT.N.KIND)  then
695         return TRUE;
696        end if;
697      when PRON =>
698        if LEFT.PRON.DECL < RIGHT.PRON.DECL  or else
699          (LEFT.PRON.DECL = RIGHT.PRON.DECL  and then
700           LEFT.PRON.KIND < RIGHT.PRON.KIND)  then
701          return TRUE;
702        end if;
703      when PACK =>
704        if LEFT.PACK.DECL < RIGHT.PACK.DECL  or else
705          (LEFT.PACK.DECL = RIGHT.PACK.DECL  and then
706           LEFT.PACK.KIND < RIGHT.PACK.KIND)  then
707         return TRUE;
708        end if;
709      when ADJ =>
710        if LEFT.ADJ.DECL < RIGHT.ADJ.DECL   or else
711          (LEFT.ADJ.DECL = RIGHT.ADJ.DECL  and then
712           LEFT.ADJ.CO < RIGHT.ADJ.CO)   then
713          return TRUE;
714        end if;
715      when NUM =>
716        if LEFT.NUM.DECL < RIGHT.NUM.DECL  or else
717          (LEFT.NUM.DECL = RIGHT.NUM.DECL  and then
718           LEFT.NUM.SORT < RIGHT.NUM.SORT)  or else
719         ((LEFT.NUM.DECL = RIGHT.NUM.DECL)  and then
720          (LEFT.NUM.SORT = RIGHT.NUM.SORT)   and then
721           LEFT.NUM.VALUE < RIGHT.NUM.VALUE)   then
722        return TRUE;
723        end if;when ADV =>
724        return LEFT.ADV.CO < RIGHT.ADV.CO;
725      when V =>
726        if (LEFT.V.CON < RIGHT.V.CON)  or else
727           (LEFT.V.CON = RIGHT.V.CON  and then
728            LEFT.V.KIND < RIGHT.V.KIND)  then
729          return TRUE;
730        end if;
731      when PREP =>
732        return LEFT.PREP.OBJ < RIGHT.PREP.OBJ;
733      when others =>
734        null;
735    end case;
736    else
737      return LEFT.POFS < RIGHT.POFS;
738    end if;
739    return FALSE;
740  exception
741    when CONSTRAINT_ERROR  =>
742      return LEFT.POFS < RIGHT.POFS;
743  end "<";
744
745
746
747package body PART_ENTRY_IO is
748  use PART_OF_SPEECH_TYPE_IO;
749  use NOUN_ENTRY_IO;
750  use PRONOUN_ENTRY_IO;
751  use PROPACK_ENTRY_IO;
752  use ADJECTIVE_ENTRY_IO;
753  use NUMERAL_ENTRY_IO;
754  use ADVERB_ENTRY_IO;
755  use VERB_ENTRY_IO;
756  use PREPOSITION_ENTRY_IO;
757  use CONJUNCTION_ENTRY_IO;
758  use INTERJECTION_ENTRY_IO;
759  SPACER : CHARACTER := ' ';
760
761
762  NOUN : NOUN_ENTRY;
763  PRONOUN : PRONOUN_ENTRY;
764  PROPACK : PROPACK_ENTRY;
765  ADJECTIVE : ADJECTIVE_ENTRY;
766  NUMERAL : NUMERAL_ENTRY;
767  ADVERB : ADVERB_ENTRY;
768  VERB : VERB_ENTRY;
769  PREPOSITION : PREPOSITION_ENTRY;
770  CONJUNCTION : CONJUNCTION_ENTRY;
771  INTERJECTION : INTERJECTION_ENTRY;
772
773  PR : PART_ENTRY;
774
775
776  procedure GET(F : in FILE_TYPE; P : out PART_ENTRY) is
777    PS : PART_OF_SPEECH_TYPE := X;
778    C : POSITIVE_COUNT := COL(F);
779  begin
780    GET(F, PS);
781    GET(F, SPACER);
782    case PS is
783      when N =>
784        GET(F, NOUN);
785        P := (N, NOUN);
786      when PRON =>
787        GET(F, PRONOUN);
788        P := (PRON, PRONOUN);
789      when PACK =>
790        GET(F, PROPACK);
791        P := (PACK, PROPACK);
792      when ADJ =>
793        GET(F, ADJECTIVE);
794        P := (ADJ, ADJECTIVE);
795      when NUM =>
796        GET(F, NUMERAL);
797        P := (NUM, NUMERAL);
798      when ADV =>
799        GET(F, ADVERB);
800        P := (ADV, ADVERB);
801      when V =>
802        GET(F, VERB);
803        P := (V, VERB);
804      when VPAR =>
805        null;                --  No VAPR entry
806      when SUPINE =>
807        null;                --  No SUPINE entry
808      when PREP =>
809        GET(F, PREPOSITION);
810        P := (PREP, PREPOSITION);
811      when CONJ =>
812        GET(F, CONJUNCTION);
813        P := (CONJ, CONJUNCTION);
814      when INTERJ =>
815        GET(F, INTERJECTION);
816        P := (INTERJ, INTERJECTION);
817      when PREFIX =>
818        P := (POFS => PREFIX);
819      when SUFFIX =>
820        P := (POFS => SUFFIX);
821      when TACKON =>
822        P := (POFS => TACKON);
823      when X =>
824        P := (POFS => X);
825    end case;
826    SET_COL(F, POSITIVE_COUNT(PART_ENTRY_IO.DEFAULT_WIDTH)+C);
827    return;
828  end GET;
829
830  procedure GET(P : out PART_ENTRY) is
831    PS : PART_OF_SPEECH_TYPE := X;
832  begin
833    GET(PS);
834    GET(SPACER);
835    case PS is
836      when N =>
837        GET(NOUN);
838        P := (N, NOUN);
839      when PRON =>
840        GET(PRONOUN);
841        P := (PRON, PRONOUN);
842      when PACK =>
843        GET(PROPACK);
844        P := (PACK, PROPACK);
845      when ADJ =>
846        GET(ADJECTIVE);
847        P := (ADJ, ADJECTIVE);
848      when NUM =>
849        GET(NUMERAL);
850        P := (NUM, NUMERAL);
851      when ADV =>
852        GET(ADVERB);
853        P := (ADV, ADVERB);
854      when V =>
855        GET(VERB);
856        P := (V, VERB);
857      when VPAR =>
858        null;                --  No VAPR entry
859      when SUPINE =>
860        null;                --  No SUPINE entry
861      when PREP =>
862        GET(PREPOSITION);
863        P := (PREP, PREPOSITION);
864      when CONJ =>
865        GET(CONJUNCTION);
866        P := (CONJ, CONJUNCTION);
867      when INTERJ =>
868        GET(INTERJECTION);
869        P := (INTERJ, INTERJECTION);
870      when PREFIX =>
871        P := (POFS => PREFIX);
872      when SUFFIX =>
873        P := (POFS => SUFFIX);
874      when TACKON =>
875        P := (POFS => TACKON);
876      when X =>
877        P := (POFS => X);
878    end case;
879    return;
880  end GET;
881
882  procedure PUT(F : in FILE_TYPE; P : in PART_ENTRY) is
883    C : POSITIVE := POSITIVE(COL(F));
884  begin
885    PUT(F, P.POFS);
886    PUT(F, ' ');
887    case P.POFS is
888      when N =>
889        PUT(F, P.N);
890      when PRON =>
891        PUT(F, P.PRON);
892      when PACK =>
893        PUT(F, P.PACK);
894      when ADJ =>
895        PUT(F, P.ADJ);
896      when NUM =>
897        PUT(F, P.NUM);
898      when ADV =>
899        PUT(F, P.ADV);
900      when V =>
901        PUT(F, P.V);
902      when VPAR =>
903        null;                --  No VAPR entry
904      when SUPINE =>
905        null;                --  No SUPINE entry
906      when PREP =>
907        PUT(F, P.PREP);
908      when CONJ =>
909        PUT(F, P.CONJ);
910      when INTERJ =>
911        PUT(F, P.INTERJ);
912      when others =>
913        null;
914    end case;
915    --PUT(F, STRING'((INTEGER(COL(F))..PART_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
916   return;
917  end PUT;
918
919
920  procedure PUT(P : in PART_ENTRY) is
921    C : POSITIVE := POSITIVE(COL);
922  begin
923    PUT(P.POFS);
924    PUT(' ');
925    case P.POFS is
926      when N =>
927        PUT(P.N);
928      when PRON =>
929        PUT(P.PRON);
930      when PACK =>
931        PUT(P.PACK);
932      when ADJ =>
933        PUT(P.ADJ);
934      when NUM =>
935        PUT(P.NUM);
936      when ADV =>
937        PUT(P.ADV);
938      when V =>
939        PUT(P.V);
940      when VPAR =>
941        null;                --  No VAPR entry
942      when SUPINE =>
943        null;                --  No SUPINE entry
944      when PREP =>
945        PUT(P.PREP);
946      when CONJ =>
947        PUT(P.CONJ);
948      when INTERJ =>
949        PUT(P.INTERJ);
950      when others =>
951        null;
952    end case;
953    --PUT(STRING'((INTEGER(COL)..PART_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
954    return;
955  end PUT;
956
957  procedure GET(S : in STRING; P : out PART_ENTRY; LAST : out INTEGER) is
958    L : INTEGER := S'FIRST - 1;
959    PS : PART_OF_SPEECH_TYPE := X;
960  begin
961    LAST := L;      --  In case it is not set later
962    GET(S, PS, L);
963    L := L + 1;
964    case PS is
965      when N =>
966        GET(S(L+1..S'LAST), NOUN, LAST);
967        P := (N, NOUN);
968      when PRON =>
969        GET(S(L+1..S'LAST), PRONOUN, LAST);
970        P := (PRON, PRONOUN);
971      when PACK =>
972        GET(S(L+1..S'LAST), PROPACK, LAST);
973        P := (PACK, PROPACK);
974      when ADJ =>
975        GET(S(L+1..S'LAST), ADJECTIVE, LAST);
976        P := (ADJ, ADJECTIVE);
977      when NUM =>
978        GET(S(L+1..S'LAST), NUMERAL, LAST);
979        P := (NUM, NUMERAL);
980      when ADV =>
981        GET(S(L+1..S'LAST), ADVERB, LAST);
982        P := (ADV, ADVERB);
983      when V =>
984        GET(S(L+1..S'LAST), VERB, LAST);
985        P := (V, VERB);
986      when VPAR =>
987        null;                --  No VAPR entry
988      when SUPINE =>
989        null;                --  No SUPINE entry
990      when PREP =>
991        GET(S(L+1..S'LAST), PREPOSITION, LAST);
992        P := (PREP, PREPOSITION);
993      when CONJ =>
994        GET(S(L+1..S'LAST), CONJUNCTION, LAST);
995        P := (CONJ, CONJUNCTION);
996      when INTERJ =>
997        GET(S(L+1..S'LAST), INTERJECTION, LAST);
998        P := (INTERJ, INTERJECTION);
999      when PREFIX =>
1000        P := (POFS => PREFIX);
1001      when SUFFIX =>
1002        P := (POFS => SUFFIX);
1003      when TACKON =>
1004        P := (POFS => TACKON);
1005      when X =>
1006        P := (POFS => X);
1007    end case;
1008  end GET;
1009
1010
1011  procedure PUT(S : out STRING; P : in PART_ENTRY) is
1012    L : INTEGER := S'FIRST - 1;
1013    M : INTEGER := 0;
1014  begin
1015    M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
1016    PUT(S(L+1..M), P.POFS);
1017    L := M + 1;
1018    S(L) :=  ' ';
1019    case P.POFS is
1020      when N =>
1021        M := L + NOUN_ENTRY_IO.DEFAULT_WIDTH;
1022        PUT(S(L+1..M), P.N);
1023      when PRON =>
1024        M := L + PRONOUN_ENTRY_IO.DEFAULT_WIDTH;
1025        PUT(S(L+1..M), P.PRON);
1026      when PACK =>
1027        M := L + PROPACK_ENTRY_IO.DEFAULT_WIDTH;
1028        PUT(S(L+1..M), P.PACK);
1029      when ADJ =>
1030        M := L + ADJECTIVE_ENTRY_IO.DEFAULT_WIDTH;
1031        PUT(S(L+1..M), P.ADJ);
1032      when NUM =>
1033        M := L + NUMERAL_ENTRY_IO.DEFAULT_WIDTH;
1034        PUT(S(L+1..M), P.NUM);
1035      when ADV =>
1036        M := L + ADVERB_ENTRY_IO.DEFAULT_WIDTH;
1037        PUT(S(L+1..M), P.ADV);
1038      when V =>
1039        M := L + VERB_ENTRY_IO.DEFAULT_WIDTH;
1040        PUT(S(L+1..M), P.V);
1041      when VPAR =>
1042        null;                --  No VAPR entryR
1043      when SUPINE =>
1044        null;                --  No SUPINE entry
1045      when PREP =>
1046        M := L + PREPOSITION_ENTRY_IO.DEFAULT_WIDTH;
1047        PUT(S(L+1..M), P.PREP);
1048      when CONJ =>
1049        M := L + CONJUNCTION_ENTRY_IO.DEFAULT_WIDTH;
1050        PUT(S(L+1..M), P.CONJ);
1051      when INTERJ =>
1052        M := L + INTERJECTION_ENTRY_IO.DEFAULT_WIDTH;
1053        PUT(S(L+1..M), P.INTERJ);
1054      when others =>
1055        null;
1056    end case;
1057    --S(M+1..S'LAST) := (others => ' ');
1058  end PUT;
1059
1060
1061end PART_ENTRY_IO;
1062
1063
1064
1065
1066package body KIND_ENTRY_IO is
1067  use NOUN_KIND_TYPE_IO;
1068  use PRONOUN_KIND_TYPE_IO;
1069  use INFLECTIONS_PACKAGE.INTEGER_IO;
1070  use VERB_KIND_TYPE_IO;
1071  SPACER : CHARACTER := ' ';
1072
1073
1074  NOUN_KIND  : NOUN_KIND_TYPE;
1075  PRONOUN_KIND : PRONOUN_KIND_TYPE;
1076  PROPACK_KIND : PRONOUN_KIND_TYPE;
1077  VERB_KIND : VERB_KIND_TYPE;
1078  VPAR_KIND : VERB_KIND_TYPE;
1079  SUPINE_KIND : VERB_KIND_TYPE;
1080  NUMERAL_VALUE : NUMERAL_VALUE_TYPE;
1081
1082
1083
1084  procedure GET(F : in FILE_TYPE;
1085                PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY) is
1086  begin
1087    case PS is
1088      when N =>
1089        GET(F, NOUN_KIND);
1090        P := (N, NOUN_KIND);
1091      when PRON =>
1092        GET(F, PRONOUN_KIND);
1093        P := (PRON, PRONOUN_KIND);
1094      when PACK =>
1095        GET(F, PROPACK_KIND);
1096        P := (PACK, PROPACK_KIND);
1097      when ADJ =>
1098        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1099        P := (POFS => ADJ);
1100      when NUM =>
1101        GET(F, NUMERAL_VALUE);
1102        P := (NUM, NUMERAL_VALUE);
1103      when ADV =>
1104        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1105        P := (POFS => ADV);
1106      when V =>
1107        GET(F, VERB_KIND);
1108        P := (V, VERB_KIND);
1109      when VPAR =>
1110        GET(F, VPAR_KIND);
1111        P := (VPAR, VPAR_KIND);
1112      when SUPINE =>
1113        GET(F, SUPINE_KIND);
1114        P := (SUPINE, SUPINE_KIND);
1115      when PREP =>
1116        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1117        P := (POFS => PREP);
1118      when CONJ =>
1119        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1120        P := (POFS => CONJ);
1121      when INTERJ =>
1122        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1123        P := (POFS => INTERJ);
1124      when TACKON =>
1125        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1126        P := (POFS => TACKON);
1127      when PREFIX =>
1128        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1129        P := (POFS => PREFIX);
1130      when SUFFIX =>
1131        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1132        P := (POFS => SUFFIX);
1133      when X =>
1134        SET_COL(F, COL(F) + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1135        P := (POFS => X);
1136    end case;
1137    return;
1138  end GET;
1139
1140
1141  procedure GET(PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY) is
1142  begin
1143    case PS is
1144      when N =>
1145        GET(NOUN_KIND);
1146        P := (N, NOUN_KIND);
1147      when PRON =>
1148        GET(PRONOUN_KIND);
1149        P := (PRON, PRONOUN_KIND);
1150      when PACK =>
1151        GET(PROPACK_KIND);
1152        P := (PACK, PROPACK_KIND);
1153      when ADJ =>
1154        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1155        P := (POFS => ADJ);
1156      when NUM =>
1157        GET(NUMERAL_VALUE);
1158        P := (NUM, NUMERAL_VALUE);
1159      when ADV =>
1160        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1161        P := (POFS => ADV);
1162      when V =>
1163        GET(VERB_KIND);
1164        P := (V, VERB_KIND);
1165      when VPAR =>
1166        GET(VPAR_KIND);
1167        P := (VPAR, VPAR_KIND);
1168      when SUPINE =>
1169        GET(SUPINE_KIND);
1170        P := (SUPINE, SUPINE_KIND);
1171      when PREP =>
1172        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1173        P := (POFS => PREP);
1174      when CONJ =>
1175        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1176        P := (POFS => CONJ);
1177      when INTERJ =>
1178        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1179        P := (POFS => INTERJ);
1180      when TACKON =>
1181        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1182        P := (POFS => TACKON);
1183      when PREFIX =>
1184        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1185        P := (POFS => PREFIX);
1186      when SUFFIX =>
1187        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1188        P := (POFS => SUFFIX);
1189      when X =>
1190        SET_COL(COL + POSITIVE_COUNT(KIND_ENTRY_IO.DEFAULT_WIDTH));
1191        P := (POFS => X);
1192    end case;
1193    return;
1194  end GET;
1195
1196
1197
1198  procedure PUT(F : in FILE_TYPE;
1199                PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is
1200    C : POSITIVE := POSITIVE(COL(F));
1201  begin
1202    case P.POFS is
1203      when N =>
1204        PUT(F, P.N_KIND);
1205      when PRON =>
1206        PUT(F, P.PRON_KIND);
1207      when PACK =>
1208        PUT(F, P.PACK_KIND);
1209      when NUM =>
1210        PUT(F, P.NUM_VALUE, NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH);
1211      when V =>
1212        PUT(F, P.V_KIND);
1213      when VPAR =>
1214        PUT(F, P.VPAR_KIND);
1215      when SUPINE =>
1216        PUT(F, P.SUPINE_KIND);
1217      when others =>
1218        null;
1219    end case;
1220    PUT(F, STRING'((INTEGER(COL(F))..KIND_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
1221    return;
1222  end PUT;
1223
1224  procedure PUT(PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is
1225    C : POSITIVE := POSITIVE(COL);
1226  begin
1227    case P.POFS is
1228      when N =>
1229        PUT(P.N_KIND);
1230      when PRON =>
1231        PUT(P.PRON_KIND);
1232      when PACK =>
1233        PUT(P.PACK_KIND);
1234      when NUM =>
1235        PUT(P.NUM_VALUE, NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH);
1236      when V =>
1237        PUT(P.V_KIND);
1238      when VPAR =>
1239        PUT(P.VPAR_KIND);
1240      when SUPINE =>
1241        PUT(P.SUPINE_KIND);
1242      when others =>
1243        null;
1244    end case;
1245    PUT(STRING'((INTEGER(COL)..KIND_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
1246    return;
1247  end PUT;
1248
1249
1250  procedure GET(S : in STRING; PS : in PART_OF_SPEECH_TYPE;
1251                P : out KIND_ENTRY; LAST : out INTEGER) is
1252    L : INTEGER := S'FIRST - 1;
1253  begin
1254    LAST := L;         --  In case it is not set later
1255    case PS is
1256      when N =>
1257        GET(S(L+1..S'LAST), NOUN_KIND, LAST);
1258        P := (N, NOUN_KIND);
1259      when PRON =>
1260        GET(S(L+1..S'LAST), PRONOUN_KIND, LAST);
1261        P := (PRON, PRONOUN_KIND);
1262      when PACK =>
1263        GET(S(L+1..S'LAST), PROPACK_KIND, LAST);
1264        P := (PACK, PROPACK_KIND);
1265      when ADJ =>
1266        P := (POFS => ADJ);
1267      when NUM =>
1268        GET(S(L+1..S'LAST), NUMERAL_VALUE, LAST);
1269        P := (NUM, NUMERAL_VALUE);
1270      when ADV =>
1271        P := (POFS => ADV);
1272      when V =>
1273        GET(S(L+1..S'LAST), VERB_KIND, LAST);
1274        P := (V, VERB_KIND);
1275      when VPAR =>
1276        GET(S(L+1..S'LAST), VPAR_KIND, LAST);
1277        P := (VPAR, VPAR_KIND);
1278      when SUPINE =>
1279        GET(S(L+1..S'LAST), SUPINE_KIND, LAST);
1280        P := (SUPINE, SUPINE_KIND);
1281      when PREP =>
1282        P := (POFS => PREP);
1283      when CONJ =>
1284        P := (POFS => CONJ);
1285      when INTERJ =>
1286        P := (POFS => INTERJ);
1287      when TACKON =>
1288        P := (POFS => TACKON);
1289      when PREFIX =>
1290        P := (POFS => PREFIX);
1291      when SUFFIX =>
1292        P := (POFS => SUFFIX);
1293      when X =>
1294        P := (POFS => X);
1295    end case;
1296    return;
1297  end GET;
1298
1299
1300  procedure PUT(S : out STRING;
1301                PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY) is
1302    L : INTEGER := S'FIRST - 1;
1303    M : INTEGER := 0;
1304  begin
1305    case P.POFS is
1306      when N =>
1307        M := L + NOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1308        PUT(S(L+1..M), P.N_KIND);
1309      when PRON =>
1310        M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1311        PUT(S(L+1..M), P.PRON_KIND);
1312      when PACK =>
1313        M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1314        PUT(S(L+1..M), P.PACK_KIND);
1315      when NUM =>
1316        M := L + NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH;
1317        PUT(S(L+1..M), P.NUM_VALUE);
1318      when V =>
1319        M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
1320        PUT(S(L+1..M), P.V_KIND);
1321      when VPAR =>
1322        M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
1323        PUT(S(L+1..M), P.VPAR_KIND);
1324      when SUPINE =>
1325        M := L + VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
1326        PUT(S(L+1..M), P.SUPINE_KIND);
1327      when others =>
1328        null;
1329    end case;
1330    S(M+1..S'LAST) := (others => ' ');
1331  end PUT;
1332
1333
1334end KIND_ENTRY_IO;
1335
1336
1337
1338
1339package body TRANSLATION_RECORD_IO is
1340    use TEXT_IO;
1341    use AGE_TYPE_IO;
1342    use AREA_TYPE_IO;
1343    use GEO_TYPE_IO;
1344    use FREQUENCY_TYPE_IO;
1345    use SOURCE_TYPE_IO;
1346    SPACER : CHARACTER := ' ';
1347    --LINE : STRING(1..250);
1348    LAST : INTEGER := 0;
1349
1350    procedure GET(F : in TEXT_IO.FILE_TYPE; TR: out TRANSLATION_RECORD) is
1351    begin
1352      GET(F, TR.AGE);
1353      GET(F, SPACER);
1354      GET(F, TR.AREA);
1355      GET(F, SPACER);
1356      GET(F, TR.GEO);
1357      GET(F, SPACER);
1358      GET(F, TR.FREQ);
1359      GET(F, SPACER);
1360      GET(F, TR.SOURCE);
1361      --GET(F, SPACER);
1362      --GET_LINE(F, LINE, LAST);
1363      --TR.MEAN := HEAD(LINE(1..LAST), MAX_MEANING_SIZE);
1364  end GET;
1365
1366    procedure GET(TR : out TRANSLATION_RECORD) is
1367    begin
1368      GET(TR.AGE);
1369      GET(SPACER);
1370      GET(TR.AREA);
1371      GET(SPACER);
1372      GET(TR.GEO);
1373      GET(SPACER);
1374      GET(TR.FREQ);
1375      GET(SPACER);
1376      GET(TR.SOURCE);
1377      --GET(SPACER);
1378      --GET_LINE(LINE, LAST);
1379      --TR.MEAN := HEAD(LINE(1..LAST), MAX_MEANING_SIZE);
1380    end GET;
1381
1382    procedure PUT(F : in TEXT_IO.FILE_TYPE; TR : in TRANSLATION_RECORD) is
1383    begin
1384      PUT(F, TR.AGE);
1385      PUT(F, ' ');
1386      PUT(F, TR.AREA);
1387      PUT(F, ' ');
1388      PUT(F, TR.GEO);
1389      PUT(F, ' ');
1390      PUT(F, TR.FREQ);
1391      PUT(F, ' ');
1392      PUT(F, TR.SOURCE);
1393      --PUT(F, ' ');
1394      --PUT(F, TR.MEAN);
1395    end PUT;
1396
1397    procedure PUT(TR : in TRANSLATION_RECORD) is
1398    begin
1399      AGE_TYPE_IO.PUT(TR.AGE);
1400      TEXT_IO.PUT(' ');
1401      AREA_TYPE_IO.PUT(TR.AREA);
1402      TEXT_IO.PUT(' ');
1403      GEO_TYPE_IO.PUT(TR.GEO);
1404      TEXT_IO.PUT(' ');
1405      FREQUENCY_TYPE_IO.PUT(TR.FREQ);
1406      TEXT_IO.PUT(' ');
1407      SOURCE_TYPE_IO.PUT(TR.SOURCE);
1408      --TEXT_IO.PUT(' ');
1409      --TEXT_IO.PUT(TR.MEAN);
1410    end PUT;
1411
1412    procedure GET(S : in STRING; TR : out TRANSLATION_RECORD; LAST : out INTEGER) is
1413      L : INTEGER := S'FIRST - 1;
1414    begin
1415      GET(S(L+1..S'LAST), TR.AGE, L);
1416--PUT(TR.AGE); TEXT_IO.PUT('-');
1417      L := L + 1;
1418      GET(S(L+1..S'LAST), TR.AREA, L);
1419--PUT(TR.AREA); TEXT_IO.PUT('-');
1420       L := L + 1;
1421      GET(S(L+1..S'LAST), TR.GEO, L);
1422--PUT(TR.GEO); TEXT_IO.PUT('-');
1423       L := L + 1;
1424      GET(S(L+1..S'LAST), TR.FREQ, L);
1425 --PUT(TR.FREQ); TEXT_IO.PUT('-');
1426      L := L + 1;
1427      GET(S(L+1..S'LAST), TR.SOURCE, LAST);
1428 --PUT(TR.SOURCE); TEXT_IO.PUT('-');
1429      --L := M + 1;
1430      --M := L + MAX_MEANING_SIZE;
1431      --TR.MEAN := HEAD(S(L+1..S'LAST), MAX_MEANING_SIZE);
1432      --LAST := M;
1433    end GET;
1434
1435    procedure PUT(S : out STRING; TR : in TRANSLATION_RECORD) is
1436      L : INTEGER := 0;
1437      M : INTEGER := 0;
1438    begin
1439      M := L + AGE_TYPE_IO.DEFAULT_WIDTH;
1440      PUT(S(L+1..M), TR.AGE);
1441      L := M + 1;
1442      S(L) :=  ' ';
1443      M := L + AREA_TYPE_IO.DEFAULT_WIDTH;
1444      PUT(S(L+1..M), TR.AREA);
1445      L := M + 1;
1446      S(L) :=  ' ';
1447      M := L + GEO_TYPE_IO.DEFAULT_WIDTH;
1448      PUT(S(L+1..M), TR.GEO);
1449      L := M + 1;
1450      S(L) :=  ' ';
1451      M := L + FREQUENCY_TYPE_IO.DEFAULT_WIDTH;
1452      PUT(S(L+1..M), TR.FREQ);
1453      L := M + 1;
1454      S(L) :=  ' ';
1455      M := L + SOURCE_TYPE_IO.DEFAULT_WIDTH;
1456      PUT(S(L+1..M), TR.SOURCE);
1457      --L := M + 1;
1458      --S(L) :=  ' ';
1459      --M := L + MAX_MEANING_SIZE;
1460      --S(L+1..M) :=  TR.MEAN;
1461      S(M+1..S'LAST) := (others => ' ');
1462    end PUT;
1463
1464    end TRANSLATION_RECORD_IO;
1465
1466
1467
1468package body DICTIONARY_ENTRY_IO is
1469  use PART_ENTRY_IO;
1470  use TRANSLATION_RECORD_IO;
1471  --use KIND_ENTRY_IO;
1472
1473  SPACER : CHARACTER := ' ';
1474  PART_COL : NATURAL := 0;
1475
1476  DE : DICTIONARY_ENTRY;
1477
1478  procedure GET(F : in FILE_TYPE; D : out DICTIONARY_ENTRY) is
1479  begin
1480   for I in STEM_KEY_TYPE range 1..4  loop
1481      GET(F, D.STEMS(I));
1482      GET(F, SPACER);
1483    end loop;
1484    GET(F, D.PART);
1485--    GET(F, SPACER);
1486--    GET(F, D.PART.POFS, D.KIND);
1487    GET(F, SPACER);
1488    GET(F, D.TRAN);
1489    GET(F, SPACER);
1490    GET(F, D.MEAN);
1491   end GET;
1492
1493  procedure GET(D : out DICTIONARY_ENTRY) is
1494  begin
1495   for I in STEM_KEY_TYPE range 1..4  loop
1496      GET(D.STEMS(I));
1497      GET(SPACER);
1498    end loop;
1499    GET(D.PART);
1500--    GET(SPACER);
1501--    GET(D.PART.POFS, D.KIND);
1502    GET(SPACER);
1503    GET(D.TRAN);
1504    GET(SPACER);
1505    GET(D.MEAN);
1506   end GET;
1507
1508  procedure PUT(F : in FILE_TYPE; D : in DICTIONARY_ENTRY) is
1509  begin
1510    for I in STEM_KEY_TYPE range 1..4  loop
1511      PUT(F, D.STEMS(I));
1512      PUT(F, ' ');
1513    end loop;
1514    PART_COL := NATURAL(COL(F));
1515    PUT(F, D.PART);
1516--    PUT(F, ' ');
1517--    PUT(F, D.PART.POFS, D.KIND);
1518    SET_COL(F, COUNT(PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1));
1519    PUT(F, D.TRAN);
1520    PUT(F, ' ');
1521    PUT(F, D.MEAN);
1522   end PUT;
1523
1524  procedure PUT(D : in DICTIONARY_ENTRY) is
1525  begin
1526    for I in STEM_KEY_TYPE range 1..4  loop
1527      PUT(D.STEMS(I));
1528      PUT(' ');
1529    end loop;
1530    PART_COL := NATURAL(COL);
1531    PUT(D.PART);
1532--    PUT(' ');
1533--    PUT(D.PART.POFS, D.KIND);
1534    SET_COL(COUNT(PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1));
1535    PUT(D.TRAN);
1536    PUT(' ');
1537    PUT(D.MEAN);
1538   end PUT;
1539
1540  procedure GET(S : in STRING; D : out DICTIONARY_ENTRY; LAST : out INTEGER) is
1541    L : INTEGER := S'FIRST - 1;
1542    M : INTEGER := 0;
1543    I : INTEGER := 0;
1544  begin
1545    for I in STEM_KEY_TYPE range 1..4  loop
1546      STEM_TYPE_IO.GET(S(L+1..S'LAST), D.STEMS(I), L);
1547    end loop;
1548    GET(S(L+1..S'LAST), D.PART, L);
1549--    L := L + 1;
1550--    GET(S(L+1..S'LAST), D.PART.POFS, D.KIND, L);
1551    L := L + 1;
1552    GET(S(L+1..S'LAST), D.TRAN, L);
1553    L := L + 1;
1554    D.MEAN := HEAD(S(L+1..S'LAST), MAX_MEANING_SIZE);
1555    I := L+1;
1556    while S(I) = ' ' loop
1557      I := I + 1;
1558    end loop;
1559    while (S(I) not in 'A'..'Z') and
1560          (S(I) not in 'a'..'z')     loop
1561      LAST := I;
1562      I := I + 1;
1563      exit;
1564    end loop;
1565  end GET;
1566
1567  procedure PUT(S : out STRING; D : in DICTIONARY_ENTRY) is
1568    L : INTEGER := S'FIRST - 1;
1569    M : INTEGER := 0;
1570  begin
1571    for I in STEM_KEY_TYPE range 1..4  loop
1572      M := L + MAX_STEM_SIZE;
1573      S(L+1..M) := D.STEMS(I);
1574      L := M + 1;
1575      S(L) :=  ' ';
1576    end loop;
1577    PART_COL := L + 1;
1578    M := L + PART_ENTRY_IO.DEFAULT_WIDTH;
1579    PUT(S(L+1..M), D.PART);
1580--    L := M + 1;
1581--    S(L) :=  ' ';
1582--    M := L + KIND_ENTRY_IO_DEFAULT_WIDTH;
1583--    PUT(S(L+1..M), D.PART.POFS, D.KIND);
1584    L := PART_COL + PART_ENTRY_IO.DEFAULT_WIDTH + 1;
1585    M := L + TRANSLATION_RECORD_IO.DEFAULT_WIDTH;
1586    PUT(S(L+1..M), D.TRAN);
1587    L := M + 1;
1588    S(L) :=  ' ';
1589    M := M + MAX_MEANING_SIZE;
1590    S(L+1..M) := D.MEAN;
1591    S(M+1..S'LAST) := (others => ' ');
1592  end PUT;
1593
1594end DICTIONARY_ENTRY_IO;
1595
1596
1597
1598
1599
1600  function "<=" (LEFT, RIGHT : AREA_TYPE) return BOOLEAN is
1601  begin
1602    if RIGHT = LEFT  or else
1603       RIGHT = X  then
1604      return TRUE;
1605    else
1606      return FALSE;
1607    end if;
1608  end "<=";
1609
1610
1611begin     --  initialization of body of DICTIONARY_PACKAGE
1612--TEXT_IO.PUT_LINE("Initializing DICTIONARY_PACKAGE");
1613
1614  DICTIONARY_KIND_IO.DEFAULT_WIDTH := DICTIONARY_KIND'WIDTH;
1615
1616  --NUMERAL_VALUE_TYPE_IO.DEFAULT_WIDTH := 5;
1617
1618  AREA_TYPE_IO.DEFAULT_WIDTH := AREA_TYPE'WIDTH;
1619
1620  GEO_TYPE_IO.DEFAULT_WIDTH := GEO_TYPE'WIDTH;
1621
1622  FREQUENCY_TYPE_IO.DEFAULT_WIDTH := FREQUENCY_TYPE'WIDTH;
1623
1624  SOURCE_TYPE_IO.DEFAULT_WIDTH := SOURCE_TYPE'WIDTH;
1625
1626
1627
1628  PARSE_RECORD_IO.DEFAULT_WIDTH :=
1629                                   STEM_TYPE_IO.DEFAULT_WIDTH + 1 +
1630                                   INFLECTION_RECORD_IO.DEFAULT_WIDTH + 1 +
1631                                   DICTIONARY_KIND_IO.DEFAULT_WIDTH + 1 +
1632                                   MNPC_IO_DEFAULT_WIDTH;
1633  NOUN_ENTRY_IO.DEFAULT_WIDTH :=
1634                   DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1635                   GENDER_TYPE_IO.DEFAULT_WIDTH + 1 +
1636                   NOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1637  PRONOUN_ENTRY_IO.DEFAULT_WIDTH :=
1638                   DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1639                   PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1640  PROPACK_ENTRY_IO.DEFAULT_WIDTH :=
1641                   DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1642                   PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
1643  ADJECTIVE_ENTRY_IO.DEFAULT_WIDTH :=
1644                   DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1645                   COMPARISON_TYPE_IO.DEFAULT_WIDTH;
1646  ADVERB_ENTRY_IO.DEFAULT_WIDTH :=
1647                   COMPARISON_TYPE_IO.DEFAULT_WIDTH;
1648  VERB_ENTRY_IO.DEFAULT_WIDTH :=
1649                   DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1650                   VERB_KIND_TYPE_IO.DEFAULT_WIDTH;
1651  PREPOSITION_ENTRY_IO.DEFAULT_WIDTH := 0;
1652  CONJUNCTION_ENTRY_IO.DEFAULT_WIDTH := 0;
1653
1654  INTERJECTION_ENTRY_IO.DEFAULT_WIDTH := 0;
1655  NUMERAL_ENTRY_IO.DEFAULT_WIDTH :=
1656                 DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
1657                 NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH + 1 +
1658                 NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH;
1659
1660
1661  PART_ENTRY_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 +
1662                NUMERAL_ENTRY_IO.DEFAULT_WIDTH;     --  Largest
1663
1664
1665
1666    --  Should make up a MAX of PART_ENTRY + KIND_ENTRY (same POFS) WIDTHS
1667
1668
1669  TRANSLATION_RECORD_IO.DEFAULT_WIDTH :=
1670                                         AGE_TYPE_IO.DEFAULT_WIDTH + 1 +
1671                                         AREA_TYPE_IO.DEFAULT_WIDTH + 1 +
1672                                         GEO_TYPE_IO.DEFAULT_WIDTH + 1 +
1673                                         FREQUENCY_TYPE_IO.DEFAULT_WIDTH + 1 +
1674                                         SOURCE_TYPE_IO.DEFAULT_WIDTH;
1675
1676
1677  DICTIONARY_ENTRY_IO.DEFAULT_WIDTH := 4 * (MAX_STEM_SIZE + 1) +
1678                           PART_ENTRY_IO.DEFAULT_WIDTH + 1 +
1679                           TRANSLATION_RECORD_IO.DEFAULT_WIDTH + 1 +
1680                           MAX_MEANING_SIZE;
1681
1682--TEXT_IO.PUT_LINE("Initialized  DICTIONARY_PACKAGE");
1683
1684end DICTIONARY_PACKAGE;
1685