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;