import from .zip file
This commit is contained in:
Michael Wolf
910
list_sweep.adb
Normal file
910
list_sweep.adb
Normal file
@@ -0,0 +1,910 @@
|
||||
with TEXT_IO;
|
||||
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
|
||||
with WORD_PARAMETERS; use WORD_PARAMETERS;
|
||||
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
|
||||
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
|
||||
with UNIQUES_PACKAGE; use UNIQUES_PACKAGE;
|
||||
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
|
||||
with WORD_SUPPORT_PACKAGE; use WORD_SUPPORT_PACKAGE;
|
||||
procedure LIST_SWEEP(PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
|
||||
-- This procedure is supposed to process the output PARSE_ARRAY at PA level
|
||||
-- before it get turned into SIRAA and DMNPCA in LIST_PACKAGE
|
||||
-- Since it does only PARSE_ARRAY it is just cheaking INFLECTIONS, not DICTIOARY
|
||||
|
||||
use INFLECTION_RECORD_IO;
|
||||
use DICT_IO;
|
||||
|
||||
PR, OPR : PARSE_RECORD := NULL_PARSE_RECORD;
|
||||
DE : DICTIONARY_ENTRY := NULL_DICTIONARY_ENTRY;
|
||||
I, J, JJ : INTEGER := 0;
|
||||
DIFF_J : INTEGER := 0;
|
||||
|
||||
|
||||
NOT_ONLY_ARCHAIC : BOOLEAN := FALSE;
|
||||
NOT_ONLY_MEDIEVAL : BOOLEAN := FALSE;
|
||||
NOT_ONLY_UNCOMMON : BOOLEAN := FALSE;
|
||||
|
||||
|
||||
function ALLOWED_STEM(PR : PARSE_RECORD) return BOOLEAN is
|
||||
ALLOWED : BOOLEAN := TRUE; -- modify as necessary and return it
|
||||
--DE : DICTIONARY_ENTRY;
|
||||
begin
|
||||
--TEXT_IO.PUT("ALLOWED? >"); PARSE_RECORD_IO.PUT(PR); TEXT_IO.NEW_LINE;
|
||||
if PR.D_K not in GENERAL..LOCAL then
|
||||
return TRUE; end if;
|
||||
|
||||
--DICT_IO.SET_INDEX(DICT_FILE(PR.D_K), PR.MNPC);
|
||||
--DICT_IO.READ(DICT_FILE(PR.D_K), DE);
|
||||
|
||||
DICT_IO.READ(DICT_FILE(PR.D_K), DE, PR.MNPC);
|
||||
|
||||
--TEXT_IO.PUT("ALLOWED? >"); DICTIONARY_ENTRY_IO.PUT(DE); TEXT_IO.NEW_LINE;
|
||||
|
||||
|
||||
-- if PR.D_K in GENERAL..UNIQUE then
|
||||
-- if (DE.TRAN.AGE = X) or else (DE.TRAN.AGE > A) then
|
||||
-- NOT_ONLY_ARCHAIC_STEM := TRUE;
|
||||
-- end if;
|
||||
-- if DE.TRAN.AGE < F then -- Or E????
|
||||
-- NOT_ONLY_MEDIEVAL_STEM := TRUE;
|
||||
-- end if;
|
||||
-- if DE.TRAN.FREQ < E then -- -- E for DICTLINE is uncommon !!!!
|
||||
-- NOT_ONLY_UNCOMMON_STEM := TRUE;
|
||||
-- end if;
|
||||
-- end if;
|
||||
|
||||
-- NOUN CHECKS
|
||||
|
||||
case PR.IR.QUAL.POFS is
|
||||
|
||||
when N =>
|
||||
|
||||
|
||||
if WORDS_MDEV(FOR_WORD_LIST_CHECK) then
|
||||
if (NOM <= PR.IR.QUAL.N.CS) and then
|
||||
(S <= PR.IR.QUAL.N.NUMBER) then
|
||||
ALLOWED := TRUE;
|
||||
elsif (NOM <= PR.IR.QUAL.N.CS) and then
|
||||
(PR.IR.QUAL.N.NUMBER = P) then
|
||||
SEARCH_FOR_PL:
|
||||
declare
|
||||
DE : DICTIONARY_ENTRY;
|
||||
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
|
||||
begin
|
||||
ALLOWED := FALSE;
|
||||
DICT_IO.READ(DICT_FILE(PR.D_K), DE, PR.MNPC);
|
||||
MEAN := DE.MEAN;
|
||||
for J in MEANING_TYPE'FIRST..MEANING_TYPE'LAST-2 loop
|
||||
if MEAN(J..J+2) = "pl." then
|
||||
ALLOWED := TRUE;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
end SEARCH_FOR_PL;
|
||||
--====================================
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
when ADJ =>
|
||||
|
||||
|
||||
|
||||
if WORDS_MDEV(FOR_WORD_LIST_CHECK) then
|
||||
if (NOM <= PR.IR.QUAL.ADJ.CS) and then
|
||||
(S <= PR.IR.QUAL.ADJ.NUMBER) and then
|
||||
(M <= PR.IR.QUAL.ADJ.GENDER) then
|
||||
ALLOWED := TRUE;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-- VERB CHECKS
|
||||
|
||||
when V =>
|
||||
--TEXT_IO.PUT("VERB ");
|
||||
-- Check for Verb 3 1 dic/duc/fac/fer shortened imperative
|
||||
-- See G&L 130.5
|
||||
declare
|
||||
STEM : constant STRING := TRIM(PR.STEM);
|
||||
LAST_THREE : STRING(1..3);
|
||||
begin
|
||||
if (PR.IR.QUAL.V = ((3, 1), (PRES, ACTIVE, IMP), 2, S)) and
|
||||
(PR.IR.ENDING.SIZE = 0) then -- For this special case
|
||||
if STEM'LENGTH >= 3 then
|
||||
LAST_THREE := STEM(STEM'LAST-2..STEM'LAST);
|
||||
if (LAST_THREE = "dic") or
|
||||
(LAST_THREE = "duc") or
|
||||
(LAST_THREE = "fac") or
|
||||
(LAST_THREE = "fer") then
|
||||
null;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Check for Verb Imperative being in permitted person
|
||||
if (PR.IR.QUAL.V.TENSE_VOICE_MOOD.MOOD = IMP) then
|
||||
if (PR.IR.QUAL.V.TENSE_VOICE_MOOD.TENSE = PRES) and
|
||||
(PR.IR.QUAL.V.PERSON = 2) then
|
||||
null;
|
||||
elsif (PR.IR.QUAL.V.TENSE_VOICE_MOOD.TENSE = FUT) and
|
||||
(PR.IR.QUAL.V.PERSON = 2 or PR.IR.QUAL.V.PERSON = 3) then
|
||||
null;
|
||||
else
|
||||
--PUT("IMP not in permitted person "); PUT(PR.IR); NEW_LINE;
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check for V IMPERS and demand that only 3rd person -- ???????
|
||||
if (DE.PART.V.KIND = IMPERS) then
|
||||
if (PR.IR.QUAL.V.PERSON = 3) then
|
||||
null;
|
||||
else
|
||||
--PUT("IMPERS not in 3rd person "); PUT(PR.IR); NEW_LINE;
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check for V DEP and demand PASSIVE
|
||||
if (DE.PART.V.KIND = DEP) then
|
||||
--TEXT_IO.PUT("DEP ");
|
||||
if (PR.IR.QUAL.V.TENSE_VOICE_MOOD.VOICE = ACTIVE) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.MOOD = INF) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.TENSE = FUT) then
|
||||
--TEXT_IO.PUT("PASSIVE ");
|
||||
--TEXT_IO.PUT("DEP FUT INF not in ACTIVE "); PUT(PR.IR); TEXT_IO.NEW_LINE;
|
||||
ALLOWED := TRUE;
|
||||
elsif (PR.IR.QUAL.V.TENSE_VOICE_MOOD.VOICE = ACTIVE) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.MOOD in IND..INF) then
|
||||
--TEXT_IO.PUT("ACTIVE ");
|
||||
--TEXT_IO.PUT("DEP not in PASSIVE NOT ALLOWED "); PUT(PR.IR); TEXT_IO.NEW_LINE;
|
||||
ALLOWED := FALSE;
|
||||
else
|
||||
--TEXT_IO.PUT("?????? ");
|
||||
null;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check for V SEMIDEP and demand PASSIVE ex Perf
|
||||
if (DE.PART.V.KIND = SEMIDEP) then
|
||||
if (PR.IR.QUAL.V.TENSE_VOICE_MOOD.VOICE = PASSIVE) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.TENSE in PRES..FUT) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.MOOD in IND..IMP) then
|
||||
--PUT("SEMIDEP Pres not in ACTIVE "); PUT(PR.IR); NEW_LINE;
|
||||
ALLOWED := FALSE;
|
||||
elsif (PR.IR.QUAL.V.TENSE_VOICE_MOOD.VOICE = ACTIVE) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.TENSE in PERF..FUTP ) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD.MOOD in IND..IMP) then
|
||||
--PUT("SEMIDEP Perf not in PASSIVE "); PUT(PR.IR); NEW_LINE;
|
||||
ALLOWED := FALSE;
|
||||
else
|
||||
null;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
|
||||
if WORDS_MDEV(FOR_WORD_LIST_CHECK) then
|
||||
if (PR.IR.QUAL.V.PERSON = 1) and then
|
||||
(PR.IR.QUAL.V.NUMBER = S) then
|
||||
if ((DE.PART.V.KIND in X..INTRANS) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD = (PRES, ACTIVE, IND))) or else
|
||||
((DE.PART.V.KIND = DEP) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD = (PRES, PASSIVE, IND))) or else
|
||||
((DE.PART.V.KIND = SEMIDEP) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD = (PRES, ACTIVE, IND))) then
|
||||
ALLOWED := TRUE;
|
||||
elsif ((DE.PART.V.KIND = PERFDEF) and
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD = (PERF, ACTIVE, IND))) then
|
||||
ALLOWED := TRUE;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
elsif (DE.PART.V.KIND = IMPERS) then
|
||||
if (PR.IR.QUAL.V.PERSON = 3) and then
|
||||
(PR.IR.QUAL.V.NUMBER = S) and then
|
||||
(PR.IR.QUAL.V.TENSE_VOICE_MOOD = (PRES, ACTIVE, IND)) then
|
||||
ALLOWED := TRUE;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
else
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
|
||||
|
||||
when others =>
|
||||
null;
|
||||
|
||||
end case;
|
||||
|
||||
|
||||
if WORDS_MDEV(FOR_WORD_LIST_CHECK) then -- Non parts
|
||||
if (PR.IR.QUAL.POFS in VPAR..SUPINE) then
|
||||
ALLOWED := FALSE;
|
||||
end if;
|
||||
end if; -- Non parts
|
||||
--TEXT_IO.PUT_LINE("Returning FOR ALLOWED " & BOOLEAN'IMAGE(ALLOWED));
|
||||
return ALLOWED;
|
||||
|
||||
end ALLOWED_STEM;
|
||||
|
||||
|
||||
-----------------------------------------------------------
|
||||
|
||||
|
||||
procedure ORDER_PARSE_ARRAY(SL: in out PARSE_ARRAY; DIFF_J : out INTEGER) is
|
||||
use INFLECTION_RECORD_IO;
|
||||
use DICT_IO;
|
||||
|
||||
HITS : INTEGER := 0;
|
||||
SL_FIRST : INTEGER := SL'FIRST;
|
||||
SL_LAST : INTEGER := SL'LAST;
|
||||
SL_LAST_INITIAL : INTEGER := SL_LAST;
|
||||
SM : PARSE_RECORD;
|
||||
--DE, ODE : DICTIONARY_ENTRY;
|
||||
ROMAN_NUMBER : BOOLEAN := FALSE;
|
||||
HAS_NOUN_ABBREVIATION : BOOLEAN := FALSE;
|
||||
-- HAS_ADJECTIVE_ABBREVIATION : BOOLEAN := FALSE;
|
||||
-- HAS_VERB_ABBREVIATION : BOOLEAN := FALSE;
|
||||
NOT_ONLY_VOCATIVE : BOOLEAN := FALSE;
|
||||
NOT_ONLY_LOCATIVE : BOOLEAN := FALSE;
|
||||
|
||||
J : INTEGER := SL'FIRST;
|
||||
|
||||
function DEPR (PR : PARSE_RECORD) return DICTIONARY_ENTRY is
|
||||
DE : DICTIONARY_ENTRY;
|
||||
begin
|
||||
--TEXT_IO.PUT("DEPR "); PARSE_RECORD_IO.PUT(PR); TEXT_IO.NEW_LINE;
|
||||
if PR.MNPC = NULL_MNPC then
|
||||
return NULL_DICTIONARY_ENTRY;
|
||||
else
|
||||
if PR.D_K in GENERAL..LOCAL then
|
||||
--if PR.MNPC /= OMNPC then
|
||||
DICT_IO.SET_INDEX(DICT_FILE(PR.D_K), PR.MNPC);
|
||||
DICT_IO.READ(DICT_FILE(PR.D_K), DE);
|
||||
--OMNPC := PR.MNPC;
|
||||
--ODE := DE;
|
||||
--else
|
||||
--DE := ODE;
|
||||
--end if;
|
||||
elsif PR.D_K = UNIQUE then
|
||||
DE := UNIQUES_DE(PR.MNPC);
|
||||
end if;
|
||||
end if;
|
||||
-- DICT_IO.SET_INDEX(DICT_FILE(PR.D_K), PR.MNPC);
|
||||
-- DICT_IO.READ(DICT_FILE(PR.D_K), DE);
|
||||
--TEXT_IO.PUT_LINE("Returning from DEPR MNPC = " & INTEGER'IMAGE(INTEGER(PR.MNPC)) & " ");
|
||||
--DICTIONARY_ENTRY_IO.PUT(DE); TEXT_IO.NEW_LINE;
|
||||
return DE;
|
||||
end DEPR;
|
||||
|
||||
begin
|
||||
|
||||
if SL'LENGTH = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
||||
-- Bubble sort since this list should usually be very small (1-5)
|
||||
HIT_LOOP:
|
||||
loop
|
||||
HITS := 0;
|
||||
|
||||
|
||||
--------------------------------------------------
|
||||
|
||||
|
||||
SWITCH:
|
||||
declare
|
||||
|
||||
function "<" (LEFT, RIGHT : QUALITY_RECORD) return BOOLEAN is
|
||||
begin
|
||||
if LEFT.POFS = RIGHT.POFS and then
|
||||
LEFT.POFS = PRON and then
|
||||
LEFT.PRON.DECL.WHICH = 1 then
|
||||
return (LEFT.PRON.DECL.VAR < RIGHT.PRON.DECL.VAR);
|
||||
else
|
||||
return INFLECTIONS_PACKAGE."<"(LEFT, RIGHT);
|
||||
end if;
|
||||
end "<";
|
||||
|
||||
function EQU (LEFT, RIGHT : QUALITY_RECORD) return BOOLEAN is
|
||||
begin
|
||||
|
||||
if LEFT.POFS = RIGHT.POFS and then
|
||||
LEFT.POFS = PRON and then
|
||||
LEFT.PRON.DECL.WHICH = 1 then
|
||||
|
||||
return (LEFT.PRON.DECL.VAR = RIGHT.PRON.DECL.VAR);
|
||||
else
|
||||
|
||||
return INFLECTIONS_PACKAGE."="(LEFT, RIGHT);
|
||||
end if;
|
||||
|
||||
end EQU;
|
||||
|
||||
|
||||
|
||||
function MEANING (PR : PARSE_RECORD) return MEANING_TYPE is
|
||||
begin
|
||||
return DEPR(PR).MEAN;
|
||||
end MEANING;
|
||||
|
||||
begin
|
||||
-- Need to remove duplicates in ARRAY_STEMS
|
||||
-- This sort is very sloppy
|
||||
-- One problem is that it can mix up some of the order of PREFIX, XXX, LOC
|
||||
-- I ought to do this for every set of results from different approaches
|
||||
-- not just in one fell swoop at the end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
INNER_LOOP:
|
||||
for I in SL'FIRST..SL_LAST-1 loop
|
||||
-- Maybe < = on PR.STEM - will have to make up "<" -- Actually STEM and PART -- and check that later in print
|
||||
if SL(I+1).D_K > SL(I).D_K or else -- Let DICT.LOC list first
|
||||
|
||||
(SL(I+1).D_K = SL(I).D_K and then
|
||||
SL(I+1).MNPC < SL(I).MNPC) or else
|
||||
|
||||
(SL(I+1).D_K = SL(I).D_K and then
|
||||
SL(I+1).MNPC = SL(I).MNPC and then
|
||||
SL(I+1).IR.QUAL < SL(I).IR.QUAL) or else
|
||||
|
||||
(SL(I+1).D_K = SL(I).D_K and then
|
||||
SL(I+1).MNPC = SL(I).MNPC and then
|
||||
EQU(SL(I+1).IR.QUAL, SL(I).IR.QUAL) and then
|
||||
MEANING(SL(I+1)) < MEANING(SL(I))) or else -- | is > letter
|
||||
|
||||
(SL(I+1).D_K = SL(I).D_K and then
|
||||
SL(I+1).MNPC = SL(I).MNPC and then
|
||||
EQU(SL(I+1).IR.QUAL, SL(I).IR.QUAL) and then
|
||||
MEANING(SL(I+1)) = MEANING(SL(I)) and then
|
||||
SL(I+1).IR.ENDING.SIZE < SL(I).IR.ENDING.SIZE) or else
|
||||
|
||||
(SL(I+1).D_K = SL(I).D_K and then
|
||||
SL(I+1).MNPC = SL(I).MNPC and then
|
||||
EQU(SL(I+1).IR.QUAL, SL(I).IR.QUAL) and then
|
||||
MEANING(SL(I+1)) = MEANING(SL(I)) and then
|
||||
SL(I+1).IR.ENDING.SIZE = SL(I).IR.ENDING.SIZE and then
|
||||
INFLECTIONS_PACKAGE."<"(SL(I+1).IR.QUAL, SL(I).IR.QUAL))
|
||||
then
|
||||
|
||||
|
||||
SM := SL(I);
|
||||
SL(I) := SL(I+1);
|
||||
SL(I+1) := SM;
|
||||
HITS := HITS + 1;
|
||||
|
||||
end if;
|
||||
|
||||
end loop INNER_LOOP;
|
||||
|
||||
|
||||
end SWITCH;
|
||||
--------------------------------------------------
|
||||
|
||||
|
||||
exit when HITS = 0;
|
||||
end loop HIT_LOOP;
|
||||
|
||||
|
||||
|
||||
-- Fix up the Archaic/Medieval
|
||||
if WORDS_MODE(TRIM_OUTPUT) then
|
||||
-- Remove those inflections if MDEV and there is other valid
|
||||
-- TEXT_IO.PUT_LINE("SCANNING FOR TRIM SL'FIRST = " & INTEGER'IMAGE(SL'FIRST) & " SL'LAST = " & INTEGER'IMAGE(SL'LAST) );
|
||||
-- for I in SL'FIRST..SL_LAST loop
|
||||
-- PARSE_RECORD_IO.PUT(SL(I)); TEXT_IO.NEW_LINE;
|
||||
-- end loop;
|
||||
|
||||
-- Check to see if we can afford to TRIM, if there will be something left over
|
||||
for I in SL'FIRST..SL_LAST loop
|
||||
--TEXT_IO.PUT_LINE("SCANNING FOR TRIM I = " & INTEGER'IMAGE(I) & " INFL AGE = " & AGE_TYPE'IMAGE(SL(I).IR.AGE));
|
||||
if SL(I).D_K in GENERAL..LOCAL then
|
||||
|
||||
DICT_IO.SET_INDEX(DICT_FILE(SL(I).D_K), SL(I).MNPC);
|
||||
--TEXT_IO.PUT(INTEGER'IMAGE(INTEGER(SL(I).MNPC)));
|
||||
DICT_IO.READ(DICT_FILE(SL(I).D_K), DE);
|
||||
--DICTIONARY_ENTRY_IO.PUT(DE); TEXT_IO.NEW_LINE;
|
||||
|
||||
if ((SL(I).IR.AGE = X) or else (SL(I).IR.AGE > A)) and
|
||||
((DE.TRAN.AGE = X) or else (DE.TRAN.AGE > A)) then
|
||||
NOT_ONLY_ARCHAIC := TRUE;
|
||||
end if;
|
||||
if ((SL(I).IR.AGE = X) or else (SL(I).IR.AGE < F)) and -- Or E????
|
||||
((DE.TRAN.AGE = X) or else (DE.TRAN.AGE < F)) then -- Or E????
|
||||
NOT_ONLY_MEDIEVAL := TRUE;
|
||||
end if;
|
||||
if ((SL(I).IR.FREQ = X) or else (SL(I).IR.FREQ < C)) and -- A/X < C -- C for inflections is uncommon !!!!
|
||||
((DE.TRAN.FREQ = X) or else (DE.TRAN.FREQ < D)) then -- -- E for DICTLINE is uncommon !!!!
|
||||
NOT_ONLY_UNCOMMON := TRUE;
|
||||
end if;
|
||||
-- TEXT_IO.PUT_LINE("NOT_ONLY_ARCHAIC = " & BOOLEAN'IMAGE(NOT_ONLY_ARCHAIC));
|
||||
-- TEXT_IO.PUT_LINE("NOT_ONLY_MEDIEVAL = " & BOOLEAN'IMAGE(NOT_ONLY_MEDIEVAL));
|
||||
-- TEXT_IO.PUT_LINE("NOT_ONLY_UNCOMMON = " & BOOLEAN'IMAGE(NOT_ONLY_UNCOMMON));
|
||||
|
||||
|
||||
-- if ((SL(I).IR.QUAL.POFS = N) and then (SL(I).IR.QUAL.N.CS /= VOC)) or
|
||||
-- ((SL(I).IR.QUAL.POFS = ADJ) and then (SL(I).IR.QUAL.ADJ.CS /= VOC)) or
|
||||
-- ((SL(I).IR.QUAL.POFS = VPAR) and then (SL(I).IR.QUAL.VPAR.CS /= VOC)) then
|
||||
-- NOT_ONLY_VOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- if (SL(I).IR.QUAL.POFS = N) and then (SL(I).IR.QUAL.N.CS /= LOC) then
|
||||
-- NOT_ONLY_LOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- if (SL(I).IR.QUAL.POFS = ADJ) and then (SL(I).IR.QUAL.ADJ.CS /= VOC) then
|
||||
-- NOT_ONLY_VOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- if (SL(I).IR.QUAL.POFS = ADJ) and then (SL(I).IR.QUAL.ADJ.CS /= LOC) then
|
||||
-- NOT_ONLY_LOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- if (SL(I).IR.QUAL.POFS = VPAR) and then (SL(I).IR.QUAL.VPAR.CS /= VOC) then
|
||||
-- NOT_ONLY_VOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- if (SL(I).IR.QUAL.POFS = VPAR) and then (SL(I).IR.QUAL.VPAR.CS /= LOC) then
|
||||
-- NOT_ONLY_LOCATIVE := TRUE;
|
||||
-- end if;
|
||||
-- TEXT_IO.PUT_LINE("NOT_ONLY_VOCATIVE = " & BOOLEAN'IMAGE(NOT_ONLY_VOCATIVE));
|
||||
-- TEXT_IO.PUT_LINE("NOT_ONLY_LOCATIVE = " & BOOLEAN'IMAGE(NOT_ONLY_LOCATIVE));
|
||||
|
||||
if SL(I).IR.QUAL.POFS = N and then
|
||||
SL(I).IR.QUAL.N.DECL = (9, 8) then
|
||||
HAS_NOUN_ABBREVIATION := TRUE;
|
||||
--TEXT_IO.PUT_LINE("Has noun abbreviation I = " & INTEGER'IMAGE(I));
|
||||
-- elsif SL(I).IR.QUAL.POFS = ADJ and then
|
||||
-- SL(I).IR.QUAL.ADJ.DECL = (9, 8) then
|
||||
-- HAS_ADJECTIVE_ABBREVIATION := TRUE;
|
||||
-- elsif SL(I).IR.QUAL.POFS = V and then
|
||||
-- SL(I).IR.QUAL.V.CON = (9, 8) then
|
||||
-- HAS_VERB_ABBREVIATION := TRUE;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
|
||||
-- We order and trim within a subset SL, but have to correct the big set PA also
|
||||
-- Kill not ALLOWED first, then check the remaining from the top
|
||||
-- I am assuming there is no trimming of FIXES for AGE/...
|
||||
I := SL_LAST;
|
||||
while I >= SL'FIRST loop
|
||||
if (not ALLOWED_STEM(SL(I)) or -- Remove not ALLOWED_STEM & null
|
||||
(PA(I) = NULL_PARSE_RECORD)) then
|
||||
--TEXT_IO.PUT_LINE("Not ALLOWED SL_LAST = " & INTEGER'IMAGE(SL_LAST) & " J = " & INTEGER'IMAGE(I));
|
||||
SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
SL_LAST := SL_LAST - 1;
|
||||
TRIMMED := TRUE;
|
||||
--TEXT_IO.PUT_LINE("Not ALLOWED end SL_LAST = " & INTEGER'IMAGE(SL_LAST) & " J = " & INTEGER'IMAGE(I));
|
||||
end if;
|
||||
I := I - 1;
|
||||
end loop;
|
||||
|
||||
I := SL_LAST;
|
||||
while I >= SL'FIRST loop
|
||||
--TEXT_IO.PUT_LINE("TRIMMING FOR TRIM I = " & INTEGER'IMAGE(I));
|
||||
if (NOT_ONLY_ARCHAIC and WORDS_MDEV(OMIT_ARCHAIC)) and then
|
||||
SL(I).IR.AGE = A then
|
||||
SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
SL_LAST := SL_LAST - 1;
|
||||
--TEXT_IO.PUT_LINE("Archaic SL_LAST = " & INTEGER'IMAGE(SL_LAST) & " I = " & INTEGER'IMAGE(I));
|
||||
TRIMMED := TRUE;
|
||||
elsif (NOT_ONLY_MEDIEVAL and WORDS_MDEV(OMIT_MEDIEVAL)) and then
|
||||
SL(I).IR.AGE >= F then
|
||||
SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
SL_LAST := SL_LAST - 1;
|
||||
--TEXT_IO.PUT_LINE("Medieval SL_LAST = " & INTEGER'IMAGE(SL_LAST) & " I = " & INTEGER'IMAGE(I));
|
||||
TRIMMED := TRUE;
|
||||
end if;
|
||||
I := I - 1;
|
||||
end loop;
|
||||
|
||||
I := SL_LAST;
|
||||
while I >= SL'FIRST loop
|
||||
if (NOT_ONLY_UNCOMMON and WORDS_MDEV(OMIT_UNCOMMON)) and then
|
||||
SL(I).IR.FREQ >= C then -- Remember A < C
|
||||
SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
SL_LAST := SL_LAST - 1;
|
||||
--TEXT_IO.PUT_LINE("Uncommon SL_LAST = " & INTEGER'IMAGE(SL_LAST) & " I = " & INTEGER'IMAGE(I));
|
||||
TRIMMED := TRUE;
|
||||
end if;
|
||||
I := I - 1;
|
||||
end loop;
|
||||
|
||||
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------
|
||||
----Big problem. This area has been generaing exceptions.
|
||||
----At least one difficulty is that suffixes change POFS.
|
||||
----So one has a N inflection (SL) but a V DE
|
||||
----When the program checks for VOC, it wants a N
|
||||
---- and then asks about KIND (P, N, T,...)
|
||||
---- But the DE (v) does not have those
|
||||
---- The solution would be to fix ADD SUFFIX to do somethnig about passing the ADDON KIND
|
||||
---- I do not want to face that now
|
||||
---- It is likely that all this VOC/LOC is worthless anyway. Maybe lower FREQ in INFLECTS
|
||||
----
|
||||
---- A further complication is the GANT and AO give different results (AO no exception)
|
||||
---- That is probably because the program is in error and the result threrfore unspecified
|
||||
----
|
||||
----
|
||||
|
||||
--
|
||||
-- I := SL_LAST;
|
||||
--TEXT_IO.PUT_LINE("Checking VOC/LOC SL_LAST = " & INTEGER'IMAGE(SL_LAST));
|
||||
-- while I >= SL'FIRST loop
|
||||
-- -- Check for Vocative being person/name and Locative a place/area
|
||||
----TEXT_IO.PUT_LINE("Looping down on I I = " & INTEGER'IMAGE(I));
|
||||
-- if (SL(I).IR.QUAL.POFS = N) then
|
||||
--TEXT_IO.PUT_LINE("N found I = " & INTEGER'IMAGE(I));
|
||||
--PARSE_RECORD_IO.PUT(SL(I)); TEXT_IO.NEW_LINE;
|
||||
-- if NOT_ONLY_VOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.N.CS = VOC) and then
|
||||
-- ((DEPR(SL(I)).PART.N.KIND /= N) and
|
||||
-- (DEPR(SL(I)).PART.N.KIND /= P)) then
|
||||
----TEXT_IO.PUT_LINE("N VOC not a P or N I = " & INTEGER'IMAGE(I));
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- elsif NOT_ONLY_LOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.N.CS = LOC) and then
|
||||
-- ((DEPR(SL(I)).PART.N.KIND /= L) and
|
||||
-- (DEPR(SL(I)).PART.N.KIND /= W)) then
|
||||
----TEXT_IO.PUT_LINE("N LOC not a W or L ");
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- end if;
|
||||
-- end if;
|
||||
-- I := I - 1;
|
||||
-- end loop;
|
||||
----TEXT_IO.PUT_LINE("Checked VOC/LOC");
|
||||
--
|
||||
--
|
||||
-- -- Cutting viciously here
|
||||
-- I := SL_LAST;
|
||||
-- while I >= SL'FIRST loop
|
||||
-- if (SL(I).IR.QUAL.POFS = ADJ) then
|
||||
-- if NOT_ONLY_VOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.ADJ.CS = VOC) then
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- elsif NOT_ONLY_LOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.ADJ.CS = LOC) then
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- end if;
|
||||
-- end if;
|
||||
-- I := I - 1;
|
||||
-- end loop;
|
||||
--
|
||||
--
|
||||
--
|
||||
-- I := SL_LAST;
|
||||
-- while I >= SL'FIRST loop
|
||||
-- if (SL(I).IR.QUAL.POFS = VPAR) then
|
||||
-- if NOT_ONLY_VOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.VPAR.CS = VOC) then
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- elsif NOT_ONLY_LOCATIVE and then
|
||||
-- (SL(I).IR.QUAL.VPAR.CS = LOC) then
|
||||
-- SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
-- SL_LAST := SL_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
-- end if;
|
||||
-- end if;
|
||||
-- I := I - 1;
|
||||
-- end loop;
|
||||
--
|
||||
|
||||
|
||||
-- This is really working much too hard!
|
||||
-- just to kill Roman numeral for three single letters
|
||||
-- Also strange in that code depends on dictionary knowledge
|
||||
I := SL_LAST;
|
||||
while I >= SL'FIRST loop
|
||||
if HAS_NOUN_ABBREVIATION and then
|
||||
(ALL_CAPS and FOLLOWED_BY_PERIOD) then
|
||||
if (SL(I).IR.QUAL.POFS /= N) or
|
||||
( (SL(I).IR.QUAL /= (N, ((9, 8), X, X, M))) and
|
||||
( TRIM(SL(I).STEM)'LENGTH = 1 and then
|
||||
(SL(I).STEM(1) = 'A' or
|
||||
SL(I).STEM(1) = 'C' or
|
||||
SL(I).STEM(1) = 'D' or
|
||||
--SL(I).STEM(1) = 'K' or -- No problem here
|
||||
SL(I).STEM(1) = 'L' or
|
||||
SL(I).STEM(1) = 'M' -- or
|
||||
--SL(I).STEM(1) = 'N' or
|
||||
--SL(I).STEM(1) = 'P' or
|
||||
--SL(I).STEM(1) = 'Q' or
|
||||
--SL(I).STEM(1) = 'T'
|
||||
) ) ) then
|
||||
SL(I..SL_LAST-1) := SL(I+1..SL_LAST);
|
||||
SL_LAST := SL_LAST - 1;
|
||||
TRIMMED := TRUE;
|
||||
end if;
|
||||
end if;
|
||||
I := I - 1;
|
||||
end loop;
|
||||
|
||||
|
||||
|
||||
end if; -- On TRIM
|
||||
|
||||
DIFF_J := SL_LAST_INITIAL - SL_LAST;
|
||||
|
||||
end ORDER_PARSE_ARRAY;
|
||||
|
||||
|
||||
|
||||
|
||||
begin -- LIST_SWEEP
|
||||
|
||||
|
||||
|
||||
-- DICT_IO.READ(DICT_FILE(GENERAL), DE, 31585);
|
||||
-- DICTIONARY_ENTRY_IO.PUT(DE); TEXT_IO.PUT_LINE("#########");
|
||||
|
||||
|
||||
if PA'LENGTH = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
||||
-- TEXT_IO.PUT_LINE("PA on entering LIST_SWEEP PA_LAST = " & INTEGER'IMAGE(PA_LAST));
|
||||
-- for I in 1..PA_LAST loop
|
||||
-- PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
|
||||
-- end loop;
|
||||
|
||||
|
||||
|
||||
RESET_PRONOUN_KIND:
|
||||
declare
|
||||
DE : DICTIONARY_ENTRY;
|
||||
begin
|
||||
for I in 1..PA_LAST loop
|
||||
if PA(I).D_K = GENERAL then
|
||||
DICT_IO.SET_INDEX(DICT_FILE(PA(I).D_K), PA(I).MNPC);
|
||||
DICT_IO.READ(DICT_FILE(PA(I).D_K), DE);
|
||||
if DE.PART.POFS = PRON and then
|
||||
DE.PART.PRON.DECL.WHICH =1 then
|
||||
PA(I).IR.QUAL.PRON.DECL.VAR := PRONOUN_KIND_TYPE'POS(DE.PART.PRON.KIND);
|
||||
--elsif DE.PART.POFS = PACK and then
|
||||
-- DE.PART.PACK.DECL.WHICH =1 then
|
||||
-- PA(I).IR.QUAL.PACK.DECL.VAR := PRONOUN_KIND_TYPE'POS(DE.KIND.PRON_KIND);
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
end RESET_PRONOUN_KIND;
|
||||
|
||||
---------------------------------------------------
|
||||
|
||||
|
||||
|
||||
-- NEED TO REMOVE DISALLOWED BEFORE DOING ANYTHING - BUT WITHOUT REORDERING
|
||||
|
||||
|
||||
-- The problem I seem to have to face first, if not the first problem,
|
||||
-- is the situation in which there are several sets of identical IRs with different MNPC
|
||||
-- These may be variants with some other stem (e.g., K=3) not affecting the (K=1) word
|
||||
-- Or they might be identical forms with different meanings (| additional meanings)
|
||||
-- I need to group such common inflections - and pass this on somehow
|
||||
|
||||
|
||||
-- TEXT_IO.PUT_LINE("PA before SWEEPING in LIST_SWEEP PA_LAST = " & INTEGER'IMAGE(PA_LAST));
|
||||
-- for I in 1..PA_LAST loop
|
||||
-- PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
|
||||
-- end loop;
|
||||
|
||||
|
||||
SWEEPING:
|
||||
-- To remove disallowed stems/inflections and resulting dangling fixes
|
||||
declare
|
||||
FIX_ON : BOOLEAN := FALSE;
|
||||
PW_ON : BOOLEAN := FALSE;
|
||||
P_FIRST : INTEGER := 1;
|
||||
P_LAST : INTEGER := 0;
|
||||
subtype XONS is PART_OF_SPEECH_TYPE range TACKON..SUFFIX;
|
||||
|
||||
|
||||
begin
|
||||
--
|
||||
-- TEXT_IO.NEW_LINE;
|
||||
-- TEXT_IO.PUT_LINE("SWEEPING ======================================");
|
||||
-- TEXT_IO.NEW_LINE;
|
||||
--TEXT_IO.PUT("{");
|
||||
J := PA_LAST;
|
||||
|
||||
while J >= 1 loop -- Sweep backwards over PA
|
||||
|
||||
|
||||
|
||||
-- if (not ALLOWED_STEM(PA(J)) or -- Remove not ALLOWED_STEM & null
|
||||
-- (PA(J) = NULL_PARSE_RECORD)) then -- and close ranks
|
||||
-- TEXT_IO.PUT_LINE("Removing dis ALLOWED STEM J = " & INTEGER'IMAGE(J));
|
||||
-- PA(J..PA_LAST-1) := PA(J+1..PA_LAST); -- null if J = PA_LAST
|
||||
-- PA_LAST := PA_LAST - 1;
|
||||
-- P_LAST := P_LAST - 1;
|
||||
-- TRIMMED := TRUE;
|
||||
|
||||
|
||||
if ((PA(J).D_K in ADDONS..YYY) or (PA(J).IR.QUAL.POFS in XONS)) and then
|
||||
(PW_ON) then -- first FIX/TRICK after regular
|
||||
FIX_ON := TRUE;
|
||||
PW_ON := FALSE;
|
||||
P_FIRST := J + 1;
|
||||
--P_LAST := J + 1;
|
||||
--TEXT_IO.PUT_LINE("SWEEP FIX/TRICK J = " & INTEGER'IMAGE(J) & " P_FIRST = " & INTEGER'IMAGE(P_FIRST) &
|
||||
--" P_LAST = " & INTEGER'IMAGE(P_LAST));
|
||||
JJ := J;
|
||||
while PA(JJ+1).IR.QUAL.POFS = PA(JJ).IR.QUAL.POFS loop
|
||||
P_LAST := JJ + 1;
|
||||
end loop;
|
||||
|
||||
|
||||
----Order internal to this set of inflections
|
||||
-- TEXT_IO.PUT_LINE("SWEEP INTERNAL J = " & INTEGER'IMAGE(J) & " P_FIRST = " & INTEGER'IMAGE(P_FIRST) &
|
||||
-- " P_LAST = " & INTEGER'IMAGE(P_LAST) & " DIFF_J = " & INTEGER'IMAGE(DIFF_J) & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
|
||||
ORDER_PARSE_ARRAY(PA(P_FIRST..P_LAST), DIFF_J);
|
||||
--PA(J..PA_LAST-1) := PA(J+1..PA_LAST);
|
||||
PA(P_LAST-DIFF_J+1..PA_LAST-DIFF_J) := PA(P_LAST+1..PA_LAST);
|
||||
PA_LAST := PA_LAST - DIFF_J;
|
||||
-- TEXT_IO.PUT_LINE("SWEEP INTERNAL end J = " & INTEGER'IMAGE(J) & " P_FIRST = " & INTEGER'IMAGE(P_FIRST) &
|
||||
-- " P_LAST = " & INTEGER'IMAGE(P_LAST) & " DIFF_J = " & INTEGER'IMAGE(DIFF_J) & " PA_LAST = " & INTEGER'IMAGE(PA_LAST));
|
||||
P_FIRST := 1;
|
||||
P_LAST := 0;
|
||||
|
||||
|
||||
elsif ((PA(J).D_K in ADDONS..YYY) or (PA(J).IR.QUAL.POFS in XONS)) and then
|
||||
(FIX_ON) then -- another FIX
|
||||
--TEXT_IO.PUT_LINE("SWEEP Another FIX/TRICK J = " & INTEGER'IMAGE(J));
|
||||
null;
|
||||
|
||||
|
||||
elsif ((PA(J).D_K in ADDONS..YYY) or
|
||||
(PA(J).IR.QUAL.POFS = X)) and then -- Kills TRICKS stuff
|
||||
(not PW_ON) then
|
||||
--TEXT_IO.PUT_LINE("Killing Tricks stuff J = " & INTEGER'IMAGE(J));
|
||||
PA(P_LAST-DIFF_J+1..PA_LAST-DIFF_J) := PA(P_LAST+1..PA_LAST);
|
||||
PA_LAST := PA_LAST - DIFF_J;
|
||||
--PA_LAST := PA_LAST - 1;
|
||||
P_LAST := P_LAST - 1;
|
||||
|
||||
|
||||
else
|
||||
--TEXT_IO.PUT_LINE("SWEEP else J = " & INTEGER'IMAGE(J) & " P_LAST = " & INTEGER'IMAGE(P_LAST));
|
||||
--for I in 1..PA_LAST loop
|
||||
--PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
|
||||
--end loop;
|
||||
PW_ON := TRUE;
|
||||
FIX_ON := FALSE;
|
||||
if P_LAST <= 0 then
|
||||
P_LAST := J;
|
||||
end if;
|
||||
if J = 1 then
|
||||
--TEXT_IO.PUT_LINE("SWEEP J = 1 P_LAST = " & INTEGER'IMAGE(P_LAST));
|
||||
ORDER_PARSE_ARRAY(PA(1..P_LAST), DIFF_J);
|
||||
PA(P_LAST-DIFF_J+1..PA_LAST-DIFF_J) := PA(P_LAST+1..PA_LAST);
|
||||
PA_LAST := PA_LAST - DIFF_J;
|
||||
--TEXT_IO.PUT_LINE("SWEEP J = 1 end PA_LAST = " & INTEGER'IMAGE(PA_LAST) & " DIFF_J = " & INTEGER'IMAGE(DIFF_J));
|
||||
end if;
|
||||
|
||||
|
||||
end if; -- check PART
|
||||
|
||||
|
||||
J := J - 1;
|
||||
|
||||
end loop; -- loop sweep over PA
|
||||
|
||||
end SWEEPING;
|
||||
|
||||
-- TEXT_IO.PUT_LINE("PA after SWEEPING in LIST_STEMS - before COMPRESS_LOOP PA_LAST = "
|
||||
-- & INTEGER'IMAGE(PA_LAST));
|
||||
-- for I in 1..PA_LAST loop
|
||||
-- PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
|
||||
-- end loop;
|
||||
|
||||
OPR := PA(1);
|
||||
-- Last chance to weed out duplicates
|
||||
J := 2;
|
||||
COMPRESS_LOOP:
|
||||
loop
|
||||
exit when J > PA_LAST;
|
||||
PR := PA(J);
|
||||
if PR /= OPR then
|
||||
SUPRESS_KEY_CHECK:
|
||||
declare
|
||||
function "<=" (A, B : PARSE_RECORD) return BOOLEAN is
|
||||
begin -- !!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
if A.IR.QUAL = B.IR.QUAL and
|
||||
A.MNPC = B.MNPC then
|
||||
return TRUE;
|
||||
else
|
||||
return FALSE;
|
||||
end if;
|
||||
end "<=";
|
||||
function "<" (A, B : PARSE_RECORD) return BOOLEAN is
|
||||
begin -- !!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
if A.IR.QUAL = B.IR.QUAL and
|
||||
A.MNPC /= B.MNPC then
|
||||
return TRUE;
|
||||
else
|
||||
return FALSE;
|
||||
end if;
|
||||
end "<";
|
||||
begin
|
||||
if ((PR.D_K /= XXX) and (PR.D_K /= YYY) and (PR.D_K /= PPP)) then
|
||||
if PR <= OPR then -- Get rid of duplicates, if ORDER is OK
|
||||
PA(J.. PA_LAST-1) := PA(J+1..PA_LAST); -- Shift PA down 1
|
||||
PA_LAST := PA_LAST - 1; -- because found key duplicate
|
||||
end if;
|
||||
else
|
||||
J := J + 1;
|
||||
end if;
|
||||
end SUPRESS_KEY_CHECK;
|
||||
else
|
||||
J := J + 1;
|
||||
|
||||
end if;
|
||||
OPR := PR;
|
||||
end loop COMPRESS_LOOP;
|
||||
|
||||
|
||||
|
||||
for I in 1..PA_LAST loop
|
||||
-- Set to 0 the VAR for N -- DON'T
|
||||
-- if PA(I).IR.QUAL.POFS = N then
|
||||
-- PA(I).IR.QUAL.N.DECL.VAR := 0;
|
||||
-- end if;
|
||||
-- Destroy the artificial VAR for PRON 1 X
|
||||
if PA(I).IR.QUAL.POFS = PRON and then
|
||||
PA(I).IR.QUAL.PRON.DECL.WHICH =1 then
|
||||
PA(I).IR.QUAL.PRON.DECL.VAR := 0;
|
||||
end if;
|
||||
if PA(I).IR.QUAL.POFS = V then
|
||||
if PA(I).IR.QUAL.V.CON = (3, 4) then
|
||||
-- Fix V 3 4 to be 4th conjugation
|
||||
PA(I).IR.QUAL.V.CON := (4, 1);
|
||||
-- else
|
||||
-- -- Set to 0 other VAR for V
|
||||
-- PA(I).IR.QUAL.V.CON.VAR := 0;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
|
||||
|
||||
-- TEXT_IO.PUT_LINE("PA after COMPRESS almost leaving LIST_STEMS PA_LAST = " & INTEGER'IMAGE(PA_LAST));
|
||||
-- for I in 1..PA_LAST loop
|
||||
-- PARSE_RECORD_IO.PUT(PA(I)); TEXT_IO.NEW_LINE;
|
||||
-- end loop;
|
||||
|
||||
--TEXT_IO.PUT("}");
|
||||
|
||||
end LIST_SWEEP;
|
||||
Reference in New Issue
Block a user