philologue/whitakers-words
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
2aab3a784c66a2b4210a4eaee14aa28fd63ba3ce
whitakers-words/inflections_package.adb
Michael Wolf 926705cb97 import from .zip file
2012-05-31 16:45:42 -05:00

2634 lines
67 KiB
Ada
Raw Blame History

with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with PREFACE;
package body INFLECTIONS_PACKAGE is
use TEXT_IO;
function "<" (LEFT, RIGHT : DECN_RECORD) return BOOLEAN is
begin
if LEFT.WHICH < RIGHT.WHICH or else
(LEFT.WHICH = RIGHT.WHICH and then
LEFT.VAR < RIGHT.VAR) then
return TRUE;
else
return FALSE;
end if;
end "<";
function "<" (LEFT, RIGHT : QUALITY_RECORD) return BOOLEAN is
begin
if LEFT.POFS = RIGHT.POFS then
case LEFT.POFS is
when N =>
if LEFT.N.DECL.WHICH < RIGHT.N.DECL.WHICH or else
(LEFT.N.DECL.WHICH = RIGHT.N.DECL.WHICH and then
LEFT.N.DECL.VAR < RIGHT.N.DECL.VAR) or else
(LEFT.N.DECL.WHICH = RIGHT.N.DECL.WHICH and then
LEFT.N.DECL.VAR = RIGHT.N.DECL.VAR and then
LEFT.N.NUMBER < RIGHT.N.NUMBER) or else
(LEFT.N.DECL.WHICH = RIGHT.N.DECL.WHICH and then
LEFT.N.DECL.VAR = RIGHT.N.DECL.VAR and then
LEFT.N.NUMBER = RIGHT.N.NUMBER and then
LEFT.N.CS < RIGHT.N.CS) or else
(LEFT.N.DECL.WHICH = RIGHT.N.DECL.WHICH and then
LEFT.N.DECL.VAR = RIGHT.N.DECL.VAR and then
LEFT.N.NUMBER = RIGHT.N.NUMBER and then
LEFT.N.CS = RIGHT.N.CS and then
LEFT.N.GENDER < RIGHT.N.GENDER) then
return TRUE;
end if;
when PRON =>
if LEFT.PRON.DECL.WHICH < RIGHT.PRON.DECL.WHICH or else
(LEFT.PRON.DECL.WHICH = RIGHT.PRON.DECL.WHICH and then
LEFT.PRON.DECL.VAR < RIGHT.PRON.DECL.VAR) or else
(LEFT.PRON.DECL.WHICH = RIGHT.PRON.DECL.WHICH and then
LEFT.PRON.DECL.VAR = RIGHT.PRON.DECL.VAR and then
LEFT.PRON.NUMBER < RIGHT.PRON.NUMBER) or else
(LEFT.PRON.DECL.WHICH = RIGHT.PRON.DECL.WHICH and then
LEFT.PRON.DECL.VAR = RIGHT.PRON.DECL.VAR and then
LEFT.PRON.NUMBER = RIGHT.PRON.NUMBER and then
LEFT.PRON.CS < RIGHT.PRON.CS) or else
(LEFT.PRON.DECL.WHICH = RIGHT.PRON.DECL.WHICH and then
LEFT.PRON.DECL.VAR = RIGHT.PRON.DECL.VAR and then
LEFT.PRON.NUMBER = RIGHT.PRON.NUMBER and then
LEFT.PRON.CS = RIGHT.PRON.CS and then
LEFT.PRON.GENDER < RIGHT.PRON.GENDER) then
return TRUE;
end if;
when PACK =>
if LEFT.PACK.DECL.WHICH < RIGHT.PACK.DECL.WHICH or else
(LEFT.PACK.DECL.WHICH = RIGHT.PACK.DECL.WHICH and then
LEFT.PACK.DECL.VAR < RIGHT.PACK.DECL.VAR) or else
(LEFT.PACK.DECL.WHICH = RIGHT.PACK.DECL.WHICH and then
LEFT.PACK.DECL.VAR = RIGHT.PACK.DECL.VAR and then
LEFT.PACK.NUMBER < RIGHT.PACK.NUMBER) or else
(LEFT.PACK.DECL.WHICH = RIGHT.PACK.DECL.WHICH and then
LEFT.PACK.DECL.VAR = RIGHT.PACK.DECL.VAR and then
LEFT.PACK.NUMBER = RIGHT.PACK.NUMBER and then
LEFT.PACK.CS < RIGHT.PACK.CS) or else
(LEFT.PACK.DECL.WHICH = RIGHT.PACK.DECL.WHICH and then
LEFT.PACK.DECL.VAR = RIGHT.PACK.DECL.VAR and then
LEFT.PACK.NUMBER = RIGHT.PACK.NUMBER and then
LEFT.PACK.CS = RIGHT.PACK.CS and then
LEFT.PACK.GENDER < RIGHT.PACK.GENDER) then
return TRUE;
end if;
when ADJ =>
if LEFT.ADJ.DECL.WHICH < RIGHT.ADJ.DECL.WHICH or else
(LEFT.ADJ.DECL.WHICH = RIGHT.ADJ.DECL.WHICH and then
LEFT.ADJ.DECL.VAR < RIGHT.ADJ.DECL.VAR) or else
(LEFT.ADJ.DECL.WHICH = RIGHT.ADJ.DECL.WHICH and then
LEFT.ADJ.DECL.VAR = RIGHT.ADJ.DECL.VAR and then
LEFT.ADJ.NUMBER < RIGHT.ADJ.NUMBER) or else
(LEFT.ADJ.DECL.WHICH = RIGHT.ADJ.DECL.WHICH and then
LEFT.ADJ.DECL.VAR = RIGHT.ADJ.DECL.VAR and then
LEFT.ADJ.NUMBER = RIGHT.ADJ.NUMBER and then
LEFT.ADJ.CS < RIGHT.ADJ.CS) or else
(LEFT.ADJ.DECL.WHICH = RIGHT.ADJ.DECL.WHICH and then
LEFT.ADJ.DECL.VAR = RIGHT.ADJ.DECL.VAR and then
LEFT.ADJ.NUMBER = RIGHT.ADJ.NUMBER and then
LEFT.ADJ.CS = RIGHT.ADJ.CS and then
LEFT.ADJ.GENDER < RIGHT.ADJ.GENDER) or else
(LEFT.ADJ.DECL.WHICH = RIGHT.ADJ.DECL.WHICH and then
LEFT.ADJ.DECL.VAR = RIGHT.ADJ.DECL.VAR and then
LEFT.ADJ.NUMBER = RIGHT.ADJ.NUMBER and then
LEFT.ADJ.CS = RIGHT.ADJ.CS and then
LEFT.ADJ.GENDER = RIGHT.ADJ.GENDER and then
LEFT.ADJ.CO < RIGHT.ADJ.CO) then
return TRUE;
end if;
when ADV =>
return LEFT.ADV.CO < RIGHT.ADV.CO;
when V =>
if (LEFT.V.CON.WHICH < RIGHT.V.CON.WHICH) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR < RIGHT.V.CON.VAR) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR = RIGHT.V.CON.VAR and then
LEFT.V.NUMBER < RIGHT.V.NUMBER) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR = RIGHT.V.CON.VAR and then
LEFT.V.NUMBER = RIGHT.V.NUMBER and then
LEFT.V.TENSE_VOICE_MOOD.TENSE < RIGHT.V.TENSE_VOICE_MOOD.TENSE) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR = RIGHT.V.CON.VAR and then
LEFT.V.NUMBER = RIGHT.V.NUMBER and then
LEFT.V.TENSE_VOICE_MOOD.TENSE = RIGHT.V.TENSE_VOICE_MOOD.TENSE and then
LEFT.V.TENSE_VOICE_MOOD.VOICE < RIGHT.V.TENSE_VOICE_MOOD.VOICE) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR = RIGHT.V.CON.VAR and then
LEFT.V.NUMBER = RIGHT.V.NUMBER and then
LEFT.V.TENSE_VOICE_MOOD.TENSE = RIGHT.V.TENSE_VOICE_MOOD.TENSE and then
LEFT.V.TENSE_VOICE_MOOD.VOICE = RIGHT.V.TENSE_VOICE_MOOD.VOICE and then
LEFT.V.TENSE_VOICE_MOOD.MOOD < RIGHT.V.TENSE_VOICE_MOOD.MOOD ) or else
(LEFT.V.CON.WHICH = RIGHT.V.CON.WHICH and then
LEFT.V.CON.VAR = RIGHT.V.CON.VAR and then
LEFT.V.NUMBER = RIGHT.V.NUMBER and then
LEFT.V.TENSE_VOICE_MOOD.TENSE = RIGHT.V.TENSE_VOICE_MOOD.TENSE and then
LEFT.V.TENSE_VOICE_MOOD.VOICE = RIGHT.V.TENSE_VOICE_MOOD.VOICE and then
LEFT.V.TENSE_VOICE_MOOD.MOOD = RIGHT.V.TENSE_VOICE_MOOD.MOOD and then
LEFT.V.PERSON < RIGHT.V.PERSON) then
return TRUE;
end if;
when VPAR =>
if LEFT.VPAR.CON.WHICH < RIGHT.VPAR.CON.WHICH or else
(LEFT.VPAR.CON.WHICH = RIGHT.VPAR.CON.WHICH and then
LEFT.VPAR.CON.VAR < RIGHT.VPAR.CON.VAR) or else
(LEFT.VPAR.CON.WHICH = RIGHT.VPAR.CON.WHICH and then
LEFT.VPAR.CON.VAR = RIGHT.VPAR.CON.VAR and then
LEFT.VPAR.NUMBER < RIGHT.VPAR.NUMBER) or else
(LEFT.VPAR.CON.WHICH = RIGHT.VPAR.CON.WHICH and then
LEFT.VPAR.CON.VAR = RIGHT.VPAR.CON.VAR and then
LEFT.VPAR.NUMBER = RIGHT.VPAR.NUMBER and then
LEFT.VPAR.CS < RIGHT.VPAR.CS) or else
(LEFT.VPAR.CON.WHICH = RIGHT.VPAR.CON.WHICH and then
LEFT.VPAR.CON.VAR = RIGHT.VPAR.CON.VAR and then
LEFT.VPAR.NUMBER = RIGHT.VPAR.NUMBER and then
LEFT.VPAR.CS = RIGHT.VPAR.CS and then
LEFT.VPAR.GENDER < RIGHT.VPAR.GENDER) then
return TRUE;
end if;
when SUPINE =>
if LEFT.SUPINE.CON.WHICH < RIGHT.SUPINE.CON.WHICH or else
(LEFT.SUPINE.CON.WHICH = RIGHT.SUPINE.CON.WHICH and then
LEFT.SUPINE.CON.VAR < RIGHT.SUPINE.CON.VAR) or else
(LEFT.SUPINE.CON.WHICH = RIGHT.SUPINE.CON.WHICH and then
LEFT.SUPINE.CON.VAR = RIGHT.SUPINE.CON.VAR and then
LEFT.SUPINE.NUMBER < RIGHT.SUPINE.NUMBER) or else
(LEFT.SUPINE.CON.WHICH = RIGHT.SUPINE.CON.WHICH and then
LEFT.SUPINE.CON.VAR = RIGHT.SUPINE.CON.VAR and then
LEFT.SUPINE.NUMBER = RIGHT.SUPINE.NUMBER and then
LEFT.SUPINE.CS < RIGHT.SUPINE.CS) or else
(LEFT.SUPINE.CON.WHICH = RIGHT.SUPINE.CON.WHICH and then
LEFT.SUPINE.CON.VAR = RIGHT.SUPINE.CON.VAR and then
LEFT.SUPINE.NUMBER = RIGHT.SUPINE.NUMBER and then
LEFT.SUPINE.CS = RIGHT.SUPINE.CS and then
LEFT.SUPINE.GENDER < RIGHT.SUPINE.GENDER) then
return TRUE;
end if;
when PREP =>
return LEFT.PREP.OBJ < RIGHT.PREP.OBJ;
when CONJ =>
null;
when INTERJ =>
null;
when NUM =>
if LEFT.NUM.DECL.WHICH < RIGHT.NUM.DECL.WHICH or else
(LEFT.NUM.DECL.WHICH = RIGHT.NUM.DECL.WHICH and then
LEFT.NUM.DECL.VAR < RIGHT.NUM.DECL.VAR) or else
(LEFT.NUM.DECL.WHICH = RIGHT.NUM.DECL.WHICH and then
LEFT.NUM.DECL.VAR = RIGHT.NUM.DECL.VAR and then
LEFT.NUM.NUMBER < RIGHT.NUM.NUMBER) or else
(LEFT.NUM.DECL.WHICH = RIGHT.NUM.DECL.WHICH and then
LEFT.NUM.DECL.VAR = RIGHT.NUM.DECL.VAR and then
LEFT.NUM.NUMBER = RIGHT.NUM.NUMBER and then
LEFT.NUM.CS < RIGHT.NUM.CS) or else
(LEFT.NUM.DECL.WHICH = RIGHT.NUM.DECL.WHICH and then
LEFT.NUM.DECL.VAR = RIGHT.NUM.DECL.VAR and then
LEFT.NUM.NUMBER = RIGHT.NUM.NUMBER and then
LEFT.NUM.CS = RIGHT.NUM.CS and then
LEFT.NUM.GENDER < RIGHT.NUM.GENDER) or else
(LEFT.NUM.DECL.WHICH = RIGHT.NUM.DECL.WHICH and then
LEFT.NUM.DECL.VAR = RIGHT.NUM.DECL.VAR and then
LEFT.NUM.NUMBER = RIGHT.NUM.NUMBER and then
LEFT.NUM.CS = RIGHT.NUM.CS and then
LEFT.NUM.GENDER = RIGHT.NUM.GENDER and then
LEFT.NUM.SORT < RIGHT.NUM.SORT) then
return TRUE;
end if;
when TACKON =>
null;
when PREFIX =>
null;
when SUFFIX =>
null;
when others =>
null;
end case;
else
return LEFT.POFS < RIGHT.POFS;
end if;
return FALSE;
exception
when CONSTRAINT_ERROR =>
return LEFT.POFS < RIGHT.POFS;
end "<";
function "<=" (LEFT, RIGHT : PART_OF_SPEECH_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
(LEFT = PACK and RIGHT = PRON) or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : DECN_RECORD) return BOOLEAN is
begin
if RIGHT = LEFT or else
(RIGHT = DECN_RECORD'(0, 0) and LEFT.WHICH /= 9) or else
RIGHT = DECN_RECORD'(LEFT.WHICH, 0) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : GENDER_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X or else
(RIGHT = C and then (LEFT = M or LEFT = F)) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : CASE_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : NUMBER_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : PERSON_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = 0 then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : COMPARISON_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : TENSE_VOICE_MOOD_RECORD) return BOOLEAN is
begin
if (RIGHT.TENSE = LEFT.TENSE or else
RIGHT.TENSE = X) and then
(RIGHT.VOICE = LEFT.VOICE or else
RIGHT.VOICE = X) and then
(RIGHT.MOOD = LEFT.MOOD or else
RIGHT.MOOD = X) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : NOUN_KIND_TYPE) return BOOLEAN is
begin
if (RIGHT = LEFT or else
RIGHT = X) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : PRONOUN_KIND_TYPE) return BOOLEAN is
begin
if (RIGHT = LEFT or else
RIGHT = X) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : VERB_KIND_TYPE) return BOOLEAN is
begin
if (RIGHT = LEFT or else
RIGHT = X) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : NUMERAL_SORT_TYPE) return BOOLEAN is
begin
if (RIGHT = LEFT or else
RIGHT = X) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : STEM_KEY_TYPE) return BOOLEAN is
begin -- Only works for 2 stem parts, not verbs
if (RIGHT = LEFT or else
RIGHT = 0) then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : AGE_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
function "<=" (LEFT, RIGHT : FREQUENCY_TYPE) return BOOLEAN is
begin
if RIGHT = LEFT or else
RIGHT = X then
return TRUE;
else
return FALSE;
end if;
end "<=";
package body STEM_TYPE_IO is
procedure GET(F : in FILE_TYPE; D : out STEM_TYPE) is
C : CHARACTER := ' ';
begin
D := NULL_STEM_TYPE;
for I in 1..STEM_TYPE_IO.DEFAULT_WIDTH loop
GET(F, C);
if (C not in 'A'..'Z') and (C not in 'a'..'z') then
exit;
else
D(I) := C;
end if;
end loop;
end GET;
procedure GET(D : out STEM_TYPE) is
C : CHARACTER := ' ';
begin
D := NULL_STEM_TYPE;
for I in 1..STEM_TYPE_IO.DEFAULT_WIDTH loop
TEXT_IO.GET(C);
if (C not in 'A'..'Z') and (C not in 'a'..'z') then
exit;
else
D(I) := C;
end if;
end loop;
end GET;
procedure PUT(F : in FILE_TYPE; D : in STEM_TYPE) is
begin
TEXT_IO.PUT(F, D);
end PUT;
procedure PUT(D : in STEM_TYPE) is
begin
TEXT_IO.PUT(D);
end PUT;
procedure GET(S : in STRING; D : out STEM_TYPE;
LAST : out INTEGER) is
C : CHARACTER;
begin
D := NULL_STEM_TYPE;
LAST := 0;
for I in 1..STEM_TYPE_IO.DEFAULT_WIDTH loop
C := S(I);
if (C not in 'A'..'Z') and (C not in 'a'..'z') then
exit;
else
D(I) := C;
LAST := I;
end if;
end loop;
end GET;
procedure PUT(S : out STRING; D : in STEM_TYPE) is
begin
S(S'FIRST..S'FIRST+STEM_TYPE_IO.DEFAULT_WIDTH-1) := D;
end PUT;
end STEM_TYPE_IO;
package body DECN_RECORD_IO is
-- This package will carry the documentation for all the following packages
-- Must have "use" for _IO for each of the components of the record
use INTEGER_IO;
-- This is a dummy used to GET the space character PUT between components
SPACER : CHARACTER := ' ';
-- The standard 6 procedures are defined as in TEXT_IO
procedure GET(F : in FILE_TYPE; D : out DECN_RECORD) is
-- Get from a file
begin
-- Get the first component
GET(F, D.WHICH);
-- Then Get (and ignore) space character which is Put between components
GET(F, SPACER);
-- Get the next component
GET(F, D.VAR);
end GET;
procedure GET(D : out DECN_RECORD) is
-- Get from the current input, in the same manner
begin
GET(D.WHICH);
GET(SPACER);
GET(D.VAR);
end GET;
procedure PUT(F : in FILE_TYPE; D : in DECN_RECORD) is
-- Put to a file
begin
-- Put the first component, with whatever Put is applicable (and use'd)
PUT(F, D.WHICH, 1);
-- Put the blank character between components
PUT(F, ' ');
-- Put the next component
PUT(F, D.VAR, 1);
end PUT;
procedure PUT(D : in DECN_RECORD) is
-- Likewise for Put to current output
begin
PUT(D.WHICH, 1);
PUT(' ');
PUT(D.VAR, 1);
end PUT;
procedure GET(S : in STRING;
D : out DECN_RECORD; LAST : out INTEGER) is
-- Get from a string
-- Initialize the string position parameter
-- Make it first-1 so the first string specification looks like later ones
L : INTEGER := S'FIRST - 1;
begin
-- Get with the use'd _IO package the first component
GET(S(L+1..S'LAST), D.WHICH, L);
-- The L is the last position read, so add one to skip the spacer
L := L + 1;
-- Get the next component
GET(S(L+1..S'LAST), D.VAR, LAST);
end GET;
procedure PUT(S : out STRING; D : in DECN_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
-- Make a place the DEFAULT_WIDTH of the component to be Put
-- The DEFAULT_WIDTH has been set for these _IO packages to be
-- the LONGEST component width, not the normal Ada default
M := L + 1; -- But WHICH is to be PUT WIDTH 1
-- Put onto the substring that is exactly the DEFAULT (LONGEST) size
PUT(S(L+1..M), D.WHICH);
-- Advance the position by 1 to the position to make the blank
L := M + 1;
-- Write the blank
S(L) := ' ';
-- Calculate the next substring, of DEFAULT_WIDTH for next component
M := L + 1;
-- Put the next component
PUT(S(L+1..M), D.VAR);
-- The following may be necessary to fill the out string
-- but usually the out string has been specified exactly
S(M+1..S'LAST) := (others => ' ');
end PUT;
end DECN_RECORD_IO;
package body TENSE_VOICE_MOOD_RECORD_IO is
use TENSE_TYPE_IO;
use VOICE_TYPE_IO;
use MOOD_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; T : out TENSE_VOICE_MOOD_RECORD) is
begin
GET(F, T.TENSE);
GET(F, SPACER);
GET(F, T.VOICE);
GET(F, SPACER);
GET(F, T.MOOD);
end GET;
procedure GET(T : out TENSE_VOICE_MOOD_RECORD) is
begin
GET(T.TENSE);
GET(SPACER);
GET(T.VOICE);
GET(SPACER);
GET(T.MOOD);
end GET;
procedure PUT(F : in FILE_TYPE; T : in TENSE_VOICE_MOOD_RECORD) is
begin
PUT(F, T.TENSE);
PUT(F, ' ');
PUT(F, T.VOICE);
PUT(F, ' ');
PUT(F, T.MOOD);
end PUT;
procedure PUT(T : in TENSE_VOICE_MOOD_RECORD) is
begin
PUT(T.TENSE);
PUT(' ');
PUT(T.VOICE);
PUT(' ');
PUT(T.MOOD);
end PUT;
procedure GET(S : in STRING;
T : out TENSE_VOICE_MOOD_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), T.TENSE, L);
L := L + 1;
GET(S(L+1..S'LAST), T.VOICE, L);
L := L + 1;
GET(S(L+1..S'LAST), T.MOOD, LAST);
end GET;
procedure PUT(S : out STRING; T : in TENSE_VOICE_MOOD_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + TENSE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), T.TENSE);
L := M + 1;
S(L) := ' ';
M := L + VOICE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), T.VOICE);
L := M + 1;
S(L) := ' ';
M := L + MOOD_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), T.MOOD);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end TENSE_VOICE_MOOD_RECORD_IO;
package body NOUN_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use GENDER_TYPE_IO;
use NUMBER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; N : out NOUN_RECORD) is
begin
GET(F, N.DECL);
GET(F, SPACER);
GET(F, N.CS);
GET(F, SPACER);
GET(F, N.NUMBER);
GET(F, SPACER);
GET(F, N.GENDER);
end GET;
procedure GET(N : out NOUN_RECORD) is
begin
GET(N.DECL);
GET(SPACER);
GET(N.CS);
GET(SPACER);
GET(N.NUMBER);
GET(SPACER);
GET(N.GENDER);
end GET;
procedure PUT(F : in FILE_TYPE; N : in NOUN_RECORD) is
begin
PUT(F, N.DECL);
PUT(F, ' ');
PUT(F, N.CS);
PUT(F, ' ');
PUT(F, N.NUMBER);
PUT(F, ' ');
PUT(F, N.GENDER);
end PUT;
procedure PUT(N : in NOUN_RECORD) is
begin
PUT(N.DECL);
PUT(' ');
PUT(N.CS);
PUT(' ');
PUT(N.NUMBER);
PUT(' ');
PUT(N.GENDER);
end PUT;
procedure GET(S : in STRING; N : out NOUN_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), N.DECL, L);
L := L + 1;
GET(S(L+1..S'LAST), N.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), N.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), N.GENDER, LAST);
end GET;
procedure PUT(S : out STRING; N : in NOUN_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), N.DECL);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), N.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), N.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), N.GENDER);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end NOUN_RECORD_IO;
package body PRONOUN_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use GENDER_TYPE_IO;
use NUMBER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; P : out PRONOUN_RECORD) is
begin
GET(F, P.DECL);
GET(F, SPACER);
GET(F, P.CS);
GET(F, SPACER);
GET(F, P.NUMBER);
GET(F, SPACER);
GET(F, P.GENDER);
end GET;
procedure GET(P : out PRONOUN_RECORD) is
begin
GET(P.DECL);
GET(SPACER);
GET(P.CS);
GET(SPACER);
GET(P.NUMBER);
GET(SPACER);
GET(P.GENDER);
end GET;
procedure PUT(F : in FILE_TYPE; P : in PRONOUN_RECORD) is
begin
PUT(F, P.DECL);
PUT(F, ' ');
PUT(F, P.CS);
PUT(F, ' ');
PUT(F, P.NUMBER);
PUT(F, ' ');
PUT(F, P.GENDER);
end PUT;
procedure PUT(P : in PRONOUN_RECORD) is
begin
PUT(P.DECL);
PUT(' ');
PUT(P.CS);
PUT(' ');
PUT(P.NUMBER);
PUT(' ');
PUT(P.GENDER);
end PUT;
procedure GET(S : in STRING; P : out PRONOUN_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), P.DECL, L);
L := L + 1;
GET(S(L+1..S'LAST), P.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), P.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), P.GENDER, LAST);
end GET;
procedure PUT(S : out STRING; P : in PRONOUN_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.DECL);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.GENDER);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end PRONOUN_RECORD_IO;
package body PROPACK_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use NUMBER_TYPE_IO;
use GENDER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; P : out PROPACK_RECORD) is
begin
GET(F, P.DECL);
GET(F, SPACER);
GET(F, P.CS);
GET(F, SPACER);
GET(F, P.NUMBER);
GET(F, SPACER);
GET(F, P.GENDER);
end GET;
procedure GET(P : out PROPACK_RECORD) is
begin
GET(P.DECL);
GET(SPACER);
GET(P.CS);
GET(SPACER);
GET(P.NUMBER);
GET(SPACER);
GET(P.GENDER);
end GET;
procedure PUT(F : in FILE_TYPE; P : in PROPACK_RECORD) is
begin
PUT(F, P.DECL);
PUT(F, ' ');
PUT(F, P.CS);
PUT(F, ' ');
PUT(F, P.NUMBER);
PUT(F, ' ');
PUT(F, P.GENDER);
end PUT;
procedure PUT(P : in PROPACK_RECORD) is
begin
PUT(P.DECL);
PUT(' ');
PUT(P.CS);
PUT(' ');
PUT(P.NUMBER);
PUT(' ');
PUT(P.GENDER);
end PUT;
procedure GET(S : in STRING; P : out PROPACK_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), P.DECL, L);
L := L + 1;
GET(S(L+1..S'LAST), P.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), P.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), P.GENDER, LAST);
end GET;
procedure PUT(S : out STRING; P : in PROPACK_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.DECL);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.GENDER);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end PROPACK_RECORD_IO;
package body ADJECTIVE_RECORD_IO is
use DECN_RECORD_IO;
use GENDER_TYPE_IO;
use CASE_TYPE_IO;
use NUMBER_TYPE_IO;
use COMPARISON_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; A : out ADJECTIVE_RECORD) is
begin
GET(F, A.DECL);
GET(F, SPACER);
GET(F, A.CS);
GET(F, SPACER);
GET(F, A.NUMBER);
GET(F, SPACER);
GET(F, A.GENDER);
GET(F, SPACER);
GET(F, A.CO);
end GET;
procedure GET(A : out ADJECTIVE_RECORD) is
begin
GET(A.DECL);
GET(SPACER);
GET(A.CS);
GET(SPACER);
GET(A.NUMBER);
GET(SPACER);
GET(A.GENDER);
GET(SPACER);
GET(A.CO);
end GET;
procedure PUT(F : in FILE_TYPE; A : in ADJECTIVE_RECORD) is
begin
PUT(F, A.DECL);
PUT(F, ' ');
PUT(F, A.CS);
PUT(F, ' ');
PUT(F, A.NUMBER);
PUT(F, ' ');
PUT(F, A.GENDER);
PUT(F, ' ');
PUT(F, A.CO);
end PUT;
procedure PUT(A : in ADJECTIVE_RECORD) is
begin
PUT(A.DECL);
PUT(' ');
PUT(A.CS);
PUT(' ');
PUT(A.NUMBER);
PUT(' ');
PUT(A.GENDER);
PUT(' ');
PUT(A.CO);
end PUT;
procedure GET(S : in STRING; A : out ADJECTIVE_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), A.DECL, L);
L := L + 1;
GET(S(L+1..S'LAST), A.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), A.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), A.GENDER, L);
L := L + 1;
GET(S(L+1..S'LAST), A.CO, LAST);
end GET;
procedure PUT(S : out STRING; A : in ADJECTIVE_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.DECL);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.GENDER);
L := M + 1;
S(L) := ' ';
M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.CO);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end ADJECTIVE_RECORD_IO;
package body NUMERAL_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use NUMBER_TYPE_IO;
use GENDER_TYPE_IO;
use NUMERAL_SORT_TYPE_IO;
use GENDER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; NUM : out NUMERAL_RECORD) is
begin
GET(F, NUM.DECL);
GET(F, SPACER);
GET(F, NUM.CS);
GET(F, SPACER);
GET(F, NUM.NUMBER);
GET(F, SPACER);
GET(F, NUM.GENDER);
GET(F, SPACER);
GET(F, NUM.SORT);
end GET;
procedure GET(NUM : out NUMERAL_RECORD) is
begin
GET(NUM.DECL);
GET(SPACER);
GET(SPACER);
GET(NUM.NUMBER);
GET(SPACER);
GET(NUM.GENDER);
GET(SPACER);
GET(NUM.SORT);
end GET;
procedure PUT(F : in FILE_TYPE; NUM : in NUMERAL_RECORD) is
begin
PUT(F, NUM.DECL);
PUT(F, ' ');
PUT(F, NUM.CS);
PUT(F, ' ');
PUT(F, NUM.NUMBER);
PUT(F, ' ');
PUT(F, NUM.GENDER);
PUT(F, ' ');
PUT(F, NUM.SORT);
end PUT;
procedure PUT(NUM : in NUMERAL_RECORD) is
begin
PUT(NUM.DECL);
PUT(' ');
PUT(NUM.CS);
PUT(' ');
PUT(NUM.NUMBER);
PUT(' ');
PUT(NUM.GENDER);
PUT(' ');
PUT(NUM.SORT);
end PUT;
procedure GET(S : in STRING; NUM : out NUMERAL_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), NUM.DECL, L);
L := L + 1;
GET(S(L+1..S'LAST), NUM.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), NUM.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), NUM.GENDER, L);
L := L + 1;
GET(S(L+1..S'LAST), NUM.SORT, LAST);
end GET;
procedure PUT(S : out STRING; NUM : in NUMERAL_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), NUM.DECL);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), NUM.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), NUM.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), NUM.GENDER);
L := M + 1;
S(L) := ' ';
M := L + NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), NUM.SORT);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end NUMERAL_RECORD_IO;
package body ADVERB_RECORD_IO is
use COMPARISON_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; A : out ADVERB_RECORD) is
begin
GET(F, A.CO);
end GET;
procedure GET(A : out ADVERB_RECORD) is
begin
GET(A.CO);
end GET;
procedure PUT(F : in FILE_TYPE; A : in ADVERB_RECORD) is
begin
PUT(F, A.CO);
end PUT;
procedure PUT(A : in ADVERB_RECORD) is
begin
PUT(A.CO);
end PUT;
procedure GET(S : in STRING; A : out ADVERB_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), A.CO, LAST);
end GET;
procedure PUT(S : out STRING; A : in ADVERB_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + COMPARISON_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), A.CO);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end ADVERB_RECORD_IO;
package body VERB_RECORD_IO is
use DECN_RECORD_IO;
use TENSE_VOICE_MOOD_RECORD_IO;
use PERSON_TYPE_IO;
use NUMBER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; V : out VERB_RECORD) is
begin
GET(F, V.CON);
GET(F, SPACER);
GET(F, V.TENSE_VOICE_MOOD);
GET(F, SPACER);
GET(F, V.PERSON);
GET(F, SPACER);
GET(F, V.NUMBER);
end GET;
procedure GET(V : out VERB_RECORD) is
begin
GET(V.CON);
GET(SPACER);
GET(V.TENSE_VOICE_MOOD);
GET(SPACER);
GET(V.PERSON);
GET(SPACER);
GET(V.NUMBER);
end GET;
procedure PUT(F : in FILE_TYPE; V : in VERB_RECORD) is
begin
PUT(F, V.CON);
PUT(F, ' ');
PUT(F, V.TENSE_VOICE_MOOD);
PUT(F, ' ');
PUT(F, V.PERSON);
PUT(F, ' ');
PUT(F, V.NUMBER);
end PUT;
procedure PUT(V : in VERB_RECORD) is
begin
PUT(V.CON);
PUT(' ');
PUT(V.TENSE_VOICE_MOOD);
PUT(' ');
PUT(V.PERSON);
PUT(' ');
PUT(V.NUMBER);
end PUT;
procedure GET(S : in STRING; V : out VERB_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), V.CON, L);
L := L + 1;
GET(S(L+1..S'LAST), V.TENSE_VOICE_MOOD, L);
L := L + 1;
GET(S(L+1..S'LAST), V.PERSON, L);
L := L + 1;
GET(S(L+1..S'LAST), V.NUMBER, LAST);
end GET;
procedure PUT(S : out STRING; V : in VERB_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), V.CON);
L := M + 1;
S(L) := ' ';
M := L + TENSE_VOICE_MOOD_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), V.TENSE_VOICE_MOOD);
L := M + 1;
S(L) := ' ';
M := L + PERSON_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), V.PERSON);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), V.NUMBER);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end VERB_RECORD_IO;
package body VPAR_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use NUMBER_TYPE_IO;
use GENDER_TYPE_IO;
use TENSE_VOICE_MOOD_RECORD_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; VP : out VPAR_RECORD) is
begin
GET(F, VP.CON);
GET(F, SPACER);
GET(F, VP.CS);
GET(F, SPACER);
GET(F, VP.NUMBER);
GET(F, SPACER);
GET(F, VP.GENDER);
GET(F, SPACER);
GET(F, VP.TENSE_VOICE_MOOD);
end GET;
procedure GET(VP : out VPAR_RECORD) is
begin
GET(VP.CON);
GET(SPACER);
GET(VP.CS);
GET(SPACER);
GET(VP.NUMBER);
GET(SPACER);
GET(VP.GENDER);
GET(SPACER);
GET(VP.TENSE_VOICE_MOOD);
end GET;
procedure PUT(F : in FILE_TYPE; VP : in VPAR_RECORD) is
begin
PUT(F, VP.CON);
PUT(F, ' ');
PUT(F, VP.CS);
PUT(F, ' ');
PUT(F, VP.NUMBER);
PUT(F, ' ');
PUT(F, VP.GENDER);
PUT(F, ' ');
PUT(F, VP.TENSE_VOICE_MOOD);
end PUT;
procedure PUT(VP : in VPAR_RECORD) is
begin
PUT(VP.CON);
PUT(' ');
PUT(VP.CS);
PUT(' ');
PUT(VP.NUMBER);
PUT(' ');
PUT(VP.GENDER);
PUT(' ');
PUT(VP.TENSE_VOICE_MOOD);
end PUT;
procedure GET(S : in STRING; VP : out VPAR_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), VP.CON, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.GENDER, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.TENSE_VOICE_MOOD, LAST);
end GET;
procedure PUT(S : out STRING; VP : in VPAR_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.CON);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.GENDER);
L := M + 1;
S(L) := ' ';
M := L + TENSE_VOICE_MOOD_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.TENSE_VOICE_MOOD);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end VPAR_RECORD_IO;
package body SUPINE_RECORD_IO is
use DECN_RECORD_IO;
use CASE_TYPE_IO;
use NUMBER_TYPE_IO;
use GENDER_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; VP : out SUPINE_RECORD) is
begin
GET(F, VP.CON);
GET(F, SPACER);
GET(F, VP.CS);
GET(F, SPACER);
GET(F, VP.NUMBER);
GET(F, SPACER);
GET(F, VP.GENDER);
end GET;
procedure GET(VP : out SUPINE_RECORD) is
begin
GET(VP.CON);
GET(SPACER);
GET(VP.CS);
GET(SPACER);
GET(VP.NUMBER);
GET(SPACER);
GET(VP.GENDER);
end GET;
procedure PUT(F : in FILE_TYPE; VP : in SUPINE_RECORD) is
begin
PUT(F, VP.CON);
PUT(F, ' ');
PUT(F, VP.CS);
PUT(F, ' ');
PUT(F, VP.NUMBER);
PUT(F, ' ');
PUT(F, VP.GENDER);
end PUT;
procedure PUT(VP : in SUPINE_RECORD) is
begin
PUT(VP.CON);
PUT(' ');
PUT(VP.CS);
PUT(' ');
PUT(VP.NUMBER);
PUT(' ');
PUT(VP.GENDER);
end PUT;
procedure GET(S : in STRING; VP : out SUPINE_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), VP.CON, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.CS, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.NUMBER, L);
L := L + 1;
GET(S(L+1..S'LAST), VP.GENDER, LAST);
end GET;
procedure PUT(S : out STRING; VP : in SUPINE_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + DECN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.CON);
L := M + 1;
S(L) := ' ';
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.CS);
L := M + 1;
S(L) := ' ';
M := L + NUMBER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.NUMBER);
L := M + 1;
S(L) := ' ';
M := L + GENDER_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), VP.GENDER);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end SUPINE_RECORD_IO;
package body PREPOSITION_RECORD_IO is
use CASE_TYPE_IO;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; P : out PREPOSITION_RECORD) is
begin
GET(F, P.OBJ);
end GET;
procedure GET(P : out PREPOSITION_RECORD) is
begin
GET(P.OBJ);
end GET;
procedure PUT(F : in FILE_TYPE; P : in PREPOSITION_RECORD) is
begin
PUT(F, P.OBJ);
end PUT;
procedure PUT(P : in PREPOSITION_RECORD) is
begin
PUT(P.OBJ);
end PUT;
procedure GET(S : in STRING; P : out PREPOSITION_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), P.OBJ, LAST);
end GET;
procedure PUT(S : out STRING; P : in PREPOSITION_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + CASE_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.OBJ);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end PREPOSITION_RECORD_IO;
package body CONJUNCTION_RECORD_IO is
NULL_CONJUNCTION_RECORD : CONJUNCTION_RECORD;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; C : out CONJUNCTION_RECORD) is
-- There is actually nothing to a CONJUNCTION_RECORD, no compoonents
begin
C := NULL_CONJUNCTION_RECORD;
end GET;
procedure GET(C : out CONJUNCTION_RECORD) is
begin
C := NULL_CONJUNCTION_RECORD;
end GET;
procedure PUT(F : in FILE_TYPE; C : in CONJUNCTION_RECORD) is
begin
null;
end PUT;
procedure PUT(C : in CONJUNCTION_RECORD) is
begin
null;
end PUT;
procedure GET(S : in STRING; C : out CONJUNCTION_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
C := NULL_CONJUNCTION_RECORD;
LAST := L - 1; -- LAST did not even get to S'FIRST, since nothing to read
end GET;
procedure PUT(S : out STRING; C : in CONJUNCTION_RECORD) is
-- Since there is no component, just make the out string blank
begin
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end CONJUNCTION_RECORD_IO;
package body INTERJECTION_RECORD_IO is
NULL_INTERJECTION_RECORD : INTERJECTION_RECORD;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; I : out INTERJECTION_RECORD) is
begin
I := NULL_INTERJECTION_RECORD;
end GET;
procedure GET(I : out INTERJECTION_RECORD) is
begin
I := NULL_INTERJECTION_RECORD;
end GET;
procedure PUT(F : in FILE_TYPE; I : in INTERJECTION_RECORD) is
begin
null;
end PUT;
procedure PUT(I : in INTERJECTION_RECORD) is
begin
null;
end PUT;
procedure GET(S : in STRING; I : out INTERJECTION_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
I := NULL_INTERJECTION_RECORD;
LAST := L - 1;
end GET;
procedure PUT(S : out STRING; I : in INTERJECTION_RECORD) is
begin
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end INTERJECTION_RECORD_IO;
package body TACKON_RECORD_IO is
NULL_TACKON_RECORD : TACKON_RECORD;
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; I : out TACKON_RECORD) is
begin
I := NULL_TACKON_RECORD;
end GET;
procedure GET(I : out TACKON_RECORD) is
begin
I := NULL_TACKON_RECORD;
end GET;
procedure PUT(F : in FILE_TYPE; I : in TACKON_RECORD) is
begin
null;
end PUT;
procedure PUT(I : in TACKON_RECORD) is
begin
null;
end PUT;
procedure GET(S : in STRING; I : out TACKON_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
I := NULL_TACKON_RECORD;
LAST := L - 1;
end GET;
procedure PUT(S : out STRING; I : in TACKON_RECORD) is
begin
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end TACKON_RECORD_IO;
package body PREFIX_RECORD_IO is
procedure GET(F : in FILE_TYPE; P : out PREFIX_RECORD) is
begin
P := NULL_PREFIX_RECORD;
end GET;
procedure GET(P : out PREFIX_RECORD) is
begin
P := NULL_PREFIX_RECORD;
end GET;
procedure PUT(F : in FILE_TYPE; P : in PREFIX_RECORD) is
begin
null;
end PUT;
procedure PUT(P : in PREFIX_RECORD) is
begin
null;
end PUT;
procedure GET(S : in STRING; P : out PREFIX_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
P := NULL_PREFIX_RECORD;
LAST := L - 1;
end GET;
procedure PUT(S : out STRING; P : in PREFIX_RECORD) is
begin
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end PREFIX_RECORD_IO;
package body SUFFIX_RECORD_IO is
procedure GET(F : in FILE_TYPE; P : out SUFFIX_RECORD) is
begin
P := NULL_SUFFIX_RECORD;
end GET;
procedure GET(P : out SUFFIX_RECORD) is
begin
P := NULL_SUFFIX_RECORD;
end GET;
procedure PUT(F : in FILE_TYPE; P : in SUFFIX_RECORD) is
begin
null;
end PUT;
procedure PUT(P : in SUFFIX_RECORD) is
begin
null;
end PUT;
procedure GET(S : in STRING; P : out SUFFIX_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
P := NULL_SUFFIX_RECORD;
LAST := L - 1;
end GET;
procedure PUT(S : out STRING; P : in SUFFIX_RECORD) is
begin
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end SUFFIX_RECORD_IO;
package body QUALITY_RECORD_IO is
use PART_OF_SPEECH_TYPE_IO;
use NOUN_RECORD_IO;
use PRONOUN_RECORD_IO;
use PROPACK_RECORD_IO;
use ADJECTIVE_RECORD_IO;
use NUMERAL_RECORD_IO;
use ADVERB_RECORD_IO;
use VERB_RECORD_IO;
use VPAR_RECORD_IO;
use SUPINE_RECORD_IO;
use PREPOSITION_RECORD_IO;
use CONJUNCTION_RECORD_IO;
use INTERJECTION_RECORD_IO;
use TACKON_RECORD_IO;
use PREFIX_RECORD_IO;
use SUFFIX_RECORD_IO;
SPACER : CHARACTER := ' ';
NOUN : NOUN_RECORD;
PRONOUN : PRONOUN_RECORD;
PROPACK : PROPACK_RECORD;
ADJECTIVE : ADJECTIVE_RECORD;
ADVERB : ADVERB_RECORD;
VERB : VERB_RECORD;
VPARTICIPLE : VPAR_RECORD;
SUPIN : SUPINE_RECORD;
PREPOSITION : PREPOSITION_RECORD;
CONJUNCTION : CONJUNCTION_RECORD;
INTERJECTION : INTERJECTION_RECORD;
NUMERAL : NUMERAL_RECORD;
TACKN : TACKON_RECORD;
PREFX : PREFIX_RECORD;
SUFFX : SUFFIX_RECORD;
PR : QUALITY_RECORD;
procedure GET(F : in FILE_TYPE; P : out QUALITY_RECORD) is
PS : PART_OF_SPEECH_TYPE := X;
begin
GET(F, PS);
GET(F, SPACER);
case PS is
when N =>
GET(F, NOUN);
P := (N, NOUN);
when PRON =>
GET(F, PRONOUN);
P := (PRON, PRONOUN);
when PACK =>
GET(F, PROPACK);
P := (PACK, PROPACK);
when ADJ =>
GET(F, ADJECTIVE);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(F, NUMERAL);
P := (NUM, NUMERAL);
when ADV =>
GET(F, ADVERB);
P := (ADV, ADVERB);
when V =>
GET(F, VERB);
P := (V, VERB);
when VPAR =>
GET(F, VPARTICIPLE);
P := (VPAR, VPARTICIPLE);
when SUPINE =>
GET(F, SUPIN);
P := (SUPINE, SUPIN);
when PREP =>
GET(F, PREPOSITION);
P := (PREP, PREPOSITION);
when CONJ =>
GET(F, CONJUNCTION);
P := (CONJ, CONJUNCTION);
when INTERJ =>
GET(F, INTERJECTION);
P := (INTERJ, INTERJECTION);
when TACKON =>
GET(F, TACKN);
P := (TACKON, TACKN);
when PREFIX =>
GET(F, PREFX);
P := (PREFIX, PREFX);
when SUFFIX =>
GET(F, SUFFX);
P := (SUFFIX, SUFFX);
when X =>
P := (POFS => X);
end case;
return;
end GET;
procedure GET(P : out QUALITY_RECORD) is
PS : PART_OF_SPEECH_TYPE := X;
begin
GET(PS);
GET(SPACER);
case PS is
when N =>
GET(NOUN);
P := (N, NOUN);
when PRON =>
GET(PRONOUN);
P := (PRON, PRONOUN);
when PACK =>
GET(PROPACK);
P := (PACK, PROPACK);
when ADJ =>
GET(ADJECTIVE);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(NUMERAL);
P := (NUM, NUMERAL);
when ADV =>
GET(ADVERB);
P := (ADV, ADVERB);
when V =>
GET(VERB);
P := (V, VERB);
when VPAR =>
GET(VPARTICIPLE);
P := (VPAR, VPARTICIPLE);
when SUPINE =>
GET(SUPIN);
P := (SUPINE, SUPIN);
when PREP =>
GET(PREPOSITION);
P := (PREP, PREPOSITION);
when CONJ =>
GET(CONJUNCTION);
P := (CONJ, CONJUNCTION);
when INTERJ =>
GET(INTERJECTION);
P := (INTERJ, INTERJECTION);
when TACKON =>
GET(TACKN);
P := (TACKON, TACKN);
when PREFIX =>
GET(PREFX);
P := (PREFIX, PREFX);
when SUFFIX =>
GET(SUFFX);
P := (SUFFIX, SUFFX);
when X =>
P := (POFS => X);
end case;
return;
end GET;
procedure PUT(F : in FILE_TYPE; P : in QUALITY_RECORD) is
C : POSITIVE := POSITIVE(COL(F));
begin
PUT(F, P.POFS);
PUT(F, ' ');
case P.POFS is
when N =>
PUT(F, P.N);
when PRON =>
PUT(F, P.PRON);
when PACK =>
PUT(F, P.PACK);
when ADJ =>
PUT(F, P.ADJ);
when NUM =>
PUT(F, P.NUM);
when ADV =>
PUT(F, P.ADV);
when V =>
PUT(F, P.V);
when VPAR =>
PUT(F, P.VPAR);
when SUPINE =>
PUT(F, P.SUPINE);
when PREP =>
PUT(F, P.PREP);
when CONJ =>
PUT(F, P.CONJ);
when INTERJ =>
PUT(F, P.INTERJ);
when TACKON =>
PUT(F, P.TACKON);
when PREFIX =>
PUT(F, P.PREFIX);
when SUFFIX =>
PUT(F, P.SUFFIX);
when others =>
null;
end case;
PUT(F, STRING'((INTEGER(COL(F))..QUALITY_RECORD_IO.DEFAULT_WIDTH+C-1 => ' ')));
return;
end PUT;
procedure PUT(P : in QUALITY_RECORD) is
C : POSITIVE := POSITIVE(COL);
begin
PUT(P.POFS);
PUT(' ');
case P.POFS is
when N =>
PUT(P.N);
when PRON =>
PUT(P.PRON);
when PACK =>
PUT(P.PACK);
when ADJ =>
PUT(P.ADJ);
when NUM =>
PUT(P.NUM);
when ADV =>
PUT(P.ADV);
when V =>
PUT(P.V);
when VPAR =>
PUT(P.VPAR);
when SUPINE =>
PUT(P.SUPINE);
when PREP =>
PUT(P.PREP);
when CONJ =>
PUT(P.CONJ);
when INTERJ =>
PUT(P.INTERJ);
when TACKON =>
PUT(P.TACKON);
when PREFIX =>
PUT(P.PREFIX);
when SUFFIX =>
PUT(P.SUFFIX);
when others =>
null;
end case;
PUT(STRING'((INTEGER(COL)..QUALITY_RECORD_IO.DEFAULT_WIDTH+C-1 => ' ')));
return;
end PUT;
procedure GET(S : in STRING; P : out QUALITY_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
PS : PART_OF_SPEECH_TYPE := X;
begin
GET(S, PS, L);
LAST := L; -- In case it is not set later
L := L + 1;
case PS is
when N =>
GET(S(L+1..S'LAST), NOUN, LAST);
P := (N, NOUN);
when PRON =>
GET(S(L+1..S'LAST), PRONOUN, LAST);
P := (PRON, PRONOUN);
when PACK =>
GET(S(L+1..S'LAST), PROPACK, LAST);
P := (PACK, PROPACK);
when ADJ =>
GET(S(L+1..S'LAST), ADJECTIVE, LAST);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(S(L+1..S'LAST), NUMERAL, LAST);
P := (NUM, NUMERAL);
when ADV =>
GET(S(L+1..S'LAST), ADVERB, LAST);
P := (ADV, ADVERB);
when V =>
GET(S(L+1..S'LAST), VERB, LAST);
P := (V, VERB);
when VPAR =>
GET(S(L+1..S'LAST), VPARTICIPLE, LAST);
P := (VPAR, VPARTICIPLE);
when SUPINE =>
GET(S(L+1..S'LAST), SUPIN, LAST);
P := (SUPINE, SUPIN);
when PREP =>
GET(S(L+1..S'LAST), PREPOSITION, LAST);
P := (PREP, PREPOSITION);
when CONJ =>
GET(S(L+1..S'LAST), CONJUNCTION, LAST);
P := (CONJ, CONJUNCTION);
when INTERJ =>
GET(S(L+1..S'LAST), INTERJECTION, LAST);
P := (INTERJ, INTERJECTION);
when TACKON =>
GET(S(L+1..S'LAST), TACKN, LAST);
P := (TACKON, TACKN);
when PREFIX =>
GET(S(L+1..S'LAST), PREFX, LAST);
P := (PREFIX, PREFX);
when SUFFIX =>
GET(S(L+1..S'LAST), SUFFX, LAST);
P := (SUFFIX, SUFFX);
when X =>
P := (POFS => X);
end case;
return;
end GET;
procedure PUT(S : out STRING; P : in QUALITY_RECORD) is
-- Note that this does not Put with a uniform width
-- which would require a constant QUALITY_RECORD_IO.DEFAULT_WIDTH
-- Rather we Put to minimal size with NOUN_RECORD_IO.DEFAULT_WIDTH,
-- PRONOUN_RECORD_IO,DEFAULT_WIDTH, ...
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.POFS);
L := M + 1;
S(L) := ' ';
case P.POFS is
when N =>
M := L + NOUN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.N);
when PRON =>
M := L + PRONOUN_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PRON);
when PACK =>
M := L + PROPACK_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PACK);
when ADJ =>
M := L + ADJECTIVE_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ADJ);
when NUM =>
M := L + NUMERAL_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.NUM);
when ADV =>
M := L + ADVERB_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ADV);
when V =>
M := L + VERB_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.V);
when VPAR =>
M := L + VPAR_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.VPAR);
when SUPINE =>
M := L + SUPINE_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.SUPINE);
when PREP =>
M := L + PREPOSITION_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PREP);
when CONJ =>
M := L + CONJUNCTION_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.CONJ);
when INTERJ =>
M := L + INTERJECTION_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.INTERJ);
when TACKON =>
M := L + TACKON_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.TACKON);
when PREFIX =>
M := L + PREFIX_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PREFIX);
when SUFFIX =>
M := L + SUFFIX_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.SUFFIX);
when others =>
null;
end case;
S(M+1..S'LAST) := (others => ' ');
end PUT;
end QUALITY_RECORD_IO;
package body ENDING_RECORD_IO is
use INTEGER_IO;
use TEXT_IO;
SPACER : CHARACTER := ' ';
SF, BLANKS : ENDING := (others => ' ');
N : ENDING_SIZE_TYPE := 0;
procedure GET(F : in FILE_TYPE; X : out ENDING_RECORD) is
begin
SF := BLANKS;
GET(F, N);
if N = 0 then
X := NULL_ENDING_RECORD;
else
GET(F, SPACER); -- Note this means exactly one blank
GET(F, SF(1..N));
X := (N, SF);
end if;
end GET;
procedure GET(X : out ENDING_RECORD) is
begin
SF := BLANKS;
GET(N);
if N = 0 then
X := NULL_ENDING_RECORD;
else
GET(SPACER);
GET(SF(1..N));
X := (N, SF);
end if;
end GET;
procedure PUT(F : in FILE_TYPE; X : in ENDING_RECORD) is
begin
PUT(F, X.SIZE, 1);
PUT(F, ' ');
PUT(F, X.SUF(1..X.SIZE) & BLANKS(X.SIZE+1..MAX_ENDING_SIZE));
end PUT;
procedure PUT(X : in ENDING_RECORD) is
begin
PUT(X.SIZE, 1);
PUT(' ');
PUT(X.SUF(1..X.SIZE) & BLANKS(X.SIZE+1..MAX_ENDING_SIZE));
end PUT;
procedure GET(S : in STRING; X : out ENDING_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
SF := BLANKS;
GET(S(L+1..S'LAST), N, L);
if N = 0 then
X := NULL_ENDING_RECORD;
LAST := L;
else
L := L + 1;
--if S(L+N-1) = ' ' or else
-- S(L+N+1) /= ' ' then
--if
-- S(L+N+1) /= ' ' then
-- TEXT_IO.PUT_LINE("ERROR in INFLECTION =>" & S);
--else
SF := S(L+1..L+N) & BLANKS(N+1..MAX_ENDING_SIZE);
LAST := L + N;
X := (N, SF(1..N) & BLANKS(N+1..MAX_ENDING_SIZE));
--end if;
end if;
exception
when others =>
TEXT_IO.PUT_LINE("ENDING ERRROR " & S);
end GET;
procedure PUT(S : out STRING; X : in ENDING_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + 2;
PUT(S(L+1..M), X.SIZE);
M := M + 1;
S(M) := ' ';
if X.SIZE > 0 then
L := M;
M := L + X.SIZE;
S(L+1..M) := X.SUF(1..X.SIZE);
end if;
-- Being very careful here, first to fill out to the MAX_ENDING_SIZE
L := M;
M := L + MAX_ENDING_SIZE - X.SIZE;
S(L+1..M) := (others => ' ');
-- Then to fill out the rest of the out string, if any
S(M+1..S'LAST) := (others => ' ');
end PUT;
end ENDING_RECORD_IO;
package body INFLECTION_RECORD_IO is
use QUALITY_RECORD_IO;
use STEM_KEY_TYPE_IO;
use ENDING_RECORD_IO;
use AGE_TYPE_IO;
use FREQUENCY_TYPE_IO;
SPACER : CHARACTER := ' ';
PE : INFLECTION_RECORD;
procedure GET(F : in FILE_TYPE; P : out INFLECTION_RECORD) is
begin
GET(F, P.QUAL);
GET(F, SPACER);
GET(F, P.KEY);
GET(F, SPACER);
GET(F, P.ENDING);
GET(F, SPACER);
GET(F, P.AGE);
GET(F, SPACER);
GET(F, P.FREQ);
end GET;
procedure GET(P : out INFLECTION_RECORD) is
begin
GET(P.QUAL);
GET(SPACER);
GET(P.KEY);
GET(SPACER);
GET(P.ENDING);
GET(SPACER);
GET(P.AGE);
GET(SPACER);
GET(P.FREQ);
end GET;
procedure PUT(F : in FILE_TYPE; P : in INFLECTION_RECORD) is
begin
PUT(F, P.QUAL);
PUT(F, ' ');
PUT(F, P.KEY, 1);
PUT(F, ' ');
PUT(F, P.ENDING);
PUT(F, ' ');
PUT(F, P.AGE);
PUT(F, ' ');
PUT(F, P.FREQ);
end PUT;
procedure PUT(P : in INFLECTION_RECORD) is
begin
PUT(P.QUAL);
PUT(' ');
PUT(P.KEY, 1);
PUT(' ');
PUT(P.ENDING);
PUT(' ');
PUT(P.AGE);
PUT(' ');
PUT(P.FREQ);
end PUT;
procedure GET(S : in STRING; P : out INFLECTION_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
LAST := 0;
P := PE;
GET(S(L+1..S'LAST), P.QUAL, L);
L := L + 1;
GET(S(L+1..S'LAST), P.KEY, L);
L := L + 1;
GET(S(L+1..S'LAST), P.ENDING, L);
L := L + 1;
GET(S(L+1..S'LAST), P.AGE, L);
L := L + 1;
GET(S(L+1..S'LAST), P.FREQ, LAST);
end GET;
procedure PUT(S : out STRING; P : in INFLECTION_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + QUALITY_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.QUAL);
L := M + 1;
S(L) := ' ';
M := L + 1;
PUT(S(L+1..M), P.KEY);
L := M + 1;
S(L) := ' ';
M := L + ENDING_RECORD_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ENDING);
L := M + 1;
S(L) := ' ';
M := L + 1;
PUT(S(L+1..M), P.AGE);
L := M + 1;
S(L) := ' ';
M := L + 1;
PUT(S(L+1..M), P.FREQ);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end INFLECTION_RECORD_IO;
procedure ESTABLISH_INFLECTIONS_SECTION is
-- Loads the inflection array from the file prepared in FILE_INFLECTIONS_SECTION
-- If N = 0 (an artifical flag for the section for blank inflections = 5)
-- computes the LELL..LELF indices for use in WORD
use TEXT_IO;
use INFLECTION_RECORD_IO;
use LEL_SECTION_IO;
procedure LOAD_LEL_INDEXES is
-- Load arrays from file
I : INTEGER := 0;
--IR : INFLECTION_RECORD;
N, XN : INTEGER := 0;
CH, XCH : CHARACTER := ' ';
INFLECTIONS_SECTIONS_FILE : LEL_SECTION_IO.FILE_TYPE;
begin
OPEN(INFLECTIONS_SECTIONS_FILE, IN_FILE, INFLECTIONS_SECTIONS_NAME);
NUMBER_OF_INFLECTIONS := 0;
LEL_SECTION_IO.READ(INFLECTIONS_SECTIONS_FILE,
LEL,
LEL_SECTION_IO.POSITIVE_COUNT(5));
I := 1;
BELF(0, ' ') := I;
BELL(0, ' ') := 0;
loop
exit when LEL(I) = NULL_INFLECTION_RECORD;
BEL(I) := LEL(I);
BELL(0, ' ') := I;
I := I + 1;
end loop;
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + I - 1;
LEL_SECTION_IO.READ(INFLECTIONS_SECTIONS_FILE,
LEL,
LEL_SECTION_IO.POSITIVE_COUNT(1));
I := 1;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
XN := N;
XCH := CH;
LELF(N, CH) := I;
C1_LOOP:
loop
N1_LOOP:
loop
exit C1_LOOP when LEL(I) = NULL_INFLECTION_RECORD;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
if CH /= XCH then
LELL(XN, XCH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XCH := CH;
XN := N;
elsif N /= XN then
LELL(XN, CH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XN := N;
exit N1_LOOP;
end if;
I := I + 1;
end loop N1_LOOP;
end loop C1_LOOP;
LELL(XN, XCH) := I - 1;
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + I - 1;
LEL_SECTION_IO.READ(INFLECTIONS_SECTIONS_FILE,
LEL,
LEL_SECTION_IO.POSITIVE_COUNT(2));
I := 1;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
XN := N;
XCH := CH;
LELF(N, CH) := I;
C2_LOOP:
loop
N2_LOOP:
loop
exit C2_LOOP when LEL(I) = NULL_INFLECTION_RECORD;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
exit when CH > 'r';
if CH /= XCH then
LELL(XN, XCH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XCH := CH;
XN := N;
elsif N /= XN then
LELL(XN, CH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XN := N;
exit N2_LOOP;
end if;
I := I + 1;
end loop N2_LOOP;
end loop C2_LOOP;
LELL(XN, XCH) := I - 1;
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + I - 1;
LEL_SECTION_IO.READ(INFLECTIONS_SECTIONS_FILE,
LEL,
LEL_SECTION_IO.POSITIVE_COUNT(3));
I := 1;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
XN := N;
XCH := CH;
LELF(N, CH) := I;
C3_LOOP:
loop
N3_LOOP:
loop
exit C3_LOOP when LEL(I) = NULL_INFLECTION_RECORD;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
exit when CH > 's';
if CH /= XCH then
LELL(XN, XCH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XCH := CH;
XN := N;
elsif N /= XN then
LELL(XN, CH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XN := N;
exit N3_LOOP;
end if;
I := I + 1;
end loop N3_LOOP;
end loop C3_LOOP;
LELL(XN, XCH) := I - 1;
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + I - 1;
LEL_SECTION_IO.READ(INFLECTIONS_SECTIONS_FILE,
LEL,
LEL_SECTION_IO.POSITIVE_COUNT(4));
I := 1;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
XN := N;
XCH := CH;
LELF(N, CH) := I;
C4_LOOP:
loop
N4_LOOP:
loop
exit C4_LOOP when LEL(I).QUAL.POFS = PRON and then
(LEL(I).QUAL.PRON.DECL.WHICH = 1 or
LEL(I).QUAL.PRON.DECL.WHICH = 2);
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
if CH /= XCH then
LELL(XN, XCH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XCH := CH;
XN := N;
elsif N /= XN then
LELL(XN, CH) := I - 1;
LELF(N, CH) := I;
LELL(N, CH) := 0;
XN := N;
exit N4_LOOP;
end if;
I := I + 1;
end loop N4_LOOP;
end loop C4_LOOP;
LELL(XN, XCH) := I - 1;
begin
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
XN := N;
XCH := CH;
PELF(N, CH) := I;
PELL(N, CH) := 0;
C_P_LOOP:
loop
N_P_LOOP:
loop
exit C_P_LOOP when LEL(I) = NULL_INFLECTION_RECORD;
N := LEL(I).ENDING.SIZE;
CH := LEL(I).ENDING.SUF(N);
if CH /= XCH then
PELL(XN, XCH) := I - 1;
PELF(N, CH) := I;
PELL(N, CH) := 0;
XCH := CH;
XN := N;
elsif N /= XN then
PELL(XN, CH) := I - 1;
PELF(N, CH) := I;
PELL(N, CH) := 0;
XN := N;
exit N_P_LOOP;
end if;
I := I + 1;
end loop N_P_LOOP;
end loop C_P_LOOP;
exception
when CONSTRAINT_ERROR => null;
end;
PELL(XN, XCH) := I - 1;
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + I - 1;
CLOSE(INFLECTIONS_SECTIONS_FILE);
end LOAD_LEL_INDEXES;
begin
PREFACE.PUT("INFLECTION_ARRAY being loaded");
PREFACE.SET_COL(33);
PREFACE.PUT("-- ");
LOAD_LEL_INDEXES; -- Makes indexes from array
PREFACE.PUT(NUMBER_OF_INFLECTIONS, 6);
PREFACE.PUT(" entries");
PREFACE.SET_COL(55); PREFACE.PUT_LINE("-- Loaded correctly");
exception
when Text_IO.Name_Error =>
NEW_LINE;
PUT_LINE("There is no " & INFLECTIONS_SECTIONS_NAME & " file.");
PUT_LINE("The program cannot work without one.");
PUT_LINE("Make sure you are in the subdirectory containing the files");
PUT_LINE("for inflections, dictionary, addons and uniques.");
raise GIVE_UP;
end ESTABLISH_INFLECTIONS_SECTION;
begin -- initialization of body of INFLECTIONS_PACKAGE
--TEXT_IO.PUT_LINE("Initializing INFLECTIONS_PACKAGE");
PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE'WIDTH;
GENDER_TYPE_IO.DEFAULT_WIDTH := GENDER_TYPE'WIDTH;
CASE_TYPE_IO.DEFAULT_WIDTH := CASE_TYPE'WIDTH;
NUMBER_TYPE_IO.DEFAULT_WIDTH := NUMBER_TYPE'WIDTH;
PERSON_TYPE_IO.DEFAULT_WIDTH := 1;
COMPARISON_TYPE_IO.DEFAULT_WIDTH := COMPARISON_TYPE'WIDTH;
TENSE_TYPE_IO.DEFAULT_WIDTH := TENSE_TYPE'WIDTH;
VOICE_TYPE_IO.DEFAULT_WIDTH := VOICE_TYPE'WIDTH;
MOOD_TYPE_IO.DEFAULT_WIDTH := MOOD_TYPE'WIDTH;
NOUN_KIND_TYPE_IO.DEFAULT_WIDTH := NOUN_KIND_TYPE'WIDTH;
PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH := PRONOUN_KIND_TYPE'WIDTH;
VERB_KIND_TYPE_IO.DEFAULT_WIDTH := VERB_KIND_TYPE'WIDTH;
NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH := NUMERAL_SORT_TYPE'WIDTH;
AGE_TYPE_IO.DEFAULT_WIDTH := AGE_TYPE'WIDTH;
FREQUENCY_TYPE_IO.DEFAULT_WIDTH := FREQUENCY_TYPE'WIDTH;
DECN_RECORD_IO.DEFAULT_WIDTH :=
1 + 1 + --WHICH_TYPE_IO_DEFAULT_WIDTH + 1 +
1; --VARIANT_TYPE_IO_DEFAULT_WIDTH;
TENSE_VOICE_MOOD_RECORD_IO.DEFAULT_WIDTH :=
TENSE_TYPE_IO.DEFAULT_WIDTH + 1 +
VOICE_TYPE_IO.DEFAULT_WIDTH + 1 +
MOOD_TYPE_IO.DEFAULT_WIDTH;
NOUN_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH;
PRONOUN_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH;
PROPACK_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH;
ADJECTIVE_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH + 1 +
COMPARISON_TYPE_IO.DEFAULT_WIDTH;
ADVERB_RECORD_IO.DEFAULT_WIDTH :=
COMPARISON_TYPE_IO.DEFAULT_WIDTH;
VERB_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
TENSE_VOICE_MOOD_RECORD_IO.DEFAULT_WIDTH + 1 +
PERSON_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH;
VPAR_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH + 1 +
TENSE_VOICE_MOOD_RECORD_IO.DEFAULT_WIDTH;
SUPINE_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH;
PREPOSITION_RECORD_IO.DEFAULT_WIDTH := CASE_TYPE_IO.DEFAULT_WIDTH;
CONJUNCTION_RECORD_IO.DEFAULT_WIDTH := 0;
INTERJECTION_RECORD_IO.DEFAULT_WIDTH := 0;
NUMERAL_RECORD_IO.DEFAULT_WIDTH :=
DECN_RECORD_IO.DEFAULT_WIDTH + 1 +
CASE_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMBER_TYPE_IO.DEFAULT_WIDTH + 1 +
GENDER_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMERAL_SORT_TYPE_IO.DEFAULT_WIDTH;
TACKON_RECORD_IO.DEFAULT_WIDTH := 0;
PREFIX_RECORD_IO.DEFAULT_WIDTH := 0;
SUFFIX_RECORD_IO.DEFAULT_WIDTH := 0;
QUALITY_RECORD_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 +
VPAR_RECORD_IO.DEFAULT_WIDTH; -- Largest
ENDING_RECORD_IO.DEFAULT_WIDTH := 3 + 1 +
MAX_ENDING_SIZE;
INFLECTION_RECORD_IO.DEFAULT_WIDTH := QUALITY_RECORD_IO.DEFAULT_WIDTH + 1 +
1 + 1 +
ENDING_RECORD_IO.DEFAULT_WIDTH + 1 +
AGE_TYPE_IO.DEFAULT_WIDTH + 1 +
FREQUENCY_TYPE_IO.DEFAULT_WIDTH;
end INFLECTIONS_PACKAGE;
Reference in New Issue View Git Blame Copy Permalink