import from .zip file
This commit is contained in:
Michael Wolf
875
makeewds.adb
Normal file
875
makeewds.adb
Normal file
@@ -0,0 +1,875 @@
|
||||
with TEXT_IO;
|
||||
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
|
||||
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
|
||||
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
|
||||
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
|
||||
with LINE_STUFF; use LINE_STUFF;
|
||||
with ENGLISH_SUPPORT_PACKAGE; use ENGLISH_SUPPORT_PACKAGE;
|
||||
with WEED;
|
||||
with WEED_ALL;
|
||||
with DICTIONARY_FORM;
|
||||
procedure MAKEEWDS is
|
||||
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
|
||||
use TEXT_IO;
|
||||
use INTEGER_IO;
|
||||
use STEM_KEY_TYPE_IO;
|
||||
use DICTIONARY_ENTRY_IO;
|
||||
use PART_ENTRY_IO;
|
||||
use PART_OF_SPEECH_TYPE_IO;
|
||||
use KIND_ENTRY_IO;
|
||||
use TRANSLATION_RECORD_IO;
|
||||
use AGE_TYPE_IO;
|
||||
use AREA_TYPE_IO;
|
||||
use GEO_TYPE_IO;
|
||||
use FREQUENCY_TYPE_IO;
|
||||
use SOURCE_TYPE_IO;
|
||||
use EWDS_Record_io;
|
||||
|
||||
|
||||
PORTING : constant BOOLEAN := FALSE;
|
||||
CHECKING : constant BOOLEAN := TRUE;
|
||||
|
||||
|
||||
D_K : DICTIONARY_KIND := XXX; -- ######################
|
||||
|
||||
|
||||
START_STEM_1 : constant := 1;
|
||||
START_STEM_2 : constant := START_STEM_1 + MAX_STEM_SIZE + 1;
|
||||
START_STEM_3 : constant := START_STEM_2 + MAX_STEM_SIZE + 1;
|
||||
START_STEM_4 : constant := START_STEM_3 + MAX_STEM_SIZE + 1;
|
||||
START_PART : constant := START_STEM_4 + MAX_STEM_SIZE + 1;
|
||||
START_TRAN : constant INTEGER :=
|
||||
START_PART +
|
||||
INTEGER(PART_ENTRY_IO.DEFAULT_WIDTH + 1);
|
||||
FINISH_LINE : constant INTEGER :=
|
||||
START_TRAN +
|
||||
TRANSLATION_RECORD_IO.DEFAULT_WIDTH - 1;
|
||||
|
||||
LINE_NUMBER : INTEGER := 0;
|
||||
|
||||
subtype WORD_TYPE is STRING(1..MAX_MEANING_SIZE);
|
||||
subtype LINE_TYPE is STRING(1..400);
|
||||
|
||||
N : INTEGER := 0;
|
||||
|
||||
|
||||
INPUT, OUTPUT, CHECK : TEXT_IO.FILE_TYPE;
|
||||
DE : DICTIONARY_ENTRY;
|
||||
|
||||
NULL_WORD_TYPE, BLANK_WORD : WORD_TYPE := (others => ' ');
|
||||
S, LINE, BLANK_LINE : LINE_TYPE := (others => ' ');
|
||||
L, LL, LAST : INTEGER := 0;
|
||||
|
||||
EWA : EWDS_ARRAY(1..40) := (others => NULL_EWDS_RECORD);
|
||||
|
||||
EWR : EWDS_RECORD := NULL_EWDS_RECORD;
|
||||
|
||||
|
||||
|
||||
-- First we supplement MEAN with singles of any hyphenated words
|
||||
-- In principle this could be done in the main EXTRACT, much same logic/code
|
||||
-- However this is difficult code for an old man, EXTRACT was hard when I was a bit younger
|
||||
-- And I cannot remember anything about it. Separating them out makes it much easier to test
|
||||
|
||||
function ADD_HYPHENATED(S : STRING) return STRING is
|
||||
|
||||
-------- I tried to do something with hyphenated but so far it does not work ----------
|
||||
|
||||
-- Find hyphenated words and add them to MEAN with a / connector, right before the parse
|
||||
-- so one has both the individual words (may be more than two) and a single combined word
|
||||
-- counting-board -> counting board/countingboard
|
||||
T : STRING (1..MAX_MEANING_SIZE*2 + 20) := (others => ' '); -- Cannot be bigger
|
||||
WORD_START : INTEGER := 1;
|
||||
WORD_END : INTEGER := 0;
|
||||
I, J, JMAX : INTEGER := 0;
|
||||
HYPHENATED : BOOLEAN := FALSE;
|
||||
|
||||
WW : INTEGER := 0; -- For debug
|
||||
|
||||
begin
|
||||
--PUT_LINE("S " & INTEGER'IMAGE(LINE_NUMBER) & " " & INTEGER'IMAGE(S'FIRST) & " " & INTEGER'IMAGE(S'LAST));
|
||||
--PUT_LINE(S);
|
||||
while I < S'LAST loop
|
||||
I := I + 1;
|
||||
J := J + 1;
|
||||
WORD_END := 0;
|
||||
--PUT(INTEGER'IMAGE(I) & "-");
|
||||
|
||||
|
||||
-- First clear away or ignore all the non-words stuff
|
||||
if S(I) = '|' then -- Skip continuation |'s
|
||||
WORD_START := I + 1;
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
null;
|
||||
I := I + 1;
|
||||
--PUT_LINE("||| " & INTEGER'IMAGE(LINE_NUMBER) & " " & S(I) & '_' & S(WORD_START..S'LAST));
|
||||
elsif S(I) = '"' then -- Skip "'s
|
||||
WORD_START := I + 1;
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
null;
|
||||
I := I + 1;
|
||||
--PUT_LINE('"' & " " & INTEGER'IMAGE(LINE_NUMBER) & " ->" & S(WORD_START..S'LAST));
|
||||
else
|
||||
if S(I) = '(' then -- (...) not to be parsed
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
I := I + 1;
|
||||
while S(I) /= ')' loop
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
WORD_START := I + 2; -- Skip };
|
||||
WORD_END := 0;
|
||||
elsif S(I) = '[' then -- (...) not to be parsed
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
I := I + 1;
|
||||
while S(I-1..I) /= "=>" loop
|
||||
T(J) := S(I);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
WORD_START := I + 2;
|
||||
WORD_END := 0;
|
||||
|
||||
end if;
|
||||
-- Finished with the non-word stuff
|
||||
|
||||
if (S(I) = '-') then
|
||||
WORD_END := I - 1;
|
||||
|
||||
-- if (I /= S'FIRST) and then -- Not -word
|
||||
-- ( (S(I-1) /= ' ') and
|
||||
-- (S(I-1) /= '/') ) then
|
||||
-- HYPHENATED := TRUE;
|
||||
-- end if;
|
||||
--PUT_LINE("--- " & INTEGER'IMAGE(LINE_NUMBER) & " " & INTEGER'IMAGE(I) &
|
||||
--" " & INTEGER'IMAGE(WORD_START) & " " & INTEGER'IMAGE(WORD_END) & " ->" & S(WORD_START..WORD_END));
|
||||
end if;
|
||||
|
||||
|
||||
if
|
||||
S(I) = ' ' or
|
||||
S(I) = '/' or
|
||||
S(I) = ',' or
|
||||
S(I) = ';' or
|
||||
S(I) = '!' or
|
||||
S(I) = '?' or
|
||||
S(I) = '+' or
|
||||
S(I) = '*' or
|
||||
S(I) = '"' or
|
||||
S(I) = '(' then
|
||||
WORD_END := I - 1;
|
||||
|
||||
--PUT_LINE(INTEGER'IMAGE(LINE_NUMBER) & " NNN " & S(I) & " " & INTEGER'IMAGE(I) & " "
|
||||
--& INTEGER'IMAGE(WORD_START)& " " & INTEGER'IMAGE(WORD_END) & " " & S(WORD_START..WORD_END));
|
||||
if HYPHENATED then
|
||||
T(J) := '/';
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
for K in WORD_START..WORD_END loop
|
||||
if S(K) /= '-' then
|
||||
T(J) := S(K);
|
||||
J := J + 1;
|
||||
JMAX := JMAX + 1;
|
||||
end if;
|
||||
end loop;
|
||||
HYPHENATED := FALSE;
|
||||
end if;
|
||||
|
||||
end if;
|
||||
|
||||
|
||||
|
||||
if --WORD_END /= 0 and then
|
||||
(S(I) = ' ' or
|
||||
S(I) = '/' ) then
|
||||
WORD_START := I + 1;
|
||||
WORD_END := 0;
|
||||
end if;
|
||||
|
||||
--PUT_LINE(INTEGER'IMAGE(LINE_NUMBER) & " TTT " & S(I) & " " & INTEGER'IMAGE(I) &
|
||||
--" " & INTEGER'IMAGE(WORD_START) & " " & INTEGER'IMAGE(WORD_END) & " " & S(WORD_START..WORD_END));
|
||||
|
||||
|
||||
end if; -- On '|'
|
||||
|
||||
|
||||
-- Set up the output to return
|
||||
--PUT('|' & INTEGER'IMAGE(J) & '/' & INTEGER'IMAGE(I));
|
||||
T(J) := S(I);
|
||||
JMAX := JMAX + 1;
|
||||
|
||||
end loop; -- Over S'RANGE
|
||||
|
||||
|
||||
--PUT_LINE("RRR ->" & INTEGER'IMAGE(LINE_NUMBER) & " " & T(1..JMAX));
|
||||
return T(1..JMAX);
|
||||
|
||||
exception
|
||||
when others =>
|
||||
PUT_LINE("ADD_HYPHENATED Exception LINE = " &
|
||||
INTEGER'IMAGE(LINE_NUMBER));
|
||||
PUT_LINE(S);
|
||||
PUT(DE); NEW_LINE;
|
||||
return T(1..JMAX);
|
||||
end ADD_HYPHENATED;
|
||||
|
||||
|
||||
procedure EXTRACT_WORDS (S : in STRING;
|
||||
POFS : in PART_OF_SPEECH_TYPE;
|
||||
N : out INTEGER;
|
||||
EWA : out EWDS_ARRAY) is
|
||||
I, J, JS, K, L, M, IM, IC : INTEGER := 0;
|
||||
START_SEMI, END_SEMI : INTEGER := 1;
|
||||
-- Have to expand type to take care of hyphenated
|
||||
subtype X_MEANING_TYPE is STRING(1..MAX_MEANING_SIZE*2+20);
|
||||
NULL_X_MEANING_TYPE : constant X_MEANING_TYPE := (others => ' ');
|
||||
SEMI, COMMA : X_MEANING_TYPE := NULL_X_MEANING_TYPE;
|
||||
|
||||
SM1, SM2 : INTEGER := 0;
|
||||
|
||||
WW : INTEGER := 0; -- For debug
|
||||
begin
|
||||
--NEW_LINE(2);
|
||||
--PUT_LINE("MEAN " & INTEGER'IMAGE(LINE_NUMBER) & " =>" & S);
|
||||
--PUT_LINE("MEAN=>" & INTEGER'IMAGE(S'FIRST) & " " & INTEGER'IMAGE(S'LAST) & "|::::::::");
|
||||
I := 1; -- Element Position in line, per SEMI
|
||||
J := 1; -- Position in word
|
||||
K := 0; -- SEMI - Division in line
|
||||
L := 1; -- Position in MEAN, for EXTRACTing SEMI
|
||||
M := 1; -- COMMA in SEMI
|
||||
N := 1; -- Word number
|
||||
IM := 0; -- Position in SEMI
|
||||
IC := 0; -- Position in COMMA
|
||||
|
||||
|
||||
|
||||
EWA(N) := NULL_EWDS_RECORD;
|
||||
|
||||
-- Slightly disparage extension
|
||||
if S(1) = '|' then K := 3; end if;
|
||||
|
||||
|
||||
while L <= S'LAST loop -- loop over MEAN
|
||||
if S(L) = ' ' then -- Clear initial blanks
|
||||
L := L + 1;
|
||||
end if;
|
||||
|
||||
SEMI := NULL_X_MEANING_TYPE;
|
||||
IM := 1;
|
||||
SM1 := 1;
|
||||
SM2 := 0;
|
||||
EXTRACT_SEMI:
|
||||
loop
|
||||
|
||||
--PUT('/');
|
||||
--PUT(S(L));
|
||||
if S(L) = '|' then
|
||||
null; -- Ignore continuation flag | as word
|
||||
elsif S(L) in '0'..'9' then
|
||||
null; -- Ignore numbers
|
||||
|
||||
elsif S(L) = ';' then -- Division Terminator
|
||||
--PUT(':');
|
||||
K := K + 1;
|
||||
SM2 := IM - 1;
|
||||
--PUT('+');
|
||||
L := L + 1; -- Clear ;
|
||||
exit;
|
||||
elsif S(L) = '(' then -- Skip (...) !
|
||||
--PUT('[');
|
||||
while S(L) /= ')' loop
|
||||
--PUT('+');
|
||||
--PUT(INTEGER'IMAGE(L));
|
||||
--PUT(S(L));
|
||||
exit when L = S'LAST; -- Run out
|
||||
L := L + 1;
|
||||
end loop;
|
||||
-- L := L + 1; -- Clear the ')'
|
||||
--PUT('^');
|
||||
--PUT(INTEGER'IMAGE(L));
|
||||
--PUT(S(L));
|
||||
if L > S'LAST then
|
||||
L := S'LAST;
|
||||
SM2 := IM;
|
||||
else
|
||||
if S(L) = ';' then -- );
|
||||
SM2 := IM - 1;
|
||||
exit EXTRACT_SEMI;
|
||||
end if;
|
||||
end if;
|
||||
--PUT(']');
|
||||
|
||||
if L >= S'LAST then -- Ends in )
|
||||
--PUT('!');
|
||||
SM2 := IM;
|
||||
exit;
|
||||
end if;
|
||||
--PUT('+');
|
||||
--L := L + 1; -- Clear the ')'
|
||||
elsif L = S'LAST then
|
||||
--PUT('|');
|
||||
SM2 := IM;
|
||||
L := L + 1; -- To end the loop
|
||||
exit;
|
||||
|
||||
else
|
||||
SEMI(IM) := S(L);
|
||||
SM2 := IM;
|
||||
IM := IM + 1;
|
||||
end if;
|
||||
--PUT('+');
|
||||
--IM := IM + 1; -- To next character
|
||||
L := L + 1; -- To next character
|
||||
end loop EXTRACT_SEMI;
|
||||
|
||||
WW := 10;
|
||||
|
||||
--if LINE_NUMBER = 8399 then
|
||||
--NEW_LINE;
|
||||
--PUT_LINE("NEW SEMI=>" & SEMI(SM1..SM2) & "|::::::::");
|
||||
--PUT_LINE("NEW SEMI INDEX=>" & INTEGER'IMAGE(SM1) & " " & INTEGER'IMAGE(SM2) & "|::::::::");
|
||||
--end if;
|
||||
|
||||
PROCESS_SEMI:
|
||||
declare
|
||||
ST : constant STRING := TRIM(SEMI);
|
||||
SM : STRING(ST'FIRST..ST'LAST) := ST;
|
||||
START_COMMA, END_COMMA : INTEGER := 0;
|
||||
begin
|
||||
if ST'LENGTH > 0 then
|
||||
COMMA := NULL_X_MEANING_TYPE;
|
||||
IM := SM'FIRST;
|
||||
M := 0;
|
||||
|
||||
--I := SM'FIRST;
|
||||
--while I <= ST'LAST loop
|
||||
|
||||
--PUT(S(I));
|
||||
--PUT('*');
|
||||
|
||||
--COMMA := NULL_X_MEANING_TYPE;
|
||||
|
||||
IC := 1;
|
||||
LOOP_OVER_SEMI:
|
||||
while IM <= SM'LAST loop
|
||||
COMMA := NULL_X_MEANING_TYPE;
|
||||
WW := 20;
|
||||
FIND_COMMA:
|
||||
loop
|
||||
|
||||
--PUT(INTEGER'IMAGE(IM) & " ( " & SM(IM));
|
||||
if SM(IM) = '(' then -- Skip (...) !
|
||||
while SM(IM) /= ')' loop
|
||||
IM := IM + 1;
|
||||
end loop;
|
||||
IM := IM + 1; -- Clear the ')'
|
||||
-- IM := IM + 1; -- Go to next character
|
||||
--PUT_LINE("Cleared (+" & " IM = " & INTEGER'IMAGE(IM));
|
||||
if IM >= END_SEMI then
|
||||
--PUT_LINE("exit on SM'LAST " & INTEGER'IMAGE(SM'LAST) & " I = " & INTEGER'IMAGE(IM));
|
||||
exit;
|
||||
end if;
|
||||
--PUT_LINE("No exit on SM'LAST " & INTEGER'IMAGE(SM'LAST) & " I = " & INTEGER'IMAGE(IM) & "|" & SM(IM) & "|");
|
||||
if (SM(IM) = ';') or (SM(IM) = ',') then
|
||||
--PUT_LINE("Found ;, COMMA IM = " & INTEGER'IMAGE(IM));
|
||||
-- Foumd COMMA
|
||||
M := M + 1;
|
||||
IC := 1;
|
||||
IM := IM + 1; -- Clear ;,
|
||||
exit;
|
||||
elsif SM(IM) = ' ' then
|
||||
--PUT_LINE("Found blank - IM = " & INTEGER'IMAGE(IM));
|
||||
IM := IM + 1;
|
||||
--PUT_LINE("Found blank + IM = " & INTEGER'IMAGE(IM));
|
||||
end if;
|
||||
--PUT_LINE("------------------------");
|
||||
end if;
|
||||
if SM(IM) = '[' then -- Take end of [=>]
|
||||
while SM(IM) /= '>' loop
|
||||
exit when SM(IM) = ']'; -- If no >
|
||||
IM := IM + 1;
|
||||
end loop;
|
||||
IM := IM + 1; -- Clear the '>' or ']'
|
||||
if SM(IM) = ';' then
|
||||
-- Foumd COMMA
|
||||
M := M + 1;
|
||||
IC := 1;
|
||||
IM := IM + 1; -- Clear ;
|
||||
exit;
|
||||
elsif SM(IM) = ' ' then
|
||||
IM := IM + 1;
|
||||
end if;
|
||||
end if; -- But could be 2 =>!
|
||||
--PUT_LINE("Through ()[] I = " & INTEGER'IMAGE(I));
|
||||
exit when IM > SM'LAST;
|
||||
|
||||
|
||||
|
||||
--PUT(INTEGER'IMAGE(IM) & " ) " & SM(IM));
|
||||
if SM(IM) = ',' then
|
||||
-- Foumd COMMA
|
||||
M := M + 1;
|
||||
IC := 1;
|
||||
IM := IM + 1; -- Clear ,
|
||||
exit;
|
||||
elsif
|
||||
IM >= SM'LAST or
|
||||
IM = S'LAST
|
||||
then
|
||||
-- Foumd COMMA
|
||||
COMMA(IC) := SM(IM);
|
||||
M := M + 1;
|
||||
IC := 1;
|
||||
exit;
|
||||
else
|
||||
COMMA(IC) := SM(IM);
|
||||
IM := IM + 1;
|
||||
IC := IC + 1;
|
||||
|
||||
end if;
|
||||
--PUT(INTEGER'IMAGE(IM) & " ! " & SM(IM));
|
||||
|
||||
|
||||
end loop FIND_COMMA;
|
||||
--PUT_LINE("COMMA " & INTEGER'IMAGE(LINE_NUMBER) & INTEGER'IMAGE(IM) & "=>" & TRIM(COMMA));
|
||||
IM := IM + 1;
|
||||
|
||||
|
||||
WW := 30;
|
||||
|
||||
PROCESS_COMMA:
|
||||
declare
|
||||
CT : constant STRING := TRIM(COMMA);
|
||||
CS : STRING(CT'FIRST..CT'LAST) := CT;
|
||||
PURE : BOOLEAN := TRUE;
|
||||
W_START, W_END : INTEGER := 0;
|
||||
begin
|
||||
WW := 31;
|
||||
--PUT_LINE("PROCESS COMMA " & INTEGER'IMAGE(LINE_NUMBER) & INTEGER'IMAGE(CT'FIRST) & INTEGER'IMAGE(CT'LAST) & "=>" & TRIM(COMMA));
|
||||
if CT'LENGTH > 0 then -- Is COMMA non empty
|
||||
-- Are there any blanks?
|
||||
-- If not then it is a pure word
|
||||
-- Or words with /
|
||||
for IP in CS'RANGE loop
|
||||
if CS(IP) = ' ' then
|
||||
PURE := FALSE;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
WW := 32;
|
||||
|
||||
-- Check for WEED words and eliminate them
|
||||
W_START := CS'FIRST;
|
||||
W_END := CS'LAST;
|
||||
for IW in CS'RANGE loop
|
||||
--PUT('-');
|
||||
--PUT(CS(IW));
|
||||
if (CS(IW) = '(') or
|
||||
(CS(IW) = '[') then
|
||||
WW := 33;
|
||||
W_START := IW + 1;
|
||||
else
|
||||
WW := 34;
|
||||
if (CS(IW) = ' ') or
|
||||
(CS(IW) = '_') or
|
||||
(CS(IW) = '-') or
|
||||
(CS(IW) = ''') or
|
||||
(CS(IW) = '!') or
|
||||
(CS(IW) = '/') or
|
||||
(CS(IW) = ':') or
|
||||
(CS(IW) = '.') or
|
||||
(CS(IW) = '!') or
|
||||
(CS(IW) = ')') or
|
||||
(CS(IW) = ']') or
|
||||
(IW = CS'LAST)
|
||||
then
|
||||
--PUT_LINE("HIT " & CS(IW) & " IW = " & INTEGER'IMAGE(IW) & " CS'LAST = " & INTEGER'IMAGE(CS'LAST));
|
||||
WW := 35;
|
||||
if IW = CS'LAST then
|
||||
W_END := IW;
|
||||
elsif IW /= CS'FIRST then
|
||||
W_END := IW - 1;
|
||||
end if;
|
||||
|
||||
WW := 36;
|
||||
-- KLUDGE
|
||||
if CS(W_START) = '"' then
|
||||
WW := 361;
|
||||
W_START := W_START + 1;
|
||||
WW := 362;
|
||||
elsif
|
||||
CS(W_END) = '"' then
|
||||
WW := 364;
|
||||
W_END := W_END - 1;
|
||||
WW := 365;
|
||||
end if;
|
||||
|
||||
WW := 37;
|
||||
|
||||
--PUT_LINE(INTEGER'IMAGE(LINE_NUMBER) & "WEEDing " &
|
||||
--INTEGER'IMAGE(W_START) & " " & INTEGER'IMAGE(W_END)
|
||||
--& " " & CS(W_START..W_END)
|
||||
--);
|
||||
WEED_ALL(CS(W_START..W_END), POFS);
|
||||
if not PURE then
|
||||
WEED(CS(W_START..W_END), POFS);
|
||||
end if;
|
||||
W_START := IW + 1;
|
||||
end if;
|
||||
WW := 38;
|
||||
end if;
|
||||
WW := 39;
|
||||
end loop; -- On CS'RANGE
|
||||
|
||||
--PUT_LINE(INTEGER'IMAGE(LINE_NUMBER) & "WEED done");
|
||||
|
||||
WW := 40;
|
||||
-- Main process of COMMA
|
||||
IC := 1;
|
||||
J := 1;
|
||||
while IC <= CS'LAST loop
|
||||
--PUT(CS(IC));
|
||||
|
||||
if CS(IC) = '"' or -- Skip all "
|
||||
CS(IC) = '(' or -- Skip initial (
|
||||
--CS(IC) = '-' or -- Skip hyphen -> one word!
|
||||
CS(IC) = '?' or -- Ignore ?
|
||||
CS(IC) = '~' or -- Ignore about ~
|
||||
CS(IC) = '*' or
|
||||
CS(IC) = '%' or -- Ignore percent unless word
|
||||
CS(IC) = '.' or -- Ignore ...
|
||||
CS(IC) = '\' or -- Ignore weed
|
||||
(CS(IC) in '0'..'9') then -- Skip numbers
|
||||
IC := IC + 1;
|
||||
WW := 50;
|
||||
|
||||
----PUT('-');
|
||||
else
|
||||
|
||||
if
|
||||
-- S(IC) = ',' or -- Terminators
|
||||
-- S(IC) = '.' or -- Would be typo
|
||||
-- S(IC) = ';' or -- Should catch at SEMI
|
||||
CS(IC) = '/' or
|
||||
CS(IC) = ' ' or
|
||||
CS(IC) = ''' or -- Ignore all ' incl 's ???
|
||||
CS(IC) = '-' or -- Hyphen causes 2 words XXX
|
||||
CS(IC) = '+' or -- Plus causes 2 words
|
||||
CS(IC) = '_' or -- Underscore causes 2 words
|
||||
CS(IC) = '=' or -- = space/terminates
|
||||
CS(IC) = '>' or
|
||||
CS(IC) = ')' or
|
||||
CS(IC) = ']' or
|
||||
CS(IC) = '!' or
|
||||
CS(IC) = '?' or
|
||||
CS(IC) = '+' or
|
||||
CS(IC) = ':' or
|
||||
CS(IC) = ']'
|
||||
then -- Found word
|
||||
WW := 60;
|
||||
--PUT('/');
|
||||
EWA(N).SEMI := K;
|
||||
if PURE then
|
||||
if K = 1 then
|
||||
EWA(N).KIND := 15;
|
||||
else
|
||||
EWA(N).KIND := 10;
|
||||
end if;
|
||||
else
|
||||
EWA(N).KIND := 0;
|
||||
end if;
|
||||
WW := 70;
|
||||
--PUT_LINE("====1 K J = " & INTEGER'IMAGE(K) & " " & INTEGER'IMAGE(J) & " ." & EWA(N).W(1..J-1) & ".");
|
||||
N := N + 1; -- Start new word in COMMA
|
||||
IC := IC + 1;
|
||||
J := 1;
|
||||
EWA(N) := NULL_EWDS_RECORD;
|
||||
|
||||
elsif -- Order of if important
|
||||
IC = CS'LAST then -- End, Found word
|
||||
--PUT('!');
|
||||
EWA(N).W(J) := CS(IC);
|
||||
EWA(N).SEMI := K;
|
||||
if PURE then
|
||||
if K = 1 then
|
||||
EWA(N).KIND := 15;
|
||||
else
|
||||
EWA(N).KIND := 10;
|
||||
end if;
|
||||
else
|
||||
EWA(N).KIND := 0;
|
||||
end if;
|
||||
--PUT_LINE("====2 K J = " & INTEGER'IMAGE(K) & " " & INTEGER'IMAGE(J) & " ." & EWA(N).W(1..J) & ".");
|
||||
N := N + 1; -- Start new word/COMMA
|
||||
|
||||
EWA(N) := NULL_EWDS_RECORD;
|
||||
exit;
|
||||
|
||||
else
|
||||
WW := 80;
|
||||
--PUT('+');
|
||||
EWA(N).W(J) := CS(IC);
|
||||
J := J + 1;
|
||||
IC := IC + 1;
|
||||
end if;
|
||||
end if;
|
||||
WW := 90;
|
||||
end loop;
|
||||
|
||||
end if; -- On COMMA being empty
|
||||
end PROCESS_COMMA;
|
||||
--PUT_LINE("COMMA Processed ");
|
||||
|
||||
|
||||
|
||||
|
||||
end loop LOOP_OVER_SEMI;
|
||||
|
||||
--PUT_LINE("LOOP OVER SEMI Processed ");
|
||||
|
||||
end if; -- On ST'LENGTH > 0
|
||||
--PUT_LINE("LOOP OVER SEMI after ST'LENGTH 0 ");
|
||||
end PROCESS_SEMI;
|
||||
|
||||
--PUT_LINE("SEMI Processed ");
|
||||
-- I = " & INTEGER'IMAGE(I)
|
||||
--& " S(I) = " & S(I)
|
||||
--);
|
||||
if (L < S'LAST) and then (S(L) = ';') then -- ??????
|
||||
--PUT_LINE("Clear L = " & INTEGER'IMAGE(L));
|
||||
L := L + 1;
|
||||
end if;
|
||||
|
||||
JS := L; -- Odd but necessary ?????
|
||||
for J in L..S'LAST loop
|
||||
exit when J >= S'LAST;
|
||||
if S(J) = ' ' then
|
||||
L := L + 1;
|
||||
else
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
START_SEMI := L;
|
||||
|
||||
--PUT_LINE("SEMI Processed Completely L = " & INTEGER'IMAGE(L) & " S'LAST = " & INTEGER'IMAGE(S'LAST));
|
||||
|
||||
|
||||
exit when L >= S'LAST;
|
||||
end loop; -- loop over MEAN
|
||||
|
||||
--PUT_LINE("SEMI loop Processed");
|
||||
if EWA(N) = NULL_EWDS_RECORD then
|
||||
N := N -1; -- Clean up danglers
|
||||
end if;
|
||||
if EWA(N) = NULL_EWDS_RECORD then -- AGAIN!!!!!!
|
||||
N := N -1; -- Clean up danglers
|
||||
end if;
|
||||
exception
|
||||
when others =>
|
||||
if (S(S'LAST) /= ')') or (S(S'LAST) /= ']') then -- KLUDGE
|
||||
NEW_LINE;
|
||||
PUT_LINE("Extract Exception WW = " & INTEGER'IMAGE(WW) & " LINE = " &
|
||||
INTEGER'IMAGE(LINE_NUMBER));
|
||||
PUT_LINE(S);
|
||||
PUT(DE); NEW_LINE;
|
||||
end if;
|
||||
end EXTRACT_WORDS;
|
||||
|
||||
|
||||
begin
|
||||
PUT_LINE(
|
||||
"Takes a DICTLINE.D_K and produces a EWDSLIST.D_K ");
|
||||
PUT("What dictionary to list, GENERAL or SPECIAL =>");
|
||||
GET_LINE(LINE, LAST);
|
||||
if LAST > 0 then
|
||||
if TRIM(LINE(1..LAST))(1) = 'G' or else
|
||||
TRIM(LINE(1..LAST))(1) = 'g' then
|
||||
D_K := GENERAL;
|
||||
-- LINE_NUMBER := LINE_NUMBER + 1; -- Because of ESSE DICTFILE line -- no longer
|
||||
elsif TRIM(LINE(1..LAST))(1) = 'S' or else
|
||||
TRIM(LINE(1..LAST))(1) = 's' then
|
||||
D_K := SPECIAL;
|
||||
else
|
||||
PUT_LINE("No such dictionary");
|
||||
raise TEXT_IO.DATA_ERROR;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
--PUT_LINE("OPENING " &
|
||||
-- ADD_FILE_NAME_EXTENSION(DICT_LINE_NAME, DICTIONARY_KIND'IMAGE(D_K)));
|
||||
|
||||
|
||||
OPEN(INPUT, IN_FILE, ADD_FILE_NAME_EXTENSION(DICT_LINE_NAME,
|
||||
DICTIONARY_KIND'IMAGE(D_K)));
|
||||
--PUT_LINE("OPEN");
|
||||
|
||||
if not PORTING then
|
||||
--PUT_LINE("CREATING");
|
||||
|
||||
CREATE(OUTPUT, OUT_FILE, ADD_FILE_NAME_EXTENSION("EWDSLIST",
|
||||
DICTIONARY_KIND'IMAGE(D_K)));
|
||||
|
||||
if CHECKING then CREATE(CHECK, OUT_FILE, "CHECKEWD."); end if;
|
||||
|
||||
--PUT_LINE("CREATED");
|
||||
end if;
|
||||
|
||||
|
||||
-- Now do the rest
|
||||
OVER_LINES:
|
||||
while not END_OF_FILE(INPUT) loop
|
||||
S := BLANK_LINE;
|
||||
GET_LINE(INPUT, S, LAST);
|
||||
if TRIM(S(1..LAST)) /= "" then -- If non-blank line
|
||||
L := 0;
|
||||
|
||||
FORM_DE:
|
||||
begin
|
||||
|
||||
DE.STEMS(1) := S(START_STEM_1..MAX_STEM_SIZE);
|
||||
--NEW_LINE; PUT(DE.STEMS(1));
|
||||
DE.STEMS(2) := S(START_STEM_2..START_STEM_2+MAX_STEM_SIZE-1);
|
||||
DE.STEMS(3) := S(START_STEM_3..START_STEM_3+MAX_STEM_SIZE-1);
|
||||
DE.STEMS(4) := S(START_STEM_4..START_STEM_4+MAX_STEM_SIZE-1);
|
||||
--PUT('#'); PUT(INTEGER'IMAGE(L)); PUT(INTEGER'IMAGE(LAST));
|
||||
--PUT('@');
|
||||
GET(S(START_PART..LAST), DE.PART, L);
|
||||
--PUT('%'); PUT(INTEGER'IMAGE(L)); PUT(INTEGER'IMAGE(LAST));
|
||||
--PUT('&'); PUT(S(L+1..LAST)); PUT('3');
|
||||
--GET(S(L+1..LAST), DE.PART.POFS, DE.KIND, L);
|
||||
GET(S(L+1..LAST), DE.TRAN.AGE, L);
|
||||
GET(S(L+1..LAST), DE.TRAN.AREA, L);
|
||||
GET(S(L+1..LAST), DE.TRAN.GEO, L);
|
||||
GET(S(L+1..LAST), DE.TRAN.FREQ, L);
|
||||
GET(S(L+1..LAST), DE.TRAN.SOURCE, L);
|
||||
DE.MEAN := HEAD(S(L+2..LAST), MAX_MEANING_SIZE);
|
||||
-- Note that this allows initial blanks
|
||||
-- L+2 skips over the SPACER, required because this is STRING, not ENUM
|
||||
|
||||
exception
|
||||
when others =>
|
||||
NEW_LINE;
|
||||
PUT_LINE("GET Exception LAST = " & INTEGER'IMAGE(LAST));
|
||||
PUT_LINE(S(1..LAST));
|
||||
INTEGER_IO.PUT(LINE_NUMBER); NEW_LINE;
|
||||
PUT(DE); NEW_LINE;
|
||||
end FORM_DE;
|
||||
|
||||
LINE_NUMBER := LINE_NUMBER + 1;
|
||||
|
||||
|
||||
if DE.PART.POFS = V and then
|
||||
DE.PART.V.CON.WHICH = 8 then
|
||||
-- V 8 is a kludge for variant forms of verbs that have regular forms elsewhere
|
||||
null;
|
||||
else
|
||||
|
||||
-- Extract words
|
||||
EXTRACT_WORDS(ADD_HYPHENATED(TRIM(DE.MEAN)), DE.PART.POFS, N, EWA);
|
||||
|
||||
-- EWORD_SIZE : constant := 38;
|
||||
-- AUX_WORD_SIZE : constant := 9;
|
||||
-- LINE_NUMBER_WIDTH : constant := 10;
|
||||
--
|
||||
-- type EWDS_RECORD is
|
||||
-- record
|
||||
-- POFS : PART_OF_SPEECH_TYPE := X;
|
||||
-- W : STRING(1..EWORD_SIZE);
|
||||
-- AUX : STRING(1..AUX_WORD_SIZE);
|
||||
-- N : INTEGER;
|
||||
-- end record;
|
||||
|
||||
|
||||
for I in 1..N loop
|
||||
if TRIM(EWA(I).W)'LENGTH /= 0 then
|
||||
EWR.W := HEAD(TRIM(EWA(I).W), EWORD_SIZE);
|
||||
EWR.AUX := HEAD("", AUX_WORD_SIZE);
|
||||
EWR.N := LINE_NUMBER;
|
||||
EWR.POFS := DE.PART.POFS;
|
||||
EWR.FREQ := DE.TRAN.FREQ;
|
||||
EWR.SEMI := EWA(I).SEMI;
|
||||
EWR.KIND := EWA(I).KIND;
|
||||
EWR.RANK := 80-FREQUENCY_TYPE'POS(EWR.FREQ)*10 + EWR.KIND + (EWR.SEMI-1)*(-3);
|
||||
if EWR.FREQ = INFLECTIONS_PACKAGE.N then EWR.RANK := EWR.RANK + 25; end if;
|
||||
--PUT(EWA(I)); NEW_LINE;
|
||||
--PUT(EWR); NEW_LINE;
|
||||
PUT(OUTPUT, EWR);
|
||||
|
||||
-- SET_COL(OUTPUT, 71);
|
||||
-- INTEGER_IO.PUT(OUTPUT, I, 2);
|
||||
|
||||
NEW_LINE(OUTPUT);
|
||||
|
||||
if CHECKING then
|
||||
-- Now make the CHECK file
|
||||
|
||||
PUT(CHECK, EWR.W);
|
||||
SET_COL(CHECK, 25);
|
||||
declare
|
||||
DF : constant STRING := DICTIONARY_FORM(DE);
|
||||
II : INTEGER := 1;
|
||||
begin
|
||||
if DF'LENGTH > 0 then
|
||||
while DF(II) /= ' ' and
|
||||
DF(II) /= '.' and
|
||||
DF(II) /= ',' loop
|
||||
PUT(CHECK, DF(II));
|
||||
II := II+ 1;
|
||||
exit when II = 19;
|
||||
end loop;
|
||||
end if;
|
||||
end;
|
||||
SET_COL(CHECK, 44);
|
||||
PUT(CHECK, EWR.N, 6);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, EWR.POFS);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, EWR.FREQ);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, EWR.SEMI, 5);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, EWR.KIND, 5);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, EWR.RANK, 5);
|
||||
PUT(CHECK, ' ');
|
||||
PUT(CHECK, DE.MEAN);
|
||||
|
||||
NEW_LINE(CHECK);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
end loop;
|
||||
|
||||
end if; -- If non-blank line
|
||||
end if;
|
||||
end loop OVER_LINES;
|
||||
|
||||
PUT_LINE("NUMBER_OF_LINES = " & INTEGER'IMAGE(LINE_NUMBER));
|
||||
|
||||
if not PORTING then
|
||||
CLOSE(OUTPUT);
|
||||
if CHECKING then CLOSE(CHECK); end if;
|
||||
end if;
|
||||
|
||||
exception
|
||||
when TEXT_IO.DATA_ERROR =>
|
||||
null;
|
||||
when others =>
|
||||
PUT_LINE(S(1..LAST));
|
||||
INTEGER_IO.PUT(INTEGER(LINE_NUMBER)); NEW_LINE;
|
||||
CLOSE(OUTPUT);
|
||||
if CHECKING then CLOSE(CHECK); end if;
|
||||
|
||||
end MAKEEWDS;
|
||||
Reference in New Issue
Block a user