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

1193 lines
45 KiB
Ada
Raw Blame History

with TEXT_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with WORD_PARAMETERS; use WORD_PARAMETERS;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
with ADDONS_PACKAGE; use ADDONS_PACKAGE;
with WORD_SUPPORT_PACKAGE; use WORD_SUPPORT_PACKAGE;
with PREFACE;
with WORD_PACKAGE; use WORD_PACKAGE;
with LIST_PACKAGE; use LIST_PACKAGE;
with TRICKS_PACKAGE; use TRICKS_PACKAGE;
with CONFIG; use CONFIG;
with PREFACE;
with PUT_STAT;
with ENGLISH_SUPPORT_PACKAGE; use ENGLISH_SUPPORT_PACKAGE;
with SEARCH_ENGLISH;
pragma Elaborate(WORD_PARAMETERS);
procedure PARSE(COMMAND_LINE : STRING := "") is
use INFLECTIONS_PACKAGE.INTEGER_IO;
use INFLECTION_RECORD_IO;
use TEXT_IO;
STORAGE_ERROR_COUNT : INTEGER := 0;
J, K, L : INTEGER := 0;
LINE, BLANK_LINE : STRING(1..2500) := (others => ' ');
--INPUT : TEXT_IO.FILE_TYPE;
PA : PARSE_ARRAY(1..100) := (others => NULL_PARSE_RECORD);
SYNCOPE_MAX : constant := 20;
NO_SYNCOPE : BOOLEAN := FALSE;
TRICKS_MAX : constant := 40;
SYPA : PARSE_ARRAY(1..SYNCOPE_MAX) := (others => NULL_PARSE_RECORD);
TRPA : PARSE_ARRAY(1..TRICKS_MAX) := (others => NULL_PARSE_RECORD);
PA_LAST, SYPA_LAST, TRPA_LAST : INTEGER := 0;
procedure PARSE_LINE(INPUT_LINE : STRING) is
L : INTEGER := TRIM(INPUT_LINE)'LAST;
--LINE : STRING(1..2500) := (others => ' ');
W : STRING(1..L) := (others => ' ');
begin
WORD_NUMBER := 0;
LINE(1..L) := TRIM(INPUT_LINE);
-- Someday I ought to be interested in punctuation and numbers, but not now
ELIMINATE_NOT_LETTERS:
begin
for I in 1..L loop
if ((LINE(I) in 'A'..'Z') or
(LINE(I) = '-') or -- For the comment
(LINE(I) = '.') or -- Catch period later
(LINE(I) in 'a'..'z')) then
null;
else
LINE(I) := ' ';
end if;
end loop;
end ELIMINATE_NOT_LETTERS;
J := 1;
K := 0;
OVER_LINE:
while J <= L loop
-- Skip over leading and intervening blanks, looking for comments
-- Punctuation, numbers, and special characters were cleared above
for I in K+1..L loop
exit when LINE(J) in 'A'..'Z';
exit when LINE(J) in 'a'..'z';
if I < L and then
LINE(I..I+1) = "--" then
exit OVER_LINE; -- the rest of the line is comment
end if;
J := I + 1;
end loop;
exit when J > L; -- Kludge
FOLLOWS_PERIOD := FALSE;
if FOLLOWED_BY_PERIOD then
FOLLOWED_BY_PERIOD := FALSE;
FOLLOWS_PERIOD := TRUE;
end if;
CAPITALIZED := FALSE;
ALL_CAPS := FALSE;
-- Extract the word
for I in J..L loop
-- Although I have removed punctuation above, it may not always be so
if LINE(I) = '.' then
FOLLOWED_BY_PERIOD := TRUE;
exit;
end if;
-- exit when (LINE(I) = ' ' or LINE(I) = ',' or LINE(I) = '-'
-- or LINE(I) = ';' or LINE(I) = ':'
-- or LINE(I) = '(' or LINE(I) = '[' or LINE(I) = '{' or LINE(I) = '<'
-- or LINE(I) = ')' or LINE(I) = ']' or LINE(I) = '}' or LINE(I) = '>'
-- or (CHARACTER'POS(LINE(I)) < 32) or (CHARACTER'POS(LINE(I)) > 127) );
exit when ((LINE(I) not in 'A'..'Z') and (LINE(I) not in 'a'..'z'));
W(I) := LINE(I);
K := I;
end loop;
if W(J) in 'A'..'Z' and then
K - J >= 1 and then
W(J+1) in 'a'..'z' then
CAPITALIZED := TRUE;
end if;
ALL_CAPS := TRUE;
for I in J..K loop
if W(I) = LOWER_CASE(W(I)) then
ALL_CAPS := FALSE;
exit;
end if;
end loop;
for I in J..K-1 loop -- Kludge for QVAE
if W(I) = 'Q' and then W(I+1) = 'V' then
W(I+1) := 'U';
end if;
end loop;
if LANGUAGE = ENGLISH_TO_LATIN then
PARSE_LINE_ENGLISH_TO_LATIN:
-- Since we do only one English word per line
declare
INPUT_WORD : constant STRING := W(J..K);
POFS : PART_OF_SPEECH_TYPE := X;
begin
-- Extract from the rest of the line
-- Should do AUX here !!!!!!!!!!!!!!!!!!!!!!!!
EXTRACT_POFS:
begin
PART_OF_SPEECH_TYPE_IO.GET(LINE(K+1..L), POFS, L);
--TEXT_IO.PUT_LINE("In EXTRACT " & LINE(K+1..L));
exception
when others =>
POFS := X;
end EXTRACT_POFS;
--PART_OF_SPEECH_TYPE_IO.PUT(POFS);
--TEXT_IO.NEW_LINE;
SEARCH_ENGLISH(INPUT_WORD, POFS);
exit OVER_LINE;
end PARSE_LINE_ENGLISH_TO_LATIN;
elsif LANGUAGE = LATIN_TO_ENGLISH then
PARSE_WORD_LATIN_TO_ENGLISH:
declare
INPUT_WORD : constant STRING := W(J..K);
ENTERING_PA_LAST : INTEGER := 0;
ENTERING_TRPA_LAST : INTEGER := 0;
HAVE_DONE_ENCLITIC : BOOLEAN := FALSE;
procedure PASS(INPUT_WORD : STRING);
procedure ENCLITIC is
SAVE_DO_FIXES : BOOLEAN := WORDS_MODE(DO_FIXES);
SAVE_DO_ONLY_FIXES : BOOLEAN := WORDS_MDEV(DO_ONLY_FIXES);
ENCLITIC_LIMIT : INTEGER := 4;
TRY : constant STRING := LOWER_CASE(INPUT_WORD);
begin
--TEXT_IO.PUT_LINE("Entering ENCLITIC HAVE DONE = " & BOOLEAN'IMAGE(HAVE_DONE_ENCLITIC));
--if WORDS_MODE(TRIM_OUTPUT) and (PA_LAST > 0) then return; end if;
if HAVE_DONE_ENCLITIC then return; end if;
ENTERING_PA_LAST := PA_LAST;
if PA_LAST > 0 then ENCLITIC_LIMIT := 1; end if;
LOOP_OVER_ENCLITIC_TACKONS:
for I in 1..ENCLITIC_LIMIT loop -- If have parse, only do que of que, ne, ve, (est)
REMOVE_A_TACKON:
declare
LESS : constant STRING :=
SUBTRACT_TACKON(TRY, TACKONS(I));
--SUBTRACT_TACKON(INPUT_WORD, TACKONS(I));
SAVE_PA_LAST : INTEGER := 0;
begin
--TEXT_IO.PUT_LINE("In ENCLITIC LESS/TACKON = " & LESS & "/" & TACKONS(I).TACK);
if LESS /= TRY then -- LESS is less
--WORDS_MODE(DO_FIXES) := FALSE;
WORD_PACKAGE.WORD(LESS, PA, PA_LAST);
--TEXT_IO.PUT_LINE("In ENCLITICS after WORD NO_FIXES LESS = " & LESS & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
if PA_LAST = 0 then
SAVE_PA_LAST := PA_LAST;
TRY_SLURY(LESS, PA, PA_LAST, LINE_NUMBER, WORD_NUMBER);
if SAVE_PA_LAST /= 0 then
if (PA_LAST - 1) - SAVE_PA_LAST = SAVE_PA_LAST then
PA_LAST := SAVE_PA_LAST;
end if;
end if;
end if;
-- Do not SYNCOPE if there is a verb TO_BE or compound already there
-- I do this here and below, it might be combined but it workd now
for I in 1..PA_LAST loop
--PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
if PA(I).IR.QUAL.POFS = V and then
PA(I).IR.QUAL.V.CON = (5, 1) then
NO_SYNCOPE := TRUE;
end if;
end loop;
--TEXT_IO.PUT_LINE("In ENCLITICS after SLURY LESS = " & LESS & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
SYPA_LAST := 0;
if WORDS_MDEV(DO_SYNCOPE) and not NO_SYNCOPE then
SYNCOPE(LESS, SYPA, SYPA_LAST); -- Want SYNCOPE second to make cleaner LIST
--TEXT_IO.PUT_LINE("In ENCLITIC after SYNCOPE LESS = " & LESS & " SYPA_LAST = " & INTEGER'IMAGE(SYPA_LAST));
PA_LAST := PA_LAST + SYPA_LAST; -- Make syncope another array to avoid PA_LAST = 0 problems
PA(1..PA_LAST) := PA(1..PA_LAST-SYPA_LAST) & SYPA(1..SYPA_LAST); -- Add SYPA to PA
SYPA(1..SYNCOPE_MAX) := (1..SYNCOPE_MAX => NULL_PARSE_RECORD); -- Clean up so it does not repeat
SYPA_LAST := 0;
end if;
NO_SYNCOPE := FALSE;
-- Restore FIXES
--WORDS_MODE(DO_FIXES) := SAVE_DO_FIXES;
WORDS_MDEV(DO_ONLY_FIXES) := TRUE;
WORD(INPUT_WORD, PA, PA_LAST);
--TEXT_IO.PUT_LINE("In ENCLITICS after ONLY_FIXES LESS = " & LESS & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
WORDS_MDEV(DO_ONLY_FIXES) := SAVE_DO_ONLY_FIXES;
if PA_LAST > ENTERING_PA_LAST then -- have a possible word
PA_LAST := PA_LAST + 1;
PA(ENTERING_PA_LAST+2..PA_LAST) :=
PA(ENTERING_PA_LAST+1..PA_LAST-1);
PA(ENTERING_PA_LAST+1) := (TACKONS(I).TACK,
((TACKON, NULL_TACKON_RECORD), 0, NULL_ENDING_RECORD, X, X),
ADDONS, DICT_IO.COUNT(TACKONS(I).MNPC));
HAVE_DONE_ENCLITIC := TRUE;
end if;
exit LOOP_OVER_ENCLITIC_TACKONS;
end if;
end REMOVE_A_TACKON;
end loop LOOP_OVER_ENCLITIC_TACKONS;
end ENCLITIC;
procedure TRICKS_ENCLITIC is
TRY : constant STRING := LOWER_CASE(INPUT_WORD);
begin
--TEXT_IO.PUT_LINE("Entering TRICKS_ENCLITIC PA_LAST = " & INTEGER'IMAGE(PA_LAST));
--if WORDS_MODE(TRIM_OUTPUT) and (PA_LAST > 0) then return; end if;
if HAVE_DONE_ENCLITIC then return; end if;
ENTERING_TRPA_LAST := TRPA_LAST;
LOOP_OVER_ENCLITIC_TACKONS:
for I in 1..4 loop -- que, ne, ve, (est)
REMOVE_A_TACKON:
declare
LESS : constant STRING :=
--SUBTRACT_TACKON(LOWER_CASE(INPUT_WORD), TACKONS(I));
SUBTRACT_TACKON(TRY, TACKONS(I));
begin
--TEXT_IO.PUT_LINE("In TRICKS_ENCLITIC LESS/TACKON = " & LESS & "/" & TACKONS(I).TACK);
if LESS /= TRY then -- LESS is less
--PASS(LESS);
TRY_TRICKS(LESS, TRPA, TRPA_LAST, LINE_NUMBER, WORD_NUMBER);
--TEXT_IO.PUT_LINE("In TRICKS_ENCLITICS after TRY_TRICKS LESS = " & LESS & " TRPA_LAST = " & INTEGER'IMAGE(TRPA_LAST));
if TRPA_LAST > ENTERING_TRPA_LAST then -- have a possible word
TRPA_LAST := TRPA_LAST + 1;
TRPA(ENTERING_TRPA_LAST+2..trPA_LAST) :=
TRPA(ENTERING_TRPA_LAST+1..TRPA_LAST-1);
TRPA(ENTERING_TRPA_LAST+1) := (TACKONS(I).TACK,
((TACKON, NULL_TACKON_RECORD), 0, NULL_ENDING_RECORD, X, X),
ADDONS, DICT_IO.COUNT(TACKONS(I).MNPC));
end if;
exit LOOP_OVER_ENCLITIC_TACKONS;
end if;
end REMOVE_A_TACKON;
end loop LOOP_OVER_ENCLITIC_TACKONS;
end TRICKS_ENCLITIC;
procedure PASS(INPUT_WORD : STRING) is
-- This is the core logic of the program, everything else is details
SAVE_PA_LAST : INTEGER := 0;
SAVE_DO_FIXES : BOOLEAN := WORDS_MODE(DO_FIXES);
SAVE_DO_ONLY_FIXES : BOOLEAN := WORDS_MDEV(DO_ONLY_FIXES);
SAVE_DO_TRICKS : BOOLEAN := WORDS_MODE(DO_TRICKS);
begin
--TEXT_IO.PUT_LINE("Entering PASS with >" & INPUT_WORD);
-- Do straight WORDS without FIXES/TRICKS, is the word in the dictionary
WORDS_MODE(DO_FIXES) := FALSE;
ROMAN_NUMERALS(INPUT_WORD, PA, PA_LAST);
WORD(INPUT_WORD, PA, PA_LAST);
--TEXT_IO.PUT_LINE("SLURY- PA_LAST = " & INTEGER'IMAGE(PA_LAST));
--for JK in 1..PA_LAST loop
-- f PARSE_RECORD_IO.PUT(PA(JK)); TEXT_IO.NEW_LINE;
--end loop;
if PA_LAST = 0 then
TRY_SLURY(INPUT_WORD, PA, PA_LAST, LINE_NUMBER, WORD_NUMBER);
end if;
-- Do not SYNCOPE if there is a verb TO_BE or compound already there
for I in 1..PA_LAST loop
--PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
if PA(I).IR.QUAL.POFS = V and then
PA(I).IR.QUAL.V.CON = (5, 1) then
NO_SYNCOPE := TRUE;
end if;
end loop;
-- -- WITH THE DICTIONARY BETTER, LET US FORGET THIS - a and c DONE, e and i STILL BUT NOT MANY
-- SAVE_PA_LAST := PA_LAST;
-- -- BIG PROBLEM HERE
-- -- If I do SLURY everytime, then each case where there is an aps- and abs- in dictionary
-- -- will show up twice, straight and SLURY, in the ourout - For either input
-- -- But if I only do SLURY if there is no hit, then some incomplete pairs will not
-- -- fully express (illuxit has two entries, inluxit has only one of them) (inritas)
-- -- So I will do SLURY and if it produces only 2 more PR (XXX and GEN), kill it, otherwise use it only
-- -- Still have a problem if there are other intervening results, not slurried.
-- -- Or if there is syncope
-- TRY_SLURY(INPUT_WORD, PA, PA_LAST, LINE_NUMBER, WORD_NUMBER);
----TEXT_IO.PUT_LINE("SLURY+ PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- if SAVE_PA_LAST /= 0 then
-- if (PA_LAST - 2) = SAVE_PA_LAST then
-- PA_LAST := SAVE_PA_LAST;
-- XXX_MEANING := NULL_MEANING_TYPE;
----TEXT_IO.PUT_LINE("SLURY! PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- end if;
-- end if;
----TEXT_IO.PUT_LINE("1 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- Pure SYNCOPE
SYPA_LAST := 0;
if WORDS_MDEV(DO_SYNCOPE) and not NO_SYNCOPE then
SYNCOPE(INPUT_WORD, SYPA, SYPA_LAST);
PA_LAST := PA_LAST + SYPA_LAST; -- Make syncope another array to avoid PA-LAST = 0 problems
PA(1..PA_LAST) := PA(1..PA_LAST-SYPA_LAST) & SYPA(1..SYPA_LAST); -- Add SYPA to PA
SYPA(1..SYNCOPE_MAX) := (1..SYNCOPE_MAX => NULL_PARSE_RECORD); -- Clean up so it does not repeat
SYPA_LAST := 0;
end if;
NO_SYNCOPE := FALSE;
--TEXT_IO.PUT_LINE("2 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- There may be a vaild simple parse, if so it is most probable
-- But I have to allow for the possibility that -que is answer, not colloque V
ENCLITIC;
-- Restore FIXES
WORDS_MODE(DO_FIXES) := SAVE_DO_FIXES;
--TEXT_IO.PUT_LINE("3 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- Now with only fixes
if PA_LAST = 0 and then
WORDS_MODE(DO_FIXES) then
WORDS_MDEV(DO_ONLY_FIXES) := TRUE;
--TEXT_IO.PUT_LINE("3a PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
WORD(INPUT_WORD, PA, PA_LAST);
--TEXT_IO.PUT_LINE("3b PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
SYPA_LAST := 0;
if WORDS_MDEV(DO_SYNCOPE) and not NO_SYNCOPE then
SYNCOPE(INPUT_WORD, SYPA, SYPA_LAST);
--TEXT_IO.PUT_LINE("3c PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
PA_LAST := PA_LAST + SYPA_LAST; -- Make syncope another array to avoid PA-LAST = 0 problems
PA(1..PA_LAST) := PA(1..PA_LAST-SYPA_LAST) & SYPA(1..SYPA_LAST); -- Add SYPA to PA
SYPA(1..SYNCOPE_MAX) := (1..SYNCOPE_MAX => NULL_PARSE_RECORD); -- Clean up so it does not repeat
SYPA_LAST := 0;
end if;
NO_SYNCOPE := FALSE;
--TEXT_IO.PUT_LINE("4 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
ENCLITIC;
--TEXT_IO.PUT_LINE("5 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
WORDS_MDEV(DO_ONLY_FIXES) := SAVE_DO_ONLY_FIXES;
end if;
--TEXT_IO.PUT_LINE("6 PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
-- ROMAN_NUMERALS(INPUT_WORD, PA, PA_LAST);
-- If Pure WORDS and ENCLITICS found something OK, otherwise proceed
-- if PA_LAST = 0 or -- If no go, try syncope, fixes
-- (not WORDS_MODE(TRIM_OUTPUT)) or
-- WORDS_MDEV(DO_FIXES_ANYWAY) then
--
--
-- -- If SYNCOPE does it, then OK, otherwise proceed
-- -- Do not try FIXES (aud+i+i) on audii since SYNCOPE worked
-- -- Now try FIXES
-- if PA_LAST = 0 or (not WORDS_MODE(TRIM_OUTPUT)) or
-- WORDS_MDEV(DO_FIXES_ANYWAY) then
-- --TRY_SLURY(INPUT_WORD, PA, PA_LAST, LINE_NUMBER, WORD_NUMBER);
-- if PA_LAST = 0 then
-- WORD(INPUT_WORD, PA, PA_LAST);
-- SYPA_LAST := 0;
-- -- SYNCOPE after TRICK
-- SYNCOPE(INPUT_WORD, SYPA, SYPA_LAST); -- Want SYNCOPE second to make cleaner LIST
-- end if;
-- end if;
-- PA_LAST := PA_LAST + SYPA_LAST; -- Make syncope another array to avoid PA_LAST = 0 problems
-- PA(1..PA_LAST) := PA(1..PA_LAST-SYPA_LAST) & SYPA(1..SYPA_LAST); -- Add SYPA to PA
-- SYPA(1..SYNCOPE_MAX) := (1..SYNCOPE_MAX => NULL_PARSE_RECORD); -- Clean up so it does not repeat
-- SYPA_LAST := 0;
--
--
-- end if; -- on A_LAST = 0
end PASS;
begin -- PARSE
XXX_MEANING := NULL_MEANING_TYPE;
PASS_BLOCK:
begin
PA_LAST := 0;
WORD_NUMBER := WORD_NUMBER + 1;
PASS(INPUT_WORD);
end PASS_BLOCK;
--TEXT_IO.PUT_LINE("After PASS_BLOCK for " & INPUT_WORD & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
--if (PA_LAST = 0) or DO_TRICKS_ANYWAY then -- WORD failed, try to modify the word
if (PA_LAST = 0) and then
not (WORDS_MODE(IGNORE_UNKNOWN_NAMES) and CAPITALIZED) then
-- WORD failed, try to modify the word
--TEXT_IO.PUT_LINE("WORDS fail me");
if WORDS_MODE(DO_TRICKS) then
--TEXT_IO.PUT_LINE("DO_TRICKS PA_LAST TRPA_LAST " & INTEGER'IMAGE(PA_LAST) & " " & INTEGER'IMAGE(TRPA_LAST));
WORDS_MODE(DO_TRICKS) := FALSE; -- Turn it off so wont be circular
TRY_TRICKS(INPUT_WORD, TRPA, TRPA_LAST, LINE_NUMBER, WORD_NUMBER);
--TEXT_IO.PUT_LINE("DONE_TRICKS PA_LAST TRPA_LAST " & INTEGER'IMAGE(PA_LAST) & " " & INTEGER'IMAGE(TRPA_LAST));
if TRPA_LAST = 0 then
TRICKS_ENCLITIC;
end if;
WORDS_MODE(DO_TRICKS) := TRUE; -- Turn it back on
end if;
PA_LAST := PA_LAST + TRPA_LAST; -- Make TRICKS another array to avoid PA-LAST = 0 problems
PA(1..PA_LAST) := PA(1..PA_LAST-TRPA_LAST) & TRPA(1..TRPA_LAST); -- Add SYPA to PA
TRPA(1..TRICKS_MAX) := (1..TRICKS_MAX => NULL_PARSE_RECORD); -- Clean up so it does not repeat
TRPA_LAST := 0;
end if;
--TEXT_IO.PUT_LINE("After TRICKS " & INTEGER'IMAGE(PA_LAST));
--======================================================================
-- At this point we have done what we can with individual words
-- Now see if there is something we can do with word combinations
-- For this we have to look ahead
if PA_LAST > 0 then -- But PA may be killed by ALLOW in LIST_STEMS
if WORDS_MODE(DO_COMPOUNDS) and
not (CONFIGURATION = ONLY_MEANINGS) then
COMPOUNDS_WITH_SUM:
declare
NW : STRING(1..2500) := (others => ' ');
NK : INTEGER := 0;
COMPOUND_TENSE : INFLECTIONS_PACKAGE.TENSE_TYPE := X;
COMPOUND_TVM : INFLECTIONS_PACKAGE.TENSE_VOICE_MOOD_RECORD;
PPL_ON : BOOLEAN := FALSE;
SUM_INFO : VERB_RECORD := ((5, 1),
(X, ACTIVE, X),
0,
X);
-- ESSE_INFO : VERB_RECORD := ((5, 1),
-- (PRES, ACTIVE, INF),
-- 0,
-- X);
PPL_INFO : VPAR_RECORD := ((0, 0),
X,
X,
X,
(X, X, X));
SUPINE_INFO : SUPINE_RECORD := ((0, 0),
X,
X,
X);
procedure LOOK_AHEAD is
J : INTEGER := 0;
begin
for I in K+2..L loop
-- Although I have removed punctuation above, it may not always be so
exit when (LINE(I) = ' ' or LINE(I) = ',' or LINE(I) = '-'
or LINE(I) = ';' or LINE(I) = ':' or LINE(I) = '.'
or LINE(I) = '(' or LINE(I) = '[' or LINE(I) = '{' or LINE(I) = '<'
or LINE(I) = ')' or LINE(I) = ']' or LINE(I) = '}' or LINE(I) = '>');
J := J + 1;
NW(J) := LINE(I);
NK := I;
end loop;
end LOOK_AHEAD;
function NEXT_WORD return STRING is
begin
return TRIM(NW);
end NEXT_WORD;
function IS_SUM(T : STRING) return BOOLEAN is
SA : constant array (MOOD_TYPE range IND..SUB,
TENSE_TYPE range PRES..FUTP,
NUMBER_TYPE range S..P,
PERSON_TYPE range 1..3)
of STRING(1..9) :=
(
( -- IND
(("sum ", "es ", "est "), ("sumus ", "estis ", "sunt ")),
(("eram ", "eras ", "erat "), ("eramus ", "eratis ", "erant ")),
(("ero ", "eris ", "erit "), ("erimus ", "eritis ", "erunt ")),
(("fui ", "fuisti ", "fuit "), ("fuimus ", "fuistis ", "fuerunt ")),
(("fueram ", "fueras ", "fuerat "), ("fueramus ", "fueratis ", "fuerant ")),
(("fuero ", "fueris ", "fuerit "), ("fuerimus ", "fueritis ", "fuerunt "))
),
( -- SUB
(("sim ", "sis ", "sit "), ("simus ", "sitis ", "sint ")),
(("essem ", "esses ", "esset "), ("essemus ", "essetis ", "essent ")),
(("zzz ", "zzz ", "zzz "), ("zzz ", "zzz ", "zzz ")),
(("fuerim ", "fueris ", "fuerit "), ("fuerimus ", "fueritis ", "fuerint ")),
(("fuissem ", "fuisses ", "fuisset "), ("fuissemus", "fuissetis", "fuissent ")),
(("zzz ", "zzz ", "zzz "), ("zzz ", "zzz ", "zzz "))
)
);
begin
if T = "" then
return FALSE;
elsif T(T'FIRST) /= 's' and
T(T'FIRST) /= 'e' and
T(T'FIRST) /= 'f' then
return FALSE;
end if;
for L in MOOD_TYPE range IND..SUB loop
for K in TENSE_TYPE range PRES..FUTP loop
for J in NUMBER_TYPE range S..P loop
for I in PERSON_TYPE range 1..3 loop
if TRIM(T) = TRIM(SA(L, K, J, I)) then
SUM_INFO := ((5, 1), (K, ACTIVE, L), I, J);
return TRUE; -- Only one of the forms can agree
end if;
end loop;
end loop;
end loop;
end loop;
return FALSE;
end IS_SUM;
function IS_ESSE(T : STRING) return BOOLEAN is
begin
return TRIM(T) = "esse";
end IS_ESSE;
function IS_FUISSE(T : STRING) return BOOLEAN is
begin
return TRIM(T) = "fuisse";
end IS_FUISSE;
function IS_IRI(T : STRING) return BOOLEAN is
begin
return TRIM(T) = "iri";
end IS_IRI;
begin
-- Look ahead for sum
LOOK_AHEAD;
if IS_SUM(NEXT_WORD) then -- On NEXT_WORD = sum, esse, iri
for I in 1..PA_LAST loop -- Check for PPL
if PA(I).IR.QUAL.POFS = VPAR and then
PA(I).IR.QUAL.VPAR.CS = NOM and then
PA(I).IR.QUAL.VPAR.NUMBER = SUM_INFO.NUMBER and then
( (PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (PERF, PASSIVE, PPL)) or
(PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, ACTIVE, PPL)) or
(PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, PASSIVE, PPL)) ) then
-- There is at least one hit, fix PA, and advance J over the sum
K := NK;
end if;
end loop;
if K = NK then -- There was a PPL hit
CLEAR_PAS_NOM_PPL:
declare
J : INTEGER := PA_LAST;
begin
while J >= 1 loop -- Sweep backwards to kill empty suffixes
if ((PA(J).IR.QUAL.POFS = PREFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = SUFFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = TACKON) and then (PPL_ON)) then
null;
elsif PA(J).IR.QUAL.POFS = VPAR and then
PA(J).IR.QUAL.VPAR.CS = NOM and then
PA(J).IR.QUAL.VPAR.NUMBER = SUM_INFO.NUMBER then
if PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (PERF, PASSIVE, PPL) then
PPL_ON := TRUE;
case SUM_INFO.TENSE_VOICE_MOOD.TENSE is -- Allows PERF for sum
when PRES | PERF => COMPOUND_TENSE := PERF;
when IMPF | PLUP => COMPOUND_TENSE := PLUP;
when FUT => COMPOUND_TENSE := FUTP;
when others => COMPOUND_TENSE := X;
end case;
COMPOUND_TVM := (COMPOUND_TENSE, PASSIVE, SUM_INFO.TENSE_VOICE_MOOD.MOOD);
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
PPP_MEANING :=
HEAD("PERF PASSIVE PPL + verb TO_BE => PASSIVE perfect system",
MAX_MEANING_SIZE);
elsif PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, ACTIVE, PPL) then
PPL_ON := TRUE;
COMPOUND_TENSE := SUM_INFO.TENSE_VOICE_MOOD.TENSE;
COMPOUND_TVM := (COMPOUND_TENSE, ACTIVE, SUM_INFO.TENSE_VOICE_MOOD.MOOD);
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
PPP_MEANING := HEAD(
"FUT ACTIVE PPL + verb TO_BE => ACTIVE Periphrastic - about to, going to",
MAX_MEANING_SIZE);
elsif PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, PASSIVE, PPL) then
PPL_ON := TRUE;
COMPOUND_TENSE := SUM_INFO.TENSE_VOICE_MOOD.TENSE;
COMPOUND_TVM := (COMPOUND_TENSE, PASSIVE, SUM_INFO.TENSE_VOICE_MOOD.MOOD);
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
PPP_MEANING := HEAD(
"FUT PASSIVE PPL + verb TO_BE => PASSIVE Periphrastic - should/ought/had to",
MAX_MEANING_SIZE);
end if;
else
PA(J..PA_LAST-1) := PA(J+1..PA_LAST);
PA_LAST := PA_LAST - 1;
PPL_ON := FALSE;
end if;
J := J - 1;
end loop;
end CLEAR_PAS_NOM_PPL;
PA_LAST := PA_LAST + 1;
PA(PA_LAST) :=
(HEAD("PPL+" & NEXT_WORD, MAX_STEM_SIZE),
((V,
(PPL_INFO.CON,
COMPOUND_TVM,
SUM_INFO.PERSON,
SUM_INFO.NUMBER)
), 0, NULL_ENDING_RECORD, X, A),
PPP, NULL_MNPC);
end if;
elsif IS_ESSE(NEXT_WORD) or IS_FUISSE(NEXT_WORD) then -- On NEXT_WORD
for I in 1..PA_LAST loop -- Check for PPL
if PA(I).IR.QUAL.POFS = VPAR and then
(((PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (PERF, PASSIVE, PPL)) and
IS_ESSE(NEXT_WORD)) or
((PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, ACTIVE, PPL)) or
(PA(I).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, PASSIVE, PPL))) ) then
-- There is at least one hit, fix PA, and advance J over the sum
K := NK;
end if;
end loop;
if K = NK then -- There was a PPL hit
CLEAR_PAS_PPL:
declare
J : INTEGER := PA_LAST;
begin
while J >= 1 loop -- Sweep backwards to kill empty suffixes
if ((PA(J).IR.QUAL.POFS = PREFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = SUFFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = TACKON) and then (PPL_ON)) then
null;
elsif PA(J).IR.QUAL.POFS = VPAR then
if PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (PERF, PASSIVE, PPL) then
PPL_ON := TRUE;
COMPOUND_TVM := (PERF, PASSIVE, INF);
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
PPP_MEANING :=
HEAD("PERF PASSIVE PPL + esse => PERF PASSIVE INF",
MAX_MEANING_SIZE);
elsif PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, ACTIVE, PPL) then
PPL_ON := TRUE;
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
if IS_ESSE(NEXT_WORD) then
COMPOUND_TVM := (FUT, ACTIVE, INF);
PPP_MEANING := HEAD(
"FUT ACTIVE PPL + esse => PRES Periphastic/FUT ACTIVE INF - be about/going to",
MAX_MEANING_SIZE);
-- also peri COMPOUND_TVM := (PRES, ACTIVE, INF);
else -- fuisse
COMPOUND_TVM := (PERF, ACTIVE, INF);
PPP_MEANING := HEAD(
"FUT ACT PPL+fuisse => PERF ACT INF Periphrastic - to have been about/going to",
MAX_MEANING_SIZE);
end if;
elsif PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD = (FUT, PASSIVE, PPL) then
PPL_ON := TRUE;
PPL_INFO := (PA(J).IR.QUAL.VPAR.CON, -- In this case, there is 1
PA(J).IR.QUAL.VPAR.CS, -- although several different
PA(J).IR.QUAL.VPAR.NUMBER,-- dictionary entries may fit
PA(J).IR.QUAL.VPAR.GENDER,-- all have same PPL_INFO
PA(J).IR.QUAL.VPAR.TENSE_VOICE_MOOD);
if IS_ESSE(NEXT_WORD) then
COMPOUND_TVM := (PRES, PASSIVE, INF);
PPP_MEANING := HEAD(
"FUT PASSIVE PPL + esse => PRES PASSIVE INF",
MAX_MEANING_SIZE);
-- also peri COMPOUND_TVM := (PRES, ACTIVE, INF);
else -- fuisse
COMPOUND_TVM := (PERF, PASSIVE, INF);
PPP_MEANING := HEAD(
"FUT PASSIVE PPL + fuisse => PERF PASSIVE INF Periphrastic - about to, going to",
MAX_MEANING_SIZE);
end if;
end if;
else
PA(J..PA_LAST-1) := PA(J+1..PA_LAST);
PA_LAST := PA_LAST - 1;
PPL_ON := FALSE;
end if;
J := J - 1;
end loop;
end CLEAR_PAS_PPL;
PA_LAST := PA_LAST + 1;
PA(PA_LAST) :=
(HEAD("PPL+" & NEXT_WORD, MAX_STEM_SIZE),
((V,
(PPL_INFO.CON,
COMPOUND_TVM,
0,
X)
), 0, NULL_ENDING_RECORD, X, A),
PPP, NULL_MNPC);
end if;
elsif IS_IRI(NEXT_WORD) then -- On NEXT_WORD = sum, esse, iri
-- Look ahead for sum
for J in 1..PA_LAST loop -- Check for SUPINE
if PA(J).IR.QUAL.POFS = SUPINE and then
PA(J).IR.QUAL.SUPINE.CS = ACC then
-- There is at least one hit, fix PA, and advance J over the iri
K := NK;
end if;
end loop;
if K = NK then -- There was a SUPINE hit
CLEAR_PAS_SUPINE:
declare
J : INTEGER := PA_LAST;
begin
while J >= 1 loop -- Sweep backwards to kill empty suffixes
if ((PA(J).IR.QUAL.POFS = PREFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = SUFFIX) and then (PPL_ON)) then
null;
elsif ((PA(J).IR.QUAL.POFS = TACKON) and then (PPL_ON)) then
null;
elsif PA(J).IR.QUAL.POFS = SUPINE and then
PA(J).IR.QUAL.SUPINE.CS = ACC then
PPL_ON := TRUE;
SUPINE_INFO := (PA(J).IR.QUAL.SUPINE.CON,
PA(J).IR.QUAL.SUPINE.CS,
PA(J).IR.QUAL.SUPINE.NUMBER,
PA(J).IR.QUAL.SUPINE.GENDER);
PA_LAST := PA_LAST + 1;
PA(PA_LAST) :=
(HEAD("SUPINE + iri", MAX_STEM_SIZE),
((V,
(SUPINE_INFO.CON,
(FUT, PASSIVE, INF),
0,
X)
), 0, NULL_ENDING_RECORD, X, A),
PPP, NULL_MNPC);
PPP_MEANING := HEAD(
"SUPINE + iri => FUT PASSIVE INF - to be about/going/ready to be ~",
MAX_MEANING_SIZE);
K := NK;
else
PA(J..PA_LAST-1) := PA(J+1..PA_LAST);
PA_LAST := PA_LAST - 1;
PPL_ON := FALSE;
end if;
J := J -1;
end loop;
end CLEAR_PAS_SUPINE;
end if;
end if; -- On NEXT_WORD = sum, esse, iri
end COMPOUNDS_WITH_SUM;
end if; -- On WORDS_MODE(DO_COMPOUNDS)
--========================================================================
end if;
--TEXT_IO.PUT_LINE("Before LISTing STEMS (PA_LAST > 0 to start) PA_LAST = " &
--INTEGER'IMAGE(PA_LAST));
if WORDS_MODE(WRITE_OUTPUT_TO_FILE) then
LIST_STEMS(OUTPUT, INPUT_WORD, INPUT_LINE, PA, PA_LAST);
else
LIST_STEMS(CURRENT_OUTPUT, INPUT_WORD, INPUT_LINE, PA, PA_LAST);
end if;
--TEXT_IO.PUT_LINE("After LISTing STEMS (PA_LAST > 0 to start) PA_LAST = " &
--INTEGER'IMAGE(PA_LAST));
PA_LAST := 0;
exception
when others =>
PUT_STAT("Exception at "
& HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
& " " & HEAD(INPUT_WORD, 28) & " " & INPUT_LINE);
raise;
end PARSE_WORD_LATIN_TO_ENGLISH;
end if;
----------------------------------------------------------------------
----------------------------------------------------------------------
J := K + 1; -- In case it is end of line and we don't look for ' '
exit when WORDS_MDEV(DO_ONLY_INITIAL_WORD);
end loop OVER_LINE; -- Loop on line
exception
-- Have STORAGE_ERROR check in WORD too ?????????????
when STORAGE_ERROR => -- I want to again, at least twice
if WORDS_MDEV(DO_PEARSE_CODES) then
TEXT_IO.PUT("00 ");
end if;
TEXT_IO.PUT_LINE( -- ERROR_FILE,
"STORAGE_ERROR Exception in WORDS, try again");
STORAGE_ERROR_COUNT := STORAGE_ERROR_COUNT + 1;
if STORAGE_ERROR_COUNT >= 4 then raise; end if;
PA_LAST := 0;
when GIVE_UP =>
PA_LAST := 0;
raise;
when others => -- I want to try to get on with the next line
TEXT_IO.PUT_LINE( -- ERROR_FILE,
"Exception in PARSE_LINE processing " & INPUT_LINE);
if WORDS_MODE(WRITE_UNKNOWNS_TO_FILE) then
if WORDS_MDEV(DO_PEARSE_CODES) then
TEXT_IO.PUT(UNKNOWNS, "00 ");
end if;
TEXT_IO.PUT(UNKNOWNS, INPUT_LINE(J..K));
TEXT_IO.SET_COL(UNKNOWNS, 30);
INFLECTIONS_PACKAGE.INTEGER_IO.PUT(UNKNOWNS, LINE_NUMBER, 5);
INFLECTIONS_PACKAGE.INTEGER_IO.PUT(UNKNOWNS, WORD_NUMBER, 3);
TEXT_IO.PUT_LINE(UNKNOWNS, " ======== ERROR ");
end if;
PA_LAST := 0;
end PARSE_LINE;
--procedure CHANGE_LANGUAGE(C : CHARACTER) is
--begin
-- if UPPER_CASE(C) = 'L' then
-- LANGUAGE := LATIN_TO_ENGLISH;
-- PREFACE.PUT_LINE("Language changed to " & LANGUAGE_TYPE'IMAGE(LANGUAGE));
-- elsif UPPER_CASE(C) = 'E' then
-- if ENGLISH_DICTIONARY_AVAILABLE(GENERAL) then
-- LANGUAGE:= ENGLISH_TO_LATIN;
-- PREFACE.PUT_LINE("Language changed to " & LANGUAGE_TYPE'IMAGE(LANGUAGE));
-- PREFACE.PUT_LINE("Input a single English word (+ part of speech - N, ADJ, V, PREP, ...)");
-- else
-- PREFACE.PUT_LINE("No English dictionary available");
-- end if;
-- else
-- PREFACE.PUT_LINE("Bad LANGAUGE input - no change, remains " & LANGUAGE_TYPE'IMAGE(LANGUAGE));
-- end if;
--exception
-- when others =>
-- PREFACE.PUT_LINE("Bad LANGAUGE input - no change, remains " & LANGUAGE_TYPE'IMAGE(LANGUAGE));
--end CHANGE_LANGUAGE;
--
--
begin -- PARSE
-- All Rights Reserved - William Armstrong Whitaker
-- INITIALIZE_WORD_PARAMETERS;
-- INITIALIZE_DEVELOPER_PARAMETERS;
-- INITIALIZE_WORD_PACKAGE;
--
if METHOD = COMMAND_LINE_INPUT then
if TRIM(COMMAND_LINE) /= "" then
PARSE_LINE(COMMAND_LINE);
end if;
else
PREFACE.PUT_LINE(
"Copyright (c) 1993-2006 - Free for any use - Version 1.97FC");
PREFACE.PUT_LINE(
"For updates and latest version check http://www.erols.com/whitaker/words.htm");
PREFACE.PUT_LINE(
"Comments? William Whitaker, Box 51225 Midland TX 79710 USA - whitaker@erols.com");
PREFACE.NEW_LINE;
PREFACE.PUT_LINE(
"Input a word or line of Latin and ENTER to get the forms and meanings");
PREFACE.PUT_LINE(" Or input " & START_FILE_CHARACTER &
" and the name of a file containing words or lines");
PREFACE.PUT_LINE(" Or input " & CHANGE_PARAMETERS_CHARACTER &
" to change parameters and mode of the program");
PREFACE.PUT_LINE(" Or input " & HELP_CHARACTER &
" to get help wherever available on individual parameters");
PREFACE.PUT_LINE(
"Two empty lines (just a RETURN/ENTER) from the keyboard exits the program");
if ENGLISH_DICTIONARY_AVAILABLE(GENERAL) then
PREFACE.PUT_LINE("English-to-Latin available");
PREFACE.PUT_LINE(
CHANGE_LANGUAGE_CHARACTER & "E changes to English-to-Latin, " &
CHANGE_LANGUAGE_CHARACTER & "L changes back [tilde E]");
end if;
if CONFIGURATION = ONLY_MEANINGS then
PREFACE.PUT_LINE(
"THIS VERSION IS HARDCODED TO GIVE DICTIONARY FORM AND MEANINGS ONLY");
PREFACE.PUT_LINE(
"IT CANNOT BE MODIFIED BY CHANGING THE DO_MEANINGS_ONLY PARAMETER");
end if;
GET_INPUT_LINES:
loop
GET_INPUT_LINE:
begin -- Block to manipulate file of lines
if (NAME(CURRENT_INPUT) = NAME(STANDARD_INPUT)) then
SCROLL_LINE_NUMBER := INTEGER(TEXT_IO.LINE(TEXT_IO.STANDARD_OUTPUT));
PREFACE.NEW_LINE;
PREFACE.PUT("=>");
end if;
LINE := BLANK_LINE;
GET_LINE(LINE, L);
if (L = 0) or else (TRIM(LINE(1..L)) = "") then
--LINE_NUMBER := LINE_NUMBER + 1; -- Count blank lines
if (NAME(CURRENT_INPUT) = NAME(STANDARD_INPUT)) then -- INPUT is keyboard
PREFACE.PUT("Blank exits =>");
GET_LINE(LINE, L); -- Second try
if (L = 0) or else (TRIM(LINE(1..L)) = "") then -- Two in a row
exit;
end if;
else -- INPUT is file
--LINE_NUMBER := LINE_NUMBER + 1; -- Count blank lines in file
if END_OF_FILE(CURRENT_INPUT) then
SET_INPUT(STANDARD_INPUT);
CLOSE(INPUT);
end if;
end if;
end if;
if (TRIM(LINE(1..L)) /= "") then -- Not a blank line so L(1) (in file input)
if LINE(1) = START_FILE_CHARACTER then -- To begin file of words
if (NAME(CURRENT_INPUT) /= NAME(STANDARD_INPUT)) then
TEXT_IO.PUT_LINE("Cannot have file of words (@FILE) in an @FILE");
else
TEXT_IO.OPEN(INPUT, TEXT_IO.IN_FILE, TRIM(LINE(2..L)));
TEXT_IO.SET_INPUT(INPUT);
end if;
elsif LINE(1) = CHANGE_PARAMETERS_CHARACTER and then
(NAME(CURRENT_INPUT) = NAME(STANDARD_INPUT)) and then
not CONFIG.SUPPRESS_PREFACE then
CHANGE_PARAMETERS;
elsif LINE(1) = CHANGE_LANGUAGE_CHARACTER then
-- (NAME(CURRENT_INPUT) = NAME(STANDARD_INPUT)) and then
-- not CONFIG.SUPPRESS_PREFACE then
--TEXT_IO.PUT_LINE("CHANGE CHARACTER " & TRIM(LINE));
CHANGE_LANGUAGE(LINE(2));
elsif -- CONFIGURATION = DEVELOPER_VERSION and then -- Allow anyone to do it
LINE(1) = CHANGE_DEVELOPER_MODES_CHARACTER and then
(NAME(CURRENT_INPUT) = NAME(STANDARD_INPUT)) and then
not CONFIG.SUPPRESS_PREFACE then
CHANGE_DEVELOPER_MODES;
else
if (NAME(CURRENT_INPUT) /= NAME(STANDARD_INPUT)) then
PREFACE.NEW_LINE;
PREFACE.PUT_LINE(LINE(1..L));
end if;
if WORDS_MODE(WRITE_OUTPUT_TO_FILE) then
if not CONFIG.SUPPRESS_PREFACE then
NEW_LINE(OUTPUT);
TEXT_IO.PUT_LINE(OUTPUT, LINE(1..L));
end if;
end if;
LINE_NUMBER := LINE_NUMBER + 1; -- Count lines to be parsed
PARSE_LINE(LINE(1..L));
end if;
end if;
exception
when NAME_ERROR | USE_ERROR =>
if (NAME(CURRENT_INPUT) /= NAME(STANDARD_INPUT)) then
SET_INPUT(STANDARD_INPUT);
CLOSE(INPUT);
end if;
PUT_LINE("An unknown or unacceptable file name. Try Again");
when END_ERROR => -- The end of the input file resets to CON:
if (NAME(CURRENT_INPUT) /= NAME(STANDARD_INPUT)) then
SET_INPUT(STANDARD_INPUT);
CLOSE(INPUT);
if METHOD = COMMAND_LINE_FILES then raise GIVE_UP; end if;
else
PUT_LINE("Raised END_ERROR, although in STANDARD_INPUT");
PUT_LINE("^Z is inappropriate keyboard input, WORDS should be terminated with a blank line");
raise GIVE_UP;
end if;
when STATUS_ERROR => -- The end of the input file resets to CON:
PUT_LINE("Raised STATUS_ERROR");
end GET_INPUT_LINE; -- end Block to manipulate file of lines
end loop GET_INPUT_LINES; -- Loop on lines
end if; -- On command line input
begin
STEM_IO.OPEN(STEM_FILE(LOCAL), STEM_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
"LOCAL"));
-- Failure to OPEN will raise an exception, to be handled below
if STEM_IO.IS_OPEN(STEM_FILE(LOCAL)) then
STEM_IO.DELETE(STEM_FILE(LOCAL));
end if;
exception
when others =>
null; -- If cannot OPEN then it does not exist, so is deleted
end;
-- The rest of this seems like overkill, it might have been done elsewhere
begin
if
DICT_IO.IS_OPEN(DICT_FILE(LOCAL)) then
DICT_IO.DELETE(DICT_FILE(LOCAL));
else
DICT_IO.OPEN(DICT_FILE(LOCAL), DICT_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME,
"LOCAL"));
DICT_IO.DELETE(DICT_FILE(LOCAL));
end if;
exception when others => null; end; -- not there, so don't have to DELETE
begin
if
DICT_IO.IS_OPEN(DICT_FILE(ADDONS)) then
DICT_IO.DELETE(DICT_FILE(ADDONS));
else
DICT_IO.OPEN(DICT_FILE(ADDONS), DICT_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME,
"ADDONS"));
DICT_IO.DELETE(DICT_FILE(ADDONS));
end if;
exception when others => null; end; -- not there, so don't have to DELETE
begin
if
DICT_IO.IS_OPEN(DICT_FILE(UNIQUE)) then
DICT_IO.DELETE(DICT_FILE(UNIQUE));
else
DICT_IO.OPEN(DICT_FILE(UNIQUE), DICT_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME,
"UNIQUE"));
DICT_IO.DELETE(DICT_FILE(UNIQUE));
end if;
exception when others => null; end; -- not there, so don't have to DELETE
exception
when STORAGE_ERROR => -- Have tried at least twice, fail
PREFACE.PUT_LINE("Continuing STORAGE_ERROR Exception in PARSE");
PREFACE.PUT_LINE("If insufficient memory in DOS, try removing TSRs");
when GIVE_UP =>
PREFACE.PUT_LINE("Giving up!");
when others =>
PREFACE.PUT_LINE("Unexpected exception raised in PARSE");
end PARSE;
Reference in New Issue View Git Blame Copy Permalink