philologue/whitakers-words
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import from .zip file

Browse Source
This commit is contained in:
Michael Wolf
2012-05-31 16:45:42 -05:00
commit 926705cb97
55 changed files with 291819 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1201
ADDONS.LAT Normal file
View File

File diff suppressed because it is too large Load Diff

39337
DICTLINE.GEN Normal file
View File

File diff suppressed because it is too large Load Diff

156082
EWDSLIST.GEN Normal file
View File

File diff suppressed because it is too large Load Diff

753
HOWTO.txt Normal file
View File

@@ -0,0 +1,753 @@
-- DOCUMENT IN DEVELOPMENT --
PROCESSES TO
DO INFLECTIONS
PREPARE DICTIONARY ADDITIONS
UPGRADE LATIN DICTLINE
CHECK LATIN DICTLINE
MAINTAIN LATIN DICTLINE
CHECK DICTLINE FOR ENGLISH SPELLING
GENERATE WORDS SYSTEM
PREPARE LATIN DICTIONARY PHASE
PREPARE ENGLISH DICTIONARY PHASE
OTHER FORMS OF DICTIONARY
DICTPAGE
Like a paper dictionary
LISTALL
All words that DICTLINE and INFLECTS can generate
For spellcheckers
Will not catch ADDONS and TRICKS words
TOOLS
CHECK.ADB
DUPS.ADB
DICTORD.ADB
FIXORD.ADB
LINEDICT.ADB
LISTORD.ADB
DICTPAGE.ADB
DICTFLAG.ADB
INVERT.ADB
INVSTEMS.ADB
ONERS.ADB
CCC.ADB
SLASH.ADB
PATCH.ADB
SORTER.ADB
------------------- DO INFLECTIONS ----------------------
INFLECTS.LAT contains the inflections in human-readable form
with comments, and in useful order.
This is the input for MAKEINFL, which produces INFLECTS.SEC.
(LINE_INF uses INFLECTS.LAT input to produce INFLECTS.LIN,
clean and ordered, but still readable.
Run
LINE_INF
which produces
INFLECTS.LIN
and INFLECTS.SEC)
----------------------------------------------------------
------------PREPARE DICTIONARY ADDITIONS----------------
----------------------------------------------------------
This process is to prepare a submission of new dictionary entries
for inclusion in DICTLINE. The normal starting point is a text file
in DICTLINE (LIN) form, the full entry on one line, spaced appropriately.
The other likely form is an edit file (ED) in which the entry is broken
into three lines
STEMS
PART and TRAN
MEAN
For this form, spacing is not important, as long as there are spaces
seperating individual elements.
This is transformed into LIN form by the program LINEDICT
LINEDICT.IN (ED form) -> LINEDICT.OUT (LIN form)
The inverse of this, LIN to ED, is useful to produce a more easily
editable file (3 lines per entry so it is all on one screen)
LISTDICT.IN (LIN DICTLINE form) -> LISTDICT.OUT (ED form)
Having a LIN form, one can create a DICTLINE.SPE and do checking on that.
Besides running CHECK to validate syntax, one can run DICTORD and create
a file in which leading words are in dictionary entry form. One can then
run this against the existing WORDS and DICTLINE to check for overlap.
DICTORD makes # file in long format
DICTORD.IN -> DICTORD.OUT
Takes DICTLINE form, puts # and dictionary form at begining.
This file can be sorted to produce word order of paper dictionary.
SORTER on (1 300) (with or without U for I/J U/V conversion)
One can then run WORDS against this file using DEV (!) parameters
DO_ONLY_INITIAL_WORD and FOR_WORD_LIST_CHECK,
and (#) parameters
HAVE_OUTPUT_FILE, WRITE_OUTPUT_TO_FILE, WRITE_UNKNOWNS_TO_FILE
The output provides for a check whether the new submissions
are duplucated in the existing dictionary, and even if the forms are
are the meanings the same.
After editorial review in light of the WORDS run, the new submission
is ready for inclusion by the usual process with CHECK and SPELLCHECK.
----------------------------------------------------------
----------------UPGRADE DICTIONARY ----------------------
----------------------------------------------------------
This is a variation of the additions process.
This process is to prepare a section of DICTLINE for upgrade.
A section (aboout 100 entries) is extracted and ordered alphabetically
It is then put in a form for convenient editing and compared to
the OLD and L+S. Entries are checked and additions are made.
The edit form is returned to DICTLINE form and inserted in
place of the extracted section.
Much the same process is involved in preparing an independent submission
of new entries.
DICTORD makes # file in long format
DICTORD.IN -> DICTORD.OUT
Takes DICTLINE form, puts # and dictionary form at begining,
a file that can be sorted to produce word order of paper dictionary
SORTER on (1 300)
LISTORD Takes # (DICTORD) long format to ED file
(3 lines per entry so it is all on one screen)
LISTORD.IN -> LISTORD.OUT
Edit
FIXORD produces clean ED file
LINEDICT makes long format (LINE_DIC/IN/OUT)
----------------------------------------------------------
-------ADDING A BLOCK OF NEW ENTRIES TO DICTIONARY -------
----------------------------------------------------------
This may be in association with the upgrade process or from
a block of new entries submitted by a developer or user.
The format may be strange. It is usually easiest to reduce/edit
it down ro the 3 line ED form, because that has no column restrictions.
From there one does the usual, making LINEICT format and preparing the addition.
One quirk is that there may be entries duplicate of the current DICTLINE.
This is so even if the supplier was working from and checking his current DICTLINE,
because there may have been later additions to the master.
While DUPS will catch these, that is a big effort for a full DICTLINE.
One would rather check just the new input.
Take the input and DICTORD. This gives a format with the dictionary entry
word first. Run the current WORDS aginst that with NO FIXES/TRICKS and
FIRST_WORD and FOR_WORDLIST parameters. And not UNKNOWN in the output
should be examined.
Then run CHECK and spellcheck the English.
----------------------------------------------------------
------------PREPARE DICTIONARY (DICTLINE) WITH ADDITIONS-----------
----------------------------------------------------------
Save present copies of DICTLINE.GEN, DICTLINE.SPE, DICT.LOC,
and whateverelse, in case you foul up and have to redo.
Add DICT.LOC to DICTLINE.GEN
Copy DICT.LOC LINEDICT.IN
Run LINEDICT
Copy LINEDICT.OUT+DICTLINE.GEN DICTLINE.NEW
Or if there is a SPE that you want to integrate
COPY DICTLINE.GEN+DICTLINE.SPE DICTLINE.NEW
Or any other and combiination.
Sort DICTLINE.NEW in the normal fashion (to check for duplicates)
SORTER
DICTLINE.NEW -- Or whatever you call it
1 75 -- STEMS
77 24 P -- PART
111 80 -- MEAN -- To order |'s
101 10 -- TRAN
DICTLINE.SOR -- Where to put result
Check the sort for oddities and any blank lines.
(Look for long/run-on lines.)
Then run CHECK and examine CHECK.OUT
Run
CHECK
to produce
CHECK.OUT
Examine CHECK.OUT and make any corrections required
(The easiest way is to edit CHECK.IN and rerun as necessary.
Then copy the final CHECK.IN to DICTLINE.)
Errors are cites by line number in CHECK.IN.
Edit examining CHECK.OUT from the bottom, so that changes do not
affect the numbering of the rest of CHECK.IN
CHECK is very fussy. The hits are primarily warnings to look for
the possiblity of error. Most will not be wrong. In fact, over
one percent of correct lines will trigger some warning, more false
positives than real errors.
This make a full run and edit of DICTLINE a considerable burden.
Sort the fixed CHECK.IN again if there have been any changes in order.
Check for duplicates in columns 1..100
(DUPS checks for '|' in column 111 so that it does not give
hits on lines known to be continuations, provided the sort is in order.)
COPY CHECK.IN DUPS.IN
Run DUPS
1 100
Examine DUPS.OUT and fix DUPS.IN (again from the bottom).
Resort if necessary.
Copy the final product to DICTLINE.GEN
This only checks DICTLINE for syntax,
----------------------------------------------------------
----------CHECK DICTLINE FOR ENGLISH SPELLING-------------
----------------------------------------------------------
To check DICTLINE further, one can check the spelling of MEAN.
The fixed format of DICTLINE facilitates this process.
Just running DICTLINE through a spellchecker is impossible,
since all lines contain Latin stems, which will fail not only
an English spellchecker, but a Latin spellchecker as well
(since they are just stems, not proper words).
The process is to extract the MEAN portion, spellcheck this,
and reassemble, making sure to preserve the exact line order.
I use two personal tools, SLASH and PATCH.
Run SLASH on DICTLINE
SLASH takes a file and cuts it into two, lines or columns.
In this case we want to separate the first 110 columns from the rest.
SLASH
c -- Rows or columns
110 -- How many in first
LEFT. -- Name of left file
RIGHT. -- Name of right file
-- Or whatever you want to call them
Save LEFT for later and work on RIGHT, which is only MEANs.
There is one additional complication.
Some MEANs have a translation example element [... => ...]
This will contain some Latin (the left half) as well as English.
The rest I do with editors, but I suppose I should make tools.
Introduce 80 blanks in front of any [
SLASH out the first 80 columns, giving the MEAN omitting the []
Spellcheck that
In the [] file, left justify and add 80 blanks before the =
SLASH out the first 80 columns and spellcheck
Reassemble the three parts of MEAN
Eliminate blanks, leaving a simple MEAN/RIGHT.
PATCH LEFT. and RIGHT together to give DICTLINE.
___________________________________________
To Prepare English Dictionary
__________________________________________
The first part of the following procedure is only for those
starting from scratch. If porting with a full package,
EWDSLIST.GEN will be provided and you can skip down.
---------------------------------------------------------
Preparing the dictionary for the English mode also
involves checks on the syntax of MEAN.
Run MAKEEWDS against DICTLINE.GEN
(There may be some errors cited. Correct as appropriate.)
This extracts the English words from DICTLINE MEAN (G or S)
Makes EWDSLIST.GEN (or .SPE)
Make sure that if running from DICTLINE.GEN that the extra ESSE line
is added. If we start from DICTFILE.GEN, it is already in.
type EWDS_RECORD is
record
W : EWORD; 1
AUX : AUXWORD; 40
N : INTEGER; 50
POFS : PART_OF_SPEECH_TYPE := X; 62
end record;
Ah 1 INTERJ
Aulus 2 N
Roman 2 N
praenomen 2 N
abbreviated 2 N
__________________________________________________
Sort EWDSLIST making a revised version (same name)
1 24 A
1 24 C
51 6 R
75 2 N D
(Run ONERS on ONERS.IN if you want to see FREQ)
(Sort ONERS.OUT 1 11 D; 13 99)
_____________________________________________________
If you are supplied with EWDSLIST.GEN as part of a port package,
the above process is not done.
_____________________________________________________
Run MAKE_EWDSFILE against EWDSLIST.GEN
(This also removes some duplicates, entries in which the
key word appears more than once.)
producing EWDSFILE.GEN
(At present these will act to produce a EWDSFILE.SPE, but
WORDS is not yet setup to use that - only English on GEN for now.)
----------------------------------------------------------
------------PREPARE WORDS SYSTEM-------------------------
----------------------------------------------------------
If using GNAT, otherwise compile with your favorite compiler
gnatmake -O3 words
gnatmake -O3 makedict
gnatmake -O3 makestem
gnatmake -O3 makeewds
gnatmake -O3 makeefil
gnatmake -O3 makeinfl
This produces executables (.EXE files) for
WORDS
MAKEDICT
MAKESTEM
MAKEEWDS
MAKEEFIL
MAKEINFL
(You may also need my SORTER to prepare the data if you are modifing data.
gnatmake -O3 sorter)
(If you have modified DICTLINE, SORTER sort
1 75 -- STEMS
77 24 P -- PART
111 80 -- MEAN
101 10 -- TRAN
Actually the order of DICTLINE is not important for the programs;
it is only a convenience for the human user.)
Run MAKEDICT against the DICTLINE.GEN - When it asks for dictionary, reply G for GENERAL
This produces DICTFILE.GEN
("against" means that the data file and the program are in the same folder/subdirectory.)
(This assumes that you are using the presorted STEMFILE.GEN
which comes with distribution and matches that DICTLINE.GEN.
Otherwise make and run WAKEDICT (Identical to MAKEDICT with
PORTING parameter set in source). This produces DICTFILE.GEN
and a STEMLIST.GEN, which has to be sorter by SORTER.
MAKE ABSOLUTELY SURE YOU ARE USING THE RIGHT MAKEDICT/WAKEDICT!
Invoke SORTER to sort the stems with I/J and U/V equivalence
and replace initial STEMLIST with the sorted one.
SORTER
STEMLIST.GEN -- Input
1 18 U
20 24 P
1 18 C
1 56 A
58 1 D
STEMLIST.GEN -- Output
The output file is also STEMLIST.GEN - Enter/CR for the name works.)
(All SORTER parameters are based on the layout of WORDS 1.97E.
Later versions may have further/expanded fields.)
Run MAKESTEM against STEMLIST.GEN (with dictionary "G") produces STEMFILE.GEN and INDXFILE.GEN
The same procedures can generate DICTFILE.SPE and STEMFILE.SPE (input S)
if there is a SPECIAL dictionary, DICTLINE.SPE
For the English part, if you use the presorted EWDSLIST.GEN
run MAKEEFIL aginst it.
(This assumes that you are using the presorted EWDSLIST.GEN
which comes with distribution and matches that DICTLINE.GEN.
Otherwise make and run MAKEEWDS against DICTLINE.GEN
This produces EWSDLIST.GEN which has to be sorted by SORTER.
Check the begining of EWDSLIST with an editor.
If there are any strange lines, remove them.
Invoke SORTER. The input file is EWSDLIST.GEN.
The sort fields are
SORTER
EWDSLIST.GEN
1 24 A -- Main word
1 24 C -- Main word for CAPS
51 6 R -- Part of Speech
72 5 N D -- RANK
58 1 D -- FREQ
EWSDLIST.GEN -- Store
The output file is also EWDSLIST.GEN - Enter/CR for the name works.)
(For this distribution, there is no facility for English from a SPECIAL dictionary -
there is no D_K field yet)
Run MAKEEFIL against the sorted EWDSLIST.GEN producing EWDSFILE.GEN
Run MAKEINFL against INFLECTS.LAT producing INFLECTS.SEC
Along with ADDONS.LAT and UNIQUES.LAT,
this is the entire set of data for WORDS.
WORDS.EXE
INFLECTS.SEC
ADDONS.LAT
UNIQUES.LAT
DICTFILE.GEN
STEMFILE.GEN
INDXFILE.GEN
EWDSFILE.GEN
-- And whatever .SPE as appropriate
(If you go through the process and have a working WORDS but it
gives the wrong output, the most likely source of error is
a missing or improper sort.)
--------------------------------------------------------------
Viewing WORD.STA
A view to see what ADDONS and TRICKS were used
Sort WORD.STA on
1 12 -- The STAT name
55 25 -- STAT details
32 20 -- Word in question
16 10 -- Line number
------------------------------------------------------------------
------------------PREPARING DICTPAGE------------------------------
------------------------------------------------------------------
Preparing DICTPAGE, the listing as of a paper dictionary.
IMPORTANT NOTE
During the process, you may find it useful to edit some entries. Feel free to do so.
But remember that you have to keep the separate files (.TXT) and reassemble at the end
into a new DICTLINE.
For a release, ideally DICTPAGE is done before the final DICTLINE,
because in the process there may be some editing of entries.
To first order, this is accomplished by running DICTPAGE
against DICTLINE, producing a listing of DICTLINE with each
entry preceeded by # and the DICTIONARY_FORM.
DICTPAGE is a simple modification of DICTORD to produce a
more readable output.
Some polishing of this process gives a better product.
Extracting a few groups of entries for special handling
will simplify the process.
1) Use the regular DICTLINE sort.
Those entries with first stem zzz may give an output
which sorts to #-. But it is likely the second term which
you want to represent this entry. For this and other reasons
these entries will require some hand editing, so extract them
from their place at the end of the regular DICTLINE, run DICTPAGE
on them, sort output on full line, and process seperately.
(About 30 entries, but half handled completely by DICTPAGE)
It is likely that this set has not changed much since the last run,
so check to see if you have to do it over.
2)Sort remaining DICTLINE on (77, 8), (110, 80), (1, 75). Extract ADJ 2 X.
Many Greek adjectives are handled in DICTLINE in two or three parts
(ADJ 2, X by gender. The full declension is the
sum of these partials. (The Greek adjective form 3 6 is handled in the
regular process and does not have to be extracted.) Extract these ADJ declensions
from a sort of DICTLINE by PART. Sort this output on stem and meaning to group
the constituent parts, run DICTPAGE and polish by hand edit to make
a single paper entry from the parts. (About 150 entries, half that
after editing, not too hard, but a program could do the modification.)
It is very likely that this has not changed.
3)The qu-/aliqu- PRONOUN/PACKON (PRON/PACK 1) are yet more complicated
than the Greek adjectives, and are handled in the same manner.
Extract them, sort on meaning, DICTPAGE, and polish output by hand.
Also PRON 5 (only 8 of these). Both of these are sufficiently
unchanging that one could archive the final edit and reuse on a later run.
4)The rest are automatically done by DICTPAGE.
5)UNIQUES are a special case, handled by UNIQPAGE. This processes UNIQUES.LAT
(as UNIQPAGE.IN) into a raw form compatible with the regular PAGE material
(UNIQPAGE.OUT which is copied into UNIQPAGE.pg), added to, and sorted with.
The various phases are assembled into a whole and sorted on the lead,
producing DICTPAGE.RAW
DICTPAGE.RAW is ZIPped to provide a source for others to process for their purposes.
DICTPAGE.RAW is processes herein by PAGE2HTM to give (withthe addition of PREAMBLE.txt
and an end BODY) to give the presentation form DICTPAGE.HTM
The process:
First do a SORT of DICTLINE on STEM to find zzz stems
SORTER
DICTLINE.GEN -- Or whatever
1 75 -- STEMS
77 24 P -- PART
111 80 -- MEAN -- To order |'s
DICTLINE.TXT -- Where to put result
Extract the zzz stems from the end of the file into ZZZ.TXT leaving DICTLINE.NOZ
Sort these
SORTER
ZZZ.TXT
77 24 P -- PART
1 75 -- STEMS
111 80 -- MEAN -- To order |'s
101 10 -- TRAN
ZZZ.TXT -- Where to put result
Extract the PRON 5 to a PRON5.TXT -- More to come
Now sort the rest
SORTER
DICTLINE.NOZ
77 24 P -- PART
1 75 -- STEMS
111 80 -- MEAN -- To order |'s
101 10 -- TRAN
DICTLINE.NOZ -- Where to put result
Now extract from DICTLINE.NOZ the remaining PRON 5, the Greek adjectives,
and the qui/alqui PRON/PACK 1, giving
ZZZ.TXT
GKADJ.TXT
PRON1.TXT
PRON5.TXT
After those are removed, the remaining is REST.TXT.
Run DICTPAGE on each of these 5 files
(Copy them to DICTPAGE.IN, run DICTPAGE, copy DICTPAGE.OUT to the appropriate file .PG)
----------------ZZZ
Process the remaining (less PRON 5) ZZZ.TXT with DICTPAGE
(Copy ZZZ.TXT to DICTPAGE.IN, run DICTPAGE, copy DICTPAGE.OUT to ZZZ.PG)
Most of them will be handled. Hand edit the rest.
Some should be expanded (archaic forms in one stem need to be filled out).
Some should be modified (e.g., the plurals).
Some should be trimmed (adjectives with no positive).
There are some kludges (artificial entries which generate irregular forms)
here. Some may just be excluded from the .PG .
----------------GKADJ
Sort GKADJ to get the various parts together for a multiple entry
SORTER
GKDAJ.TXT
1 75 -- STEMS
111 80 -- MEAN -- To order |'s
101 10 -- TRAN
77 24 P -- PART
GKADJ.TXT -- Where to put result
Run DICTPAGE and edit. This edit is straightforward but tedious.
I should prepare a procedure to do this automatically, but have not yet.
It is likely that there are few or no changes
from the previous run and those results can be used/modified.
The product is GKADJ.PG
----------------PRON1
This must be hand edited. However it may not change much between versions.
----------------PRON5
Very small.
----------------UNIQUES
UNIQUES are treated by UNIQPAGE.EXE, giving UNIQPAGE.PG
----------------
----------------
The resulting files (with extensions appropriate to the phase of the operation,
ending in .PG) are
GKADJ
PRON1
PRON5
REST
UNIQPAGE
ZZZ
----------------FINISH
Assemble the 6 .PG files to DICTPAGE.PG and sort to produce DICTPAGE.RAW
SORTER
DICTPAGE.PG
1 300 C -- Everything
1 300 A -- For Caps
DICTPAGE.RAW -- Where to put result
Then process with PAGE2HTM ans add PREAMBLE.TXT at begining and end BODY at end
to get DICTPAGE.HTM
---------------------------------------------------------------------
------------------------------------------------------------------
----------------------THE SHORT FORM------------------------------
------------------------------------------------------------------
------ SORT DICTLINE
SORTER
DICTLINE.GEN
1 75 -- STEMS
77 24 P -- PART
111 80 -- MEAN -- To order |'s
101 10 -- TRAN
DICTLINE.GEN -- Where to put result
WAKEDICT/MAKEDICT
------ SORT STEMLIST IF NOT PROVIDED
SORTER
STEMLIST.GEN -- Input
1 18 U
20 24 P
1 18 A
1 56 C
STEMLIST.GEN -- Output
MAKESTEM
MAKEEWDS
------ SORT EWDSLIST
SORTER
EWDSLIST.GEN
1 24 A -- Main word
1 24 C -- Main word for CAPS
51 6 R -- Part of Speech
72 5 N D -- RANK
58 1 D -- FREQ
EWSDLIST.GEN -- Output
MAKEEFIL

3207
INFLECTS.LAT Normal file
View File

File diff suppressed because it is too large Load Diff

62085
STEMLIST.GEN Normal file
View File

File diff suppressed because it is too large Load Diff

222
UNIQUES.LAT Normal file
View File

@@ -0,0 +1,222 @@
agantur
V 3 1 PRES PASSIVE SUB 3 P IMPERS F X X E E
let them be treated; let it be a matter or question of;
agatur
V 3 1 PRES PASSIVE SUB 3 S IMPERS F X X E E
let it be treated; let it be a matter or question of;
necessest
V 5 1 PRES ACTIVE IND 3 S IMPERS X X X C X
it is necessary/essential/unavoidable/true; it is inevitable/by natural law;
aforem
V 5 1 IMPF ACTIVE SUB 1 S TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
afores
V 5 1 IMPF ACTIVE SUB 2 S TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
aforet
V 5 1 IMPF ACTIVE SUB 3 S TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
aforemus
V 5 1 IMPF ACTIVE SUB 1 P TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
aforetis
V 5 1 IMPF ACTIVE SUB 2 P TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
aforent
V 5 1 IMPF ACTIVE SUB 3 P TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
afore
V 5 1 FUT ACTIVE INF 0 X TO_BEING X X X C X
be away/absent/distant/missing; be free/removed from; be lacking; be distinct;
viden
V 2 1 PRES ACTIVE IND 2 S TRANS X X X C S
do you not see; or consider; (vides-ne);
memento
V 0 0 PRES ACTIVE IMP 2 S TRANS X X X C O
remember; be mindful of;
mementote
V 0 0 PRES ACTIVE IMP 2 P TRANS X X X C O
remember; be mindful of;
cette
V 3 1 PRES ACTIVE IMP 2 P TRANS X X X B O
give/bring here!/hand over, come (now/here); tell/show us, out with it! behold!
cedo
V 3 1 PRES ACTIVE IMP 2 S TRANS X X X B O
give/bring here!/hand over, come (now/here); tell/show us, out with it! behold!
adesdum
V 5 1 PRES ACTIVE IMP 2 S TO_BEING X X X C X
come hither; (ades dum);
chely
N 9 9 VOC S F T X X X C S
lyre, harp; tortoise shell (from which lyres were made); tortoise;
chelyn
N 9 9 ACC S F T X X X C O
lyre, harp; tortoise shell (from which lyres were made); tortoise;
exspes
ADJ 3 1 NOM S X POS X X X C X
hopeless; (only NOM S);
iusiurandum
N 2 1 NOM S N t X X X C X
an oath (ius iurandum);
iurisiurandi
N 2 1 GEN S N t X X X C X
an oath (ius iurandum);
iusiurandum
N 2 1 ACC S N t X X X C X
an oath (ius iurandum);
iureiurando
N 2 1 ABL S N t X X X C X
an oath (ius iurandum);
ec
PRON 3 1 NOM S F ADJECT E X X E W
this; person/thing present/just mentioned/in this place; ((h)(a)ec); +DEMONS;
ec
PRON 3 1 NOM P N ADJECT E X X E W
these (pl.); persons/things/conditions present/here/just mentioned; +DEMONS;
ec
PRON 3 1 ACC P N ADJECT E X X E W
these (pl.); persons/things/conditions present/here/just mentioned; +DEMONS;
eadem
PRON 4 2 NOM S F DEMONS X X X B X
same, the same, the very same; also; (idem, eadem, idem);
eadem
PRON 4 2 NOM P N DEMONS X X X B X
same, the same, the very same; also; (idem, eadem, idem);
eadem
PRON 4 2 ACC P N DEMONS X X X B X
same, the same, the very same; also; (idem, eadem, idem);
eundem
PRON 4 2 ACC S M DEMONS X X X B X
same, the same, the very same; also; (idem, eadem, idem);
eodem
PRON 4 2 ABL S X DEMONS X X X B X
same, the same, the very same; also; (idem, eadem, idem);
quisquis
PRON 1 2 NOM S C ADJECT X X X B X
whoever; every one who; whoever it be; everyone; each;
quidquid
PRON 1 6 NOM S N INDEF X X X B X
whatever, whatsoever; everything which; each one; each; everything; anything;
quicquid
PRON 1 6 NOM S N INDEF X X X B X
whatever, whatsoever; everything which; each one; each; everything; anything;
quodquod
PRON 1 7 NOM S N ADJECT X X X B X
whatever, whatsoever; everything which; each one; each; everything; anything;
quemquem
PRON 1 0 ACC S M ADJECT X X X C X
whomever; every one who; whomever it be; everyone; each;
quidquid
PRON 1 6 ACC S N ADJECT X X X C X
whatever, whatsoever; everything which; each one; each; everything; anything;
quicquid
PRON 1 6 ACC S N ADJECT X X X C X
whatever, whatsoever; everything which; each one; each; everything; anything;
quodquod
PRON 1 7 ACC S N ADJECT X X X C X
whatever, whatsoever; everything which; each one; each; everything; anything;
chodchod
PRON 1 7 ACC S N ADJECT E X X F W
whatever; everything/anything (which); valuable merchandise (Souter);
quoquo
PRON 1 0 ABL S X ADJECT X X X C X
whoever; whatever, whatsoever; every one who; everything which; each one; each;
quicquam
PRON 1 6 NOM S N ADJECT X X X C X
any; anything; anything whatsoever;
quicquam
PRON 1 6 ACC S N ADJECT X X X C X
any; anything; anything whatsoever;
quippiam
PRON 1 0 NOM S N INDEF X X X B O
some/any one/thing; unspecified thing/person; certain quanity, a bit; at all;
quippiam
PRON 1 0 ACC S N INDEF X X X B O
some/any one/thing; unspecified thing/person; certain quanity, a bit; at all;
unusquisque
PRON 1 0 NOM S M INDEF X X X D W
each one;
uniuscuiusque
PRON 1 0 GEN S X INDEF X X X D W
each one;
unicuique
PRON 1 0 DAT S X INDEF X X X D W
each one;
unumquodque
PRON 1 0 ACC S M INDEF X X X D W
each one;
quantumcumque
N 2 2 NOM S N T X X X D O
however much/little; as much as; whatever;
quantumcumque
N 2 2 ACC S N T X X X D O
however much/little; as much as; whatever;
mi
ADJ 1 1 VOC S M POS X X X B X
my, mine;
mare
ADJ 3 1 NOM S N POS X X X F O
male; masculine, of the male sex; manly, virile, brave, noble; G:masculine;
di
N 2 1 NOM P M p X E X C X
god;
dii
N 2 1 NOM P M p X E X C X
god;
deus
N 2 1 VOC S M p X E X C X
god; God!: Oh God;
di
N 2 1 VOC P M p X E X C X
god;
dii
N 2 1 VOC P M p X E X C X
god;
dis
N 2 1 ABL P M p X E X C X
god;
diis
N 2 1 DAT P M p X E X C X
god;
dis
N 2 1 DAT P M p X E X C X
god;
diis
N 2 1 ABL P M p X E X C X
god;
boum
N 3 1 GEN P C t X A X E O
ox; bull; cow; cattle (pl.); (odd form of bos or bus);
bobus
N 3 1 DAT P C t X A X D O
ox; bull; cow; cattle (pl.); (odd form of bos or bus);
bobus
N 3 1 ABL P C t X A X D O
ox; bull; cow; cattle (pl.); (odd form of bos or bus);
mensuum
N 3 3 GEN P M t X X X C O
month;
republicae
N 5 1 GEN S F t X X X B X
of the state/republic; (res publica => the state);
rusi
N 3 1 LOC S N w X X X B X
country; ( = in the country); (ancient form carried on);
mavis
V 6 2 PRES ACTIVE IND 2 S X X X X B X
prefer;
mavult
V 6 2 PRES ACTIVE IND 3 S X X X X B X
prefer;
mavultis
V 6 2 PRES ACTIVE IND 2 P X X X X B X
prefer;
vis
V 6 2 PRES ACTIVE IND 2 S X X X X A X
be willing; wish;
vult
V 6 2 PRES ACTIVE IND 3 S X X X X A X
be willing; wish;
vultis
V 6 2 PRES ACTIVE IND 2 P X X X X A X
be willing; wish;

863
addons_package.adb Normal file
View File

@@ -0,0 +1,863 @@
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
with PREFACE;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
pragma ELABORATE(INFLECTIONS_PACKAGE);
pragma ELABORATE(DICTIONARY_PACKAGE);
package body ADDONS_PACKAGE is
use TEXT_IO;
use PART_OF_SPEECH_TYPE_IO;
use TARGET_ENTRY_IO;
use PART_ENTRY_IO;
--use KIND_ENTRY_IO;
use STEM_KEY_TYPE_IO;
function EQU(C, D : CHARACTER) return BOOLEAN is
begin
if (D = 'u') or (D = 'v') then
if (C = 'u') or (C = 'v') then
return TRUE;
else
return FALSE;
end if;
else
return C = D;
end if;
end EQU;
function EQU(S, T : STRING) return BOOLEAN is
begin
if S'LENGTH /= T'LENGTH then
return FALSE;
end if;
for I in 1..S'LENGTH loop
if not EQU(S(S'FIRST+I-1), T(T'FIRST+I-1)) then
return FALSE;
end if;
end loop;
return TRUE;
end EQU;
procedure LOAD_ADDONS (FILE_NAME : in STRING) is
use PART_OF_SPEECH_TYPE_IO;
use TACKON_ENTRY_IO;
use PREFIX_ENTRY_IO;
use SUFFIX_ENTRY_IO;
--use DICT_IO;
S : STRING(1..100);
L, LAST, TIC, PRE, SUF, TAC, PAC : INTEGER := 0;
ADDONS_FILE : TEXT_IO.FILE_TYPE;
D_K : constant DICTIONARY_KIND := ADDONS;
POFS: PART_OF_SPEECH_TYPE;
DE : DICTIONARY_ENTRY := NULL_DICTIONARY_ENTRY;
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
M : INTEGER := 1;
--TG : TARGET_ENTRY;
TN : TACKON_ENTRY;
PM : PREFIX_ITEM;
TS : STEM_TYPE;
procedure GET_NO_COMMENT_LINE(F : in TEXT_IO.FILE_TYPE;
S : out STRING; LAST : out INTEGER) is
T : STRING(1..250) := (others => ' ');
L : INTEGER := 0;
begin
LAST := 0;
while not END_OF_FILE(F) loop
GET_LINE(F, T, L);
if L >= 2 and then
(HEAD(TRIM(T), 250)(1..2) = "--" or
HEAD(TRIM(T), 250)(1..2) = " ") then
null;
else
S(1..L) := T(1..L);
LAST := L;
exit;
end if;
end loop;
end GET_NO_COMMENT_LINE;
procedure EXTRACT_FIX(S : in STRING;
XFIX : out FIX_TYPE; XC : out CHARACTER) is
ST : constant STRING := TRIM(S);
L : INTEGER := ST'LENGTH;
J : INTEGER := 0;
begin
for I in 1..L loop
J := I;
exit when ( (I < L) and then (ST(I+1) = ' ') );
end loop;
XFIX := HEAD(ST(1..J), MAX_FIX_SIZE);
if J = L then -- there is no CONNECT CHARACTER
XC := ' ';
return;
else
for I in J+1..L loop
if ST(I) /= ' ' then
XC := ST(I);
exit;
end if;
end loop;
end if;
return;
end EXTRACT_FIX;
begin
OPEN(ADDONS_FILE, IN_FILE, FILE_NAME);
PREFACE.PUT("ADDONS");
PREFACE.PUT(" loading ");
-- if DICT_IO.IS_OPEN(DICT_FILE(D_K)) then
-- DICT_IO.DELETE(DICT_FILE(D_K));
-- end if;
-- DICT_IO.CREATE(DICT_FILE(D_K), DICT_IO.INOUT_FILE,
-- --ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME, DICTIONARY_KIND'IMAGE(D_K)));
-- "");
--
while not END_OF_FILE(ADDONS_FILE) loop
DE := NULL_DICTIONARY_ENTRY;
GET_NO_COMMENT_LINE(ADDONS_FILE, S, LAST);
--TEXT_IO.PUT_LINE(S(1..LAST));
GET(S(1..LAST), POFS, L);
case POFS is
when TACKON =>
TS := HEAD(TRIM(S(L+1..LAST)), MAX_STEM_SIZE);
DE.STEMS(1) := TS;
GET_LINE(ADDONS_FILE, S, LAST);
GET(S(1..LAST), TN, L);
GET_LINE(ADDONS_FILE, S, LAST);
MEAN := HEAD(S(1..LAST), MAX_MEANING_SIZE);
if TN.BASE.POFS= PACK and then
(TN.BASE.PACK.DECL.WHICH = 1 or
TN.BASE.PACK.DECL.WHICH = 2) and then
MEAN(1..9) = "PACKON w/" then
PAC := PAC + 1;
PACKONS (PAC).POFS:= POFS;
PACKONS(PAC).TACK := TS;
PACKONS(PAC).ENTR := TN;
-- DICT_IO.SET_INDEX(DICT_FILE(D_K), M);
-- DE.MEAN := MEAN;
-- DICT_IO.WRITE(DICT_FILE(D_K), DE);
PACKONS (PAC).MNPC := M;
MEANS(M) := MEAN;
M := M + 1;
else
TAC := TAC + 1;
TACKONS (TAC).POFS:= POFS;
TACKONS(TAC).TACK := TS;
TACKONS(TAC).ENTR := TN;
-- DICT_IO.SET_INDEX(DICT_FILE(D_K), M);
-- DE.MEAN := MEAN;
-- DICT_IO.WRITE(DICT_FILE(D_K), DE);
-- --DICT_IO.WRITE(DICT_FILE(D_K), MEAN);
TACKONS (TAC).MNPC := M;
MEANS(M) := MEAN;
M := M + 1;
end if;
NUMBER_OF_PACKONS := PAC;
NUMBER_OF_TACKONS := TAC;
when PREFIX =>
EXTRACT_FIX(S(L+1..LAST), PM.FIX, PM.CONNECT);
GET_LINE(ADDONS_FILE, S, LAST);
GET(S(1..LAST), PM.ENTR, L);
GET_LINE(ADDONS_FILE, S, LAST);
MEAN := HEAD(S(1..LAST), MAX_MEANING_SIZE);
if PM.ENTR.ROOT = PACK then
TIC := TIC + 1;
TICKONS (TIC).POFS:= POFS;
TICKONS(TIC).FIX := PM.FIX;
TICKONS(TIC).CONNECT := PM.CONNECT;
TICKONS(TIC).ENTR := PM.ENTR;
-- DICT_IO.SET_INDEX(DICT_FILE(D_K), M);
-- DE.MEAN := MEAN;
-- DICT_IO.WRITE(DICT_FILE(D_K), DE);
-- --DICT_IO.WRITE(DICT_FILE(D_K), MEAN);
TICKONS (TIC).MNPC := M;
MEANS(M) := MEAN;
M := M + 1;
else
PRE := PRE + 1;
PREFIXES(PRE).POFS:= POFS;
PREFIXES(PRE).FIX := PM.FIX;
PREFIXES(PRE).CONNECT := PM.CONNECT;
PREFIXES(PRE).ENTR := PM.ENTR;
-- DICT_IO.SET_INDEX(DICT_FILE(D_K), M);
DE.MEAN := MEAN;
-- DICT_IO.WRITE(DICT_FILE(D_K), DE);
-- --DICT_IO.WRITE(DICT_FILE(D_K), MEAN);
PREFIXES(PRE).MNPC := M;
MEANS(M) := MEAN;
M := M + 1;
end if;
NUMBER_OF_TICKONS := TIC;
NUMBER_OF_PREFIXES := PRE;
when SUFFIX =>
SUF := SUF + 1;
SUFFIXES(SUF).POFS:= POFS;
--TEXT_IO.PUT_LINE(S(1..LAST));
EXTRACT_FIX(S(L+1..LAST), SUFFIXES(SUF).FIX, SUFFIXES(SUF).CONNECT);
--TEXT_IO.PUT("@1");
GET_LINE(ADDONS_FILE, S, LAST);
--TEXT_IO.PUT("@2");
--TEXT_IO.PUT_LINE(S(1..LAST) & "<");
--TEXT_IO.PUT("@2");
GET(S(1..LAST), SUFFIXES(SUF).ENTR, L);
--TEXT_IO.PUT("@3");
GET_LINE(ADDONS_FILE, S, LAST);
--TEXT_IO.PUT("@4");
MEAN := HEAD(S(1..LAST), MAX_MEANING_SIZE);
--TEXT_IO.PUT("@5");
--
-- DICT_IO.SET_INDEX(DICT_FILE(D_K), M);
-- DE.MEAN := MEAN;
-- DICT_IO.WRITE(DICT_FILE(D_K), DE);
-- --DICT_IO.WRITE(DICT_FILE(D_K), MEAN);
SUFFIXES(SUF).MNPC := M;
MEANS(M) := MEAN;
M := M + 1;
NUMBER_OF_SUFFIXES := SUF;
when others =>
TEXT_IO.PUT_LINE("Bad ADDON !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
TEXT_IO.PUT_LINE(S(1..LAST));
raise TEXT_IO.DATA_ERROR;
end case;
end loop;
PREFACE.PUT(TAC, 1); PREFACE.PUT("+");
PREFACE.PUT(PAC, 2); PREFACE.PUT(" TACKONS ");
PREFACE.PUT(TIC, 1); PREFACE.PUT("+");
PREFACE.PUT(PRE, 3); PREFACE.PUT(" PREFIXES ");
PREFACE.PUT(SUF, 3); PREFACE.PUT(" SUFFIXES ");
PREFACE.SET_COL(60); PREFACE.PUT_LINE("-- Loaded correctly");
CLOSE(ADDONS_FILE);
--for I in MEANS'RANGE loop
-- TEXT_IO.PUT(INTEGER'IMAGE(INTEGER(I))); TEXT_IO.PUT_LINE("--" & MEANS(I));
--end loop;
exception
when TEXT_IO.NAME_ERROR =>
PREFACE.PUT_LINE("No ADDONS file ");
null;
when TEXT_IO.DATA_ERROR =>
PREFACE.PUT_LINE(S(1..LAST));
PREFACE.PUT_LINE("No further ADDONS read ");
CLOSE(ADDONS_FILE);
when others =>
PREFACE.PUT_LINE("Exception in LOAD_ADDONS");
PREFACE.PUT_LINE(S(1..LAST));
end LOAD_ADDONS;
function SUBTRACT_TACKON(W : STRING; X : TACKON_ITEM) return STRING is
WD : constant STRING := TRIM(W);
L : constant INTEGER := WD'LENGTH;
XF : constant STRING := TRIM(X.TACK);
Z : constant INTEGER := XF'LENGTH;
begin
--PUT_LINE("In SUB TACKON " & INTEGER'IMAGE(L) & INTEGER'IMAGE(Z));
if WORDS_MDEV(USE_TACKONS) and then
L > Z and then
--WD(L-Z+1..L) = XF(1..Z) then
EQU(WD(L-Z+1..L), XF(1..Z)) then
--PUT("In SUBTRACT_TACKON we got a hit "); PUT_LINE(X.TACK);
return WD(1..L-Z);
else
--PUT("In SUBTRACT_TACKON NO hit "); PUT_LINE(X.TACK);
return W;
end if;
end SUBTRACT_TACKON;
function SUBTRACT_PREFIX(W : STRING; X : PREFIX_ITEM) return STEM_TYPE is
WD : constant STRING := TRIM(W);
XF : constant STRING := TRIM(X.FIX);
Z : constant INTEGER := XF'LENGTH;
ST : STEM_TYPE := HEAD(WD, MAX_STEM_SIZE);
begin
if WORDS_MDEV(USE_PREFIXES) and then
X /= NULL_PREFIX_ITEM and then
WD'LENGTH > Z and then
--WD(1..Z) = XF(1..Z) and then
EQU(WD(1..Z), XF(1..Z)) and then
( (X.CONNECT = ' ') or (WD(Z+1) = X.CONNECT) ) then
ST(1..WD'LENGTH-Z) := WD(Z+1..WD'LAST);
ST(WD'LENGTH-Z+1..MAX_STEM_SIZE) :=
NULL_STEM_TYPE(WD'LENGTH-Z+1..MAX_STEM_SIZE);
end if;
--PUT_LINE("SUBTRACT_PREFIX " & X.FIX & " FROM " & WD & " returns " & ST);
return ST;
end SUBTRACT_PREFIX;
function SUBTRACT_SUFFIX(W : STRING; X : SUFFIX_ITEM) return STEM_TYPE is
WD : constant STRING := TRIM(W);
L : constant INTEGER := WD'LENGTH;
XF : constant STRING := TRIM(X.FIX);
Z : constant INTEGER := XF'LENGTH;
ST : STEM_TYPE := HEAD(WD, MAX_STEM_SIZE);
begin
--PUT_LINE("In SUBTRACT_SUFFIX Z = " & INTEGER'IMAGE(Z) &
--" CONNECT >" & X.CONNECT & '<');
if WORDS_MDEV(USE_SUFFIXES) and then
X /= NULL_SUFFIX_ITEM and then
WD'LENGTH > Z and then
--WD(L-Z+1..L) = XF(1..Z) and then
EQU(WD(L-Z+1..L), XF(1..Z)) and then
( (X.CONNECT = ' ') or (WD(L-Z) = X.CONNECT) ) then
--PUT_LINE("In SUBTRACT_SUFFIX we got a hit");
ST(1..WD'LENGTH-Z) := WD(1..WD'LENGTH-Z);
ST(WD'LENGTH-Z+1..MAX_STEM_SIZE) :=
NULL_STEM_TYPE(WD'LENGTH-Z+1..MAX_STEM_SIZE);
end if;
--PUT_LINE("SUBTRACT_SUFFIX " & X.FIX & " FROM " & WD & " returns " & ST);
return ST;
end SUBTRACT_SUFFIX;
function ADD_PREFIX(STEM : STEM_TYPE;
PREFIX : PREFIX_ITEM) return STEM_TYPE is
FPX : constant STRING := TRIM(PREFIX.FIX) & STEM;
begin
if WORDS_MDEV(USE_PREFIXES) then
return HEAD(FPX, MAX_STEM_SIZE);
else
return STEM;
end if;
end ADD_PREFIX;
function ADD_SUFFIX(STEM : STEM_TYPE;
SUFFIX : SUFFIX_ITEM) return STEM_TYPE is
FPX : constant STRING := TRIM(STEM) & SUFFIX.FIX;
begin
if WORDS_MDEV(USE_SUFFIXES) then
return HEAD(FPX, MAX_STEM_SIZE);
else
return STEM;
end if;
end ADD_SUFFIX;
-- package body TARGET_ENTRY_IO is separate;
-- package body TACKON_ENTRY_IO is separate;
-- package body TACKON_LINE_IO is separate;
-- package body PREFIX_ENTRY_IO is separate;
-- package body PREFIX_LINE_IO is separate;
-- package body SUFFIX_ENTRY_IO is separate;
-- package body SUFFIX_LINE_IO is separate;
package body TARGET_ENTRY_IO is
use PART_OF_SPEECH_TYPE_IO;
use NOUN_ENTRY_IO;
use PRONOUN_ENTRY_IO;
use PROPACK_ENTRY_IO;
use ADJECTIVE_ENTRY_IO;
use NUMERAL_ENTRY_IO;
use ADVERB_ENTRY_IO;
use VERB_ENTRY_IO;
-- use KIND_ENTRY_IO;
--
-- use NOUN_KIND_TYPE_IO;
-- use PRONOUN_KIND_TYPE_IO;
-- use INFLECTIONS_PACKAGE.INTEGER_IO;
-- use VERB_KIND_TYPE_IO;
SPACER : CHARACTER := ' ';
NOUN : NOUN_ENTRY;
PRONOUN : PRONOUN_ENTRY;
PROPACK : PROPACK_ENTRY;
ADJECTIVE : ADJECTIVE_ENTRY;
NUMERAL : NUMERAL_ENTRY;
ADVERB : ADVERB_ENTRY;
VERB : VERB_ENTRY;
-- NOUN_KIND : NOUN_KIND_TYPE;
-- PRONOUN_KIND : PRONOUN_KIND_TYPE;
-- PROPACK_KIND : PRONOUN_KIND_TYPE;
-- NUMERAL_VALUE : NUMERAL_VALUE_TYPE;
-- VERB_KIND : VERB_KIND_TYPE;
--KIND : KIND_ENTRY;
P : TARGET_ENTRY;
procedure GET(F : in FILE_TYPE; P : out TARGET_ENTRY) is
PS : TARGET_POFS_TYPE := X;
begin
GET(F, PS);
GET(F, SPACER);
case PS is
when N =>
GET(F, NOUN);
--GET(F, NOUN_KIND);
P := (N, NOUN); --, NOUN_KIND);
when PRON =>
GET(F, PRONOUN);
--GET(F, PRONOUN_KIND);
P := (PRON, PRONOUN); --, PRONOUN_KIND);
when PACK =>
GET(F, PROPACK);
--GET(F, PROPACK_KIND);
P := (PACK, PROPACK); --, PROPACK_KIND);
when ADJ =>
GET(F, ADJECTIVE);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(F, NUMERAL);
--GET(F, NUMERAL_VALUE);
P := (NUM, NUMERAL); --, NUMERAL_VALUE);
when ADV =>
GET(F, ADVERB);
P := (ADV, ADVERB);
when V =>
GET(F, VERB);
--GET(F, VERB_KIND);
P := (V, VERB); --, VERB_KIND);
when X =>
P := (POFS=> X);
end case;
return;
end GET;
procedure GET(P : out TARGET_ENTRY) is
PS : TARGET_POFS_TYPE := X;
begin
GET(PS);
GET(SPACER);
case PS is
when N =>
GET(NOUN);
--GET(NOUN_KIND);
P := (N, NOUN); --, NOUN_KIND);
when PRON =>
GET(PRONOUN);
--GET(PRONOUN_KIND);
P := (PRON, PRONOUN); --, PRONOUN_KIND);
when PACK =>
GET(PROPACK);
--GET(PROPACK_KIND);
P := (PACK, PROPACK); --, PROPACK_KIND);
when ADJ =>
GET(ADJECTIVE);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(NUMERAL);
--GET(NUMERAL_VALUE);
P := (NUM, NUMERAL); --, NUMERAL_VALUE);
when ADV =>
GET(ADVERB);
P := (ADV, ADVERB);
when V =>
GET(VERB);
--GET(VERB_KIND);
P := (V, VERB); --, VERB_KIND);
when X =>
P := (POFS=> X);
end case;
return;
end GET;
procedure PUT(F : in FILE_TYPE; P : in TARGET_ENTRY) is
C : POSITIVE := POSITIVE(COL(F));
begin
PUT(F, P.POFS);
PUT(F, ' ');
case P.POFS is
when N =>
PUT(F, P.N);
--PUT(F, P.NOUN_KIND);
when PRON =>
PUT(F, P.PRON);
--PUT(F, P.PRONOUN_KIND);
when PACK =>
PUT(F, P.PACK);
--PUT(F, P.PROPACK_KIND);
when ADJ =>
PUT(F, P.ADJ);
when NUM =>
PUT(F, P.NUM);
--PUT(F, P.NUMERAL_VALUE);
when ADV =>
PUT(F, P.ADV);
when V =>
PUT(F, P.V);
--PUT(F, P.VERB_KIND);
when others =>
null;
end case;
PUT(F, STRING'((INTEGER(COL(F))..TARGET_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
return;
end PUT;
procedure PUT(P : in TARGET_ENTRY) is
C : POSITIVE := POSITIVE(COL);
begin
PUT(P.POFS);
PUT(' ');
case P.POFS is
when N =>
PUT(P.N);
--PUT(P.NOUN_KIND);
when PRON =>
PUT(P.PRON);
--PUT(P.PRONOUN_KIND);
when PACK =>
PUT(P.PACK);
--PUT(P.PROPACK_KIND);
when ADJ =>
PUT(P.ADJ);
when NUM =>
PUT(P.NUM);
--PUT(P.NUMERAL_VALUE);
when ADV =>
PUT(P.ADV);
when V =>
PUT(P.V);
--PUT(P.VERB_KIND);
when others =>
null;
end case;
PUT(STRING'((INTEGER(COL)..TARGET_ENTRY_IO.DEFAULT_WIDTH+C-1 => ' ')));
return;
end PUT;
procedure GET(S : in STRING; P : out TARGET_ENTRY; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
PS : TARGET_POFS_TYPE := X;
begin
GET(S, PS, L);
L := L + 1;
case PS is
when N =>
GET(S(L+1..S'LAST), NOUN, LAST);
--GET(S(L+1..S'LAST), NOUN_KIND, LAST);
P := (N, NOUN); --, NOUN_KIND);
when PRON =>
GET(S(L+1..S'LAST), PRONOUN, LAST);
--GET(S(L+1..S'LAST), PRONOUN_KIND, LAST);
P := (PRON, PRONOUN); --, PRONOUN_KIND);
when PACK =>
GET(S(L+1..S'LAST), PROPACK, LAST);
--GET(S(L+1..S'LAST), PROPACK_KIND, LAST);
P := (PACK, PROPACK); --, PROPACK_KIND);
when ADJ =>
GET(S(L+1..S'LAST), ADJECTIVE, LAST);
P := (ADJ, ADJECTIVE);
when NUM =>
GET(S(L+1..S'LAST), NUMERAL, LAST);
--GET(S(L+1..S'LAST), NUMERAL_VALUE, LAST);
P := (NUM, NUMERAL); --, NUMERAL_VALUE);
when ADV =>
GET(S(L+1..S'LAST), ADVERB, LAST);
P := (ADV, ADVERB);
when V =>
GET(S(L+1..S'LAST), VERB, LAST);
--GET(S(L+1..S'LAST), VERB_KIND, LAST);
P := (V, VERB); --, VERB_KIND);
when X =>
P := (POFS=> X);
end case;
return;
end GET;
procedure PUT(S : out STRING; P : in TARGET_ENTRY) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.POFS);
L := M + 1;
S(L) := ' ';
case P.POFS is
when N =>
M := L + NOUN_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.N);
-- M := L + NOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
-- PUT(S(L+1..M), P.NOUN_KIND);
when PRON =>
M := L + PRONOUN_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PRON);
-- M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
-- PUT(S(L+1..M), P.PRONOUN_KIND);
when PACK =>
M := L + PROPACK_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.PACK);
-- M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
-- PUT(S(L+1..M), P.PROPACK_KIND);
when ADJ =>
M := L + ADJECTIVE_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ADJ);
when NUM =>
M := L + NUMERAL_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.NUM);
-- M := L + NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH;
-- PUT(S(L+1..M), P.PRONOUN_KIND);
when ADV =>
M := L + ADVERB_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ADV);
when V =>
M := L + VERB_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.V);
-- M := L + PRONOUN_KIND_TYPE_IO.DEFAULT_WIDTH;
-- PUT(S(L+1..M), P.PRONOUN_KIND);
when others =>
null;
end case;
S(M+1..S'LAST) := (others => ' ');
end PUT;
end TARGET_ENTRY_IO;
package body TACKON_ENTRY_IO is
SPACER : CHARACTER := ' ';
procedure GET(F : in FILE_TYPE; I : out TACKON_ENTRY) is
begin
GET(F, I.BASE);
end GET;
procedure GET(I : out TACKON_ENTRY) is
begin
GET(I.BASE);
end GET;
procedure PUT(F : in FILE_TYPE; I : in TACKON_ENTRY) is
begin
PUT(F, I.BASE);
end PUT;
procedure PUT(I : in TACKON_ENTRY) is
begin
PUT(I.BASE);
end PUT;
procedure GET(S : in STRING; I : out TACKON_ENTRY; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), I.BASE, LAST);
end GET;
procedure PUT(S : out STRING; I : in TACKON_ENTRY) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + TARGET_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), I.BASE);
S(S'FIRST..S'LAST) := (others => ' ');
end PUT;
end TACKON_ENTRY_IO;
package body PREFIX_ENTRY_IO is
use PART_OF_SPEECH_TYPE_IO;
use TEXT_IO;
SPACER : CHARACTER := ' ';
PE : PREFIX_ENTRY;
procedure GET(F : in FILE_TYPE; P : out PREFIX_ENTRY) is
begin
GET(F, P.ROOT);
GET(F, SPACER);
GET(F, P.TARGET);
end GET;
procedure GET(P : out PREFIX_ENTRY) is
begin
GET(P.ROOT);
GET(SPACER);
GET(P.TARGET);
end GET;
procedure PUT(F : in FILE_TYPE; P : in PREFIX_ENTRY) is
begin
PUT(F, P.ROOT);
PUT(F, ' ');
PUT(F, P.TARGET);
end PUT;
procedure PUT(P : in PREFIX_ENTRY) is
begin
PUT(P.ROOT);
PUT(' ');
PUT(P.TARGET);
end PUT;
procedure GET(S : in STRING; P : out PREFIX_ENTRY; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
GET(S(L+1..S'LAST), P.ROOT, L);
L := L + 1;
GET(S(L+1..S'LAST), P.TARGET, LAST);
end GET;
procedure PUT(S : out STRING; P : in PREFIX_ENTRY) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ROOT);
L := M + 1;
S(L) := ' ';
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.TARGET);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end PREFIX_ENTRY_IO;
package body SUFFIX_ENTRY_IO is
use PART_OF_SPEECH_TYPE_IO;
use TARGET_ENTRY_IO;
use TEXT_IO;
SPACER : CHARACTER := ' ';
PE : SUFFIX_ENTRY;
procedure GET(F : in FILE_TYPE; P : out SUFFIX_ENTRY) is
begin
GET(F, P.ROOT);
GET(F, SPACER);
GET(F, P.ROOT_KEY);
GET(F, SPACER);
GET(F, P.TARGET);
GET(F, SPACER);
GET(F, P.TARGET_KEY);
end GET;
procedure GET(P : out SUFFIX_ENTRY) is
begin
GET(P.ROOT);
GET(SPACER);
GET(P.ROOT_KEY);
GET(SPACER);
GET(P.TARGET);
GET(SPACER);
GET(P.TARGET_KEY);
end GET;
procedure PUT(F : in FILE_TYPE; P : in SUFFIX_ENTRY) is
begin
PUT(F, P.ROOT);
PUT(F, ' ');
PUT(F, P.ROOT_KEY, 2);
PUT(F, ' ');
PUT(F, P.TARGET);
PUT(F, ' ');
PUT(F, P.TARGET_KEY, 2);
end PUT;
procedure PUT(P : in SUFFIX_ENTRY) is
begin
PUT(P.ROOT);
PUT(' ');
PUT(P.ROOT_KEY, 2);
PUT(' ');
PUT(P.TARGET);
PUT(' ');
PUT(P.TARGET_KEY, 2);
end PUT;
procedure GET(S : in STRING; P : out SUFFIX_ENTRY; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
--TEXT_IO.PUT("#1" & INTEGER'IMAGE(L));
GET(S(L+1..S'LAST), P.ROOT, L);
--TEXT_IO.PUT("#2" & INTEGER'IMAGE(L));
L := L + 1;
GET(S(L+1..S'LAST), P.ROOT_KEY, L);
--TEXT_IO.PUT("#3" & INTEGER'IMAGE(L));
L := L + 1;
GET(S(L+1..S'LAST), P.TARGET, L);
--TEXT_IO.PUT("#4" & INTEGER'IMAGE(L));
L := L + 1;
GET(S(L+1..S'LAST), P.TARGET_KEY, LAST);
--TEXT_IO.PUT("#5" & INTEGER'IMAGE(LAST));
end GET;
procedure PUT(S : out STRING; P : in SUFFIX_ENTRY) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.ROOT);
L := M + 1;
S(L) := ' ';
M := L + 2;
PUT(S(L+1..M), P.ROOT_KEY);
L := M + 1;
S(L) := ' ';
M := L + TARGET_ENTRY_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.TARGET);
L := M + 1;
S(L) := ' ';
M := L + 2;
PUT(S(L+1..M), P.TARGET_KEY);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end SUFFIX_ENTRY_IO;
begin -- Initiate body of ADDONS_PACKAGE
--TEXT_IO.PUT_LINE("Initializing ADDONS_PACKAGE");
PREFIX_ENTRY_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 +
PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
TARGET_ENTRY_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 +
NUMERAL_ENTRY_IO.DEFAULT_WIDTH; -- Largest
SUFFIX_ENTRY_IO.DEFAULT_WIDTH := PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH + 1 +
2 + 1 +
TARGET_ENTRY_IO.DEFAULT_WIDTH + 1 +
2;
TACKON_ENTRY_IO.DEFAULT_WIDTH := TARGET_ENTRY_IO.DEFAULT_WIDTH;
end ADDONS_PACKAGE;

179
addons_package.ads Normal file
View File

@@ -0,0 +1,179 @@
with TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
package ADDONS_PACKAGE is
use TEXT_IO;
subtype FIX_TYPE is STEM_TYPE;
NULL_FIX_TYPE : constant FIX_TYPE := NULL_STEM_TYPE;
MAX_FIX_SIZE : constant := MAX_STEM_SIZE;
subtype TARGET_POFS_TYPE is PART_OF_SPEECH_TYPE range X..V;
type TARGET_ENTRY(POFS: TARGET_POFS_TYPE := X) is
record
case POFS is
when N =>
N : NOUN_ENTRY;
--NOUN_KIND : NOUN_KIND_TYPE;
when PRON =>
PRON : PRONOUN_ENTRY;
--PRONOUN_KIND : PRONOUN_KIND_TYPE;
when PACK =>
PACK : PROPACK_ENTRY;
--PROPACK_KIND : PRONOUN_KIND_TYPE;
when ADJ =>
ADJ : ADJECTIVE_ENTRY;
when NUM =>
NUM : NUMERAL_ENTRY;
--NUMERAL_VALUE : NUMERAL_VALUE_TYPE;
when ADV =>
ADV : ADVERB_ENTRY;
when V =>
V : VERB_ENTRY;
--VERB_KIND : VERB_KIND_TYPE;
when others =>
null;
end case;
end record;
NULL_TARGET_ENTRY : TARGET_ENTRY;
package TARGET_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out TARGET_ENTRY);
procedure GET(P : out TARGET_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in TARGET_ENTRY);
procedure PUT(P : in TARGET_ENTRY);
procedure GET(S : in STRING; P : out TARGET_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in TARGET_ENTRY);
end TARGET_ENTRY_IO;
type TACKON_ENTRY is
record
BASE : TARGET_ENTRY;
end record;
NULL_TACKON_ENTRY : TACKON_ENTRY;
package TACKON_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; I : out TACKON_ENTRY);
procedure GET(I : out TACKON_ENTRY);
procedure PUT(F : in FILE_TYPE; I : in TACKON_ENTRY);
procedure PUT(I : in TACKON_ENTRY);
procedure GET(S : in STRING; I : out TACKON_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; I : in TACKON_ENTRY);
end TACKON_ENTRY_IO;
type PREFIX_ENTRY is
record
ROOT : PART_OF_SPEECH_TYPE := X;
TARGET : PART_OF_SPEECH_TYPE := X;
end record;
NULL_PREFIX_ENTRY : PREFIX_ENTRY;
package PREFIX_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PREFIX_ENTRY);
procedure GET(P : out PREFIX_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in PREFIX_ENTRY);
procedure PUT(P : in PREFIX_ENTRY);
procedure GET(S : in STRING; P : out PREFIX_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PREFIX_ENTRY);
end PREFIX_ENTRY_IO;
type SUFFIX_ENTRY is
record
ROOT : PART_OF_SPEECH_TYPE := X;
ROOT_KEY : STEM_KEY_TYPE := 0;
TARGET : TARGET_ENTRY := NULL_TARGET_ENTRY;
TARGET_KEY : STEM_KEY_TYPE := 0;
end record;
NULL_SUFFIX_ENTRY : SUFFIX_ENTRY;
package SUFFIX_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out SUFFIX_ENTRY);
procedure GET(P : out SUFFIX_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in SUFFIX_ENTRY);
procedure PUT(P : in SUFFIX_ENTRY);
procedure GET(S : in STRING; P : out SUFFIX_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in SUFFIX_ENTRY);
end SUFFIX_ENTRY_IO;
type TACKON_ITEM is
record
POFS: PART_OF_SPEECH_TYPE := TACKON;
TACK : STEM_TYPE := NULL_STEM_TYPE;
ENTR : TACKON_ENTRY := NULL_TACKON_ENTRY;
MNPC : INTEGER := 0;
end record;
NULL_TACKON_ITEM : TACKON_ITEM;
type PREFIX_ITEM is
record
POFS: PART_OF_SPEECH_TYPE := PREFIX;
FIX : FIX_TYPE := NULL_FIX_TYPE;
CONNECT : CHARACTER := ' ';
ENTR : PREFIX_ENTRY := NULL_PREFIX_ENTRY;
MNPC : INTEGER := 0;
end record;
NULL_PREFIX_ITEM : PREFIX_ITEM;
type SUFFIX_ITEM is
record
POFS: PART_OF_SPEECH_TYPE := SUFFIX;
FIX : FIX_TYPE := NULL_FIX_TYPE;
CONNECT : CHARACTER := ' ';
ENTR : SUFFIX_ENTRY := NULL_SUFFIX_ENTRY;
MNPC : INTEGER := 0;
end record;
NULL_SUFFIX_ITEM : SUFFIX_ITEM;
type PREFIX_ARRAY is array (INTEGER range <>) of PREFIX_ITEM;
type TICKON_ARRAY is array (INTEGER range <>) of PREFIX_ITEM;
type SUFFIX_ARRAY is array (INTEGER range <>) of SUFFIX_ITEM;
type TACKON_ARRAY is array (INTEGER range <>) of TACKON_ITEM;
type MEANS_ARRAY is array (INTEGER range <>) of MEANING_TYPE;
-- To simulate a DICT_IO file, as used previously
TACKONS : TACKON_ARRAY(1..20);
PACKONS : TACKON_ARRAY(1..25);
TICKONS : PREFIX_ARRAY(1..10);
PREFIXES : PREFIX_ARRAY(1..130);
SUFFIXES : SUFFIX_ARRAY(1..185);
MEANS : MEANS_ARRAY(1..370);
NUMBER_OF_TICKONS : INTEGER := 0;
NUMBER_OF_TACKONS : INTEGER := 0;
NUMBER_OF_PACKONS : INTEGER := 0;
NUMBER_OF_PREFIXES : INTEGER := 0;
NUMBER_OF_SUFFIXES : INTEGER := 0;
procedure LOAD_ADDONS (FILE_NAME : in STRING);
function SUBTRACT_TACKON(W : STRING; X : TACKON_ITEM) return STRING;
function SUBTRACT_PREFIX(W : STRING; X : PREFIX_ITEM) return STEM_TYPE;
function SUBTRACT_TICKON(W : STRING; X : PREFIX_ITEM) return STEM_TYPE
renames SUBTRACT_PREFIX;
function SUBTRACT_SUFFIX(W : STRING; X : SUFFIX_ITEM) return STEM_TYPE;
function ADD_PREFIX(STEM : STEM_TYPE;
PREFIX : PREFIX_ITEM) return STEM_TYPE;
function ADD_SUFFIX(STEM : STEM_TYPE;
SUFFIX : SUFFIX_ITEM) return STEM_TYPE;
end ADDONS_PACKAGE;

20
config.ads Normal file
View File

@@ -0,0 +1,20 @@
package CONFIG is
OUTPUT_SCREEN_SIZE : INTEGER := 20;
type CONFIGURATION_TYPE is (DEVELOPER_VERSION, USER_VERSION, ONLY_MEANINGS);
CONFIGURATION : CONFIGURATION_TYPE := DEVELOPER_VERSION;
type METHOD_TYPE is (INTERACTIVE, COMMAND_LINE_INPUT, COMMAND_LINE_FILES);
METHOD : METHOD_TYPE := INTERACTIVE;
type LANGUAGE_TYPE is (LATIN_TO_ENGLISH, ENGLISH_TO_LATIN);
LANGUAGE : LANGUAGE_TYPE := LATIN_TO_ENGLISH;
SUPPRESS_PREFACE : BOOLEAN := FALSE;
end CONFIG;

878
developer_parameters.adb Normal file
View File

@@ -0,0 +1,878 @@
with TEXT_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES; -- Omit when put name here
with WORD_PARAMETERS; use WORD_PARAMETERS;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
with PREFACE;
with LINE_STUFF; use LINE_STUFF;
pragma Elaborate(PREFACE);
package body DEVELOPER_PARAMETERS is
use TEXT_IO;
type HELP_TYPE is array (NATURAL range <>) of STRING(1..70);
BLANK_HELP_LINE : constant STRING(1..70) := (others => ' ');
NO_HELP : constant HELP_TYPE := (2..1 => BLANK_HELP_LINE);
type REPLY_TYPE is (N, Y);
package REPLY_TYPE_IO is new TEXT_IO.ENUMERATION_IO(REPLY_TYPE);
REPLY : array (BOOLEAN) of REPLY_TYPE := (N, Y);
MDEV_OF_REPLY : array (REPLY_TYPE) of BOOLEAN := (FALSE, TRUE);
BLANK_INPUT : exception;
-- The default MDEVs are set in the body so that they can be changed
-- with only this being recompiled, not the rest of the with'ing system
DEFAULT_MDEV_ARRAY : constant MDEV_ARRAY := (
-- HAVE_DEBUG_FILE => FALSE,
-- WRITE_DEBUG_FILE => FALSE,
HAVE_STATISTICS_FILE => FALSE,
WRITE_STATISTICS_FILE => FALSE,
SHOW_DICTIONARY => FALSE,
SHOW_DICTIONARY_LINE => FALSE,
SHOW_DICTIONARY_CODES => TRUE,
DO_PEARSE_CODES => FALSE,
DO_ONLY_INITIAL_WORD => FALSE,
FOR_WORD_LIST_CHECK => FALSE,
DO_ONLY_FIXES => FALSE,
DO_FIXES_ANYWAY => FALSE,
USE_PREFIXES => TRUE,
USE_SUFFIXES => TRUE,
USE_TACKONS => TRUE,
DO_MEDIEVAL_TRICKS => TRUE,
DO_SYNCOPE => TRUE,
DO_TWO_WORDS => TRUE,
INCLUDE_UNKNOWN_CONTEXT => TRUE,
NO_MEANINGS => FALSE,
OMIT_ARCHAIC => TRUE,
OMIT_MEDIEVAL => FALSE,
OMIT_UNCOMMON => TRUE,
DO_I_FOR_J => FALSE,
DO_U_FOR_V => FALSE,
PAUSE_IN_SCREEN_OUTPUT => TRUE,
NO_SCREEN_ACTIVITY => FALSE,
UPDATE_LOCAL_DICTIONARY => FALSE,
UPDATE_MEANINGS => FALSE,
MINIMIZE_OUTPUT => TRUE );
BAD_MDEV_FILE : exception;
--HAVE_DEBUG_FILE_HELP : constant HELP_TYPE := (
-- "This option instructs the program to create a file which can hold ",
-- "certain internal information about the current search. The file is ",
-- "overwritten for every word in order to prevent it from growing out of ",
-- "hand, so information about the last word searched is saved in case of ",
-- "failure. The debug output file is named " & DEBUG_FULL_NAME
-- & (42+DEBUG_FULL_NAME'LENGTH..70 => ' '),
-- "Use of this option, along with the WRITE_DEBUG_FILE option may slow ",
-- "the program significantly. This information is usually only useful ",
-- "to the developer, so the default is N(o). " );
--
--WRITE_DEBUG_FILE_HELP : constant HELP_TYPE := (
-- "This option instructs the program, when HAVE_DEBUG_FILE is on, to put ",
-- "some debug data to a file named " & DEBUG_FULL_NAME
-- & (33+DEBUG_FULL_NAME'LENGTH..70 => ' '),
-- "This option may be turned on and off while running of the program, ",
-- "thereby capturing only certain desired results. The file is reset and",
-- "restarted after each word parsed, so that it does not get too big. ",
-- "If the option HAVE_DEBUG_FILE is off, the user will not be given a ",
-- "chance to turn this one on. Default is N(o). " );
--
HAVE_STATISTICS_FILE_HELP : constant HELP_TYPE := (
"This option instructs the program to create a file which can hold ",
"certain statistical information about the process. The file is ",
"overwritten for new invocation of the program, so old data must be ",
"explicitly saved if it is to be retained. The statistics are in TEXT ",
"format. The statistics file is named " & STATS_FULL_NAME
& (42+STATS_FULL_NAME'LENGTH..70 => ' '),
"This information is only of development use, so the default is N(o). " );
WRITE_STATISTICS_FILE_HELP : constant HELP_TYPE := (
"This option instructs the program, with HAVE_STATISTICS_FILE, to put ",
"derived statistics in a file named " & STATS_FULL_NAME
& (36+STATS_FULL_NAME'LENGTH..70 => ' '),
"This option may be turned on and off while running of the program, ",
"thereby capturing only certain desired results. The file is reset at ",
"each invocation of the program, if the HAVE_STATISTICS_FILE is set. ",
"If the option HAVE_STATISTICS_FILE is off, the user will not be given ",
"a chance to turn this one on. Default is N(o). " );
SHOW_DICTIONARY_HELP : constant HELP_TYPE := (
"This option causes a flag, like 'GEN>' to be put before the meaning ",
"in the output. While this is useful for certain development purposes,",
"it forces off a few characters from the meaning, and is really of no ",
"interest to most users. ",
"The default choice is N(o), but it can be turned on with a Y(es). " );
SHOW_DICTIONARY_LINE_HELP : constant HELP_TYPE := (
"This option causes the number of the dictionary line for the current ",
"meaning to be output. This is of use to no one but the dictionary ",
"maintainer. The default choice is N(o). It is activated by Y(es). ");
SHOW_DICTIONARY_CODES_HELP : constant HELP_TYPE := (
"This option causes the codes for the dictionary entry for the current ",
"meaning to be output. This may not be useful to any but the most ",
"involved user. The default choice is N(o). It is activated by Y(es).");
DO_PEARSE_CODES_HELP : constant HELP_TYPE := (
"This option causes special codes to be output flagging the different ",
"kinds of output lines. 01 for forms, 02 for dictionary forms, and ",
"03 for meaning. The default choice is N(o). It is activated by Y(es).",
"There are no Pearse codes in English mode. ");
DO_ONLY_INITIAL_WORD_HELP : constant HELP_TYPE := (
"This option instructs the program to only analyze the initial word on ",
"each line submitted. This is a tool for checking and integrating new ",
"dictionary input, and will be of no interest to the general user. ",
"The default choice is N(o), but it can be turned on with a Y(es). " );
FOR_WORD_LIST_CHECK_HELP : constant HELP_TYPE := (
"This option works in conjunction with DO_ONLY_INITIAL_WORD to allow ",
"the processing of scanned dictionarys or text word lists. It accepts ",
"only the forms common in dictionary entries, like NOM S for N or ADJ, ",
"or PRES ACTIVE IND 1 S for V. It is be used only with DO_INITIAL_WORD",
"The default choice is N(o), but it can be turned on with a Y(es). " );
DO_ONLY_FIXES_HELP : constant HELP_TYPE := (
"This option instructs the program to ignore the normal dictionary ",
"search and to go direct to attach various prefixes and suffixes before",
"processing. This is a pure research tool. It allows one to examine ",
"the coverage of pure stems and dictionary primary compositions. ",
"This option is only available if DO_FIXES is turned on. ",
"This is entirely a development and research tool, not to be used in ",
"conventional translation situations, so the default choice is N(o). ",
"This processing can be turned on with the choice of Y(es). " );
DO_FIXES_ANYWAY_HELP : constant HELP_TYPE := (
"This option instructs the program to do both the normal dictionary ",
"search and then process for the various prefixes and suffixes too. ",
"This is a pure research tool allowing one to consider the possibility ",
"of strange constructions, even in the presence of conventional ",
"results, e.g., alte => deeply (ADV), but al+t+e => wing+ed (ADJ VOC) ",
"(If multiple suffixes were supported this could also be wing+ed+ly.) ",
"This option is only available if DO_FIXES is turned on. ",
"This is entirely a development and research tool, not to be used in ",
"conventional translation situations, so the default choice is N(o). ",
"This processing can be turned on with the choice of Y(es). ",
" ------ PRESENTLY NOT IMPLEMENTED ------ " );
USE_PREFIXES_HELP : constant HELP_TYPE := (
"This option instructs the program to implement prefixes from ADDONS ",
"whenever and wherever FIXES are called for. The purpose of this ",
"option is to allow some flexibility while the program in running to ",
"select various combinations of fixes, to turn them on and off, ",
"individually as well as collectively. This is an option usually ",
"employed by the developer while experimenting with the ADDONS file. ",
"This option is only effective in connection with DO_FIXES. ",
"This is primarily a development tool, so the conventional user should ",
"probably maintain the default choice of Y(es). " );
USE_SUFFIXES_HELP : constant HELP_TYPE := (
"This option instructs the program to implement suffixes from ADDONS ",
"whenever and wherever FIXES are called for. The purpose of this ",
"option is to allow some flexibility while the program in running to ",
"select various combinations of fixes, to turn them on and off, ",
"individually as well as collectively. This is an option usually ",
"employed by the developer while experimenting with the ADDONS file. ",
"This option is only effective in connection with DO_FIXES. ",
"This is primarily a development tool, so the conventional user should ",
"probably maintain the default choice of Y(es). " );
USE_TACKONS_HELP : constant HELP_TYPE := (
"This option instructs the program to implement TACKONS from ADDONS ",
"whenever and wherever FIXES are called for. The purpose of this ",
"option is to allow some flexibility while the program in running to ",
"select various combinations of fixes, to turn them on and off, ",
"individually as well as collectively. This is an option usually ",
"employed by the developer while experimenting with the ADDONS file. ",
"This option is only effective in connection with DO_FIXES. ",
"This is primarily a development tool, so the conventional user should ",
"probably maintain the default choice of Y(es). " );
DO_MEDIEVAL_TRICKS_HELP : constant HELP_TYPE := (
"This option instructs the program, when it is unable to find a proper ",
"match in the dictionary, and after various prefixes and suffixes, and ",
"tring every Classical Latin trick it can think of, to go to a few that",
"are usually only found in medieval Latin, replacements of caul -> col,",
"st -> est, z -> di, ix -> is, nct -> nt. It also tries some things ",
"like replacing doubled consonants in classical with a single one. ",
"Together these tricks are useful, but may give false positives (>20%).",
"This option is only available if the general DO_TRICKS is chosen. ",
"If the text is late or medieval, this option is much more useful than ",
"tricks for classical. The dictionary can never contain all spelling ",
"variations found in medieval Latin, but some constructs are common. ",
"The default choice is N(o), since the results are iffy, medieval only,",
"and expensive. This processing is turned on with the choice of Y(es)." );
DO_SYNCOPE_HELP : constant HELP_TYPE := (
"This option instructs the program to postulate that syncope of ",
"perfect stem verbs may have occured (e.g, aver -> ar in the perfect), ",
"and to try various possibilities for the insertion of a removed 'v'. ",
"To do this it has to fully process the modified candidates, which can ",
"have a consderable impact on the speed of processind a large file. ",
"However, this trick seldom producesa false positive, and syncope is ",
"very common in Latin (first year texts excepted). Default is Y(es). ",
"This processing is turned off with the choice of N(o). " );
DO_TWO_WORDS_HELP : constant HELP_TYPE := (
"There are some few common Lain expressions that combine two inflected ",
"words (e.g. respublica, paterfamilias). There are numerous examples ",
"of numbers composed of two words combined together. ",
"Sometimes a text or inscription will have words run together. ",
"When WORDS is unable to reach a satisfactory solution with all other ",
"tricks, as a last stab it will try to break the input into two words. ",
"This most often fails. Even if mechnically successful, the result is ",
"usually false and must be examined by the user. If the result is ",
"correct, it is probably clear to the user. Otherwise, beware. . ",
"Since this is a last chanceand infrequent, the default is Y(es); ",
"This processing is turned off with the choice of N(o). " );
INCLUDE_UNKNOWN_CONTEXT_HELP : constant HELP_TYPE := (
"This option instructs the program, when writing to an UNKNOWNS file, ",
"to put out the whole context of the UNKNOWN (the whole input line on ",
"which the UNKNOWN was found). This is appropriate for processing ",
"large text files in which it is expected that there will be relatively",
"few UNKNOWNS. The main use at the moment is to provide display ",
"of the input line on the output file in the case of UNKNOWNS_ONLY. ");
NO_MEANINGS_HELP : constant HELP_TYPE := (
"This option instructs the program to omit putting out meanings. ",
"This is only useful for certain dictionary maintenance procedures. ",
"The combination not DO_DICTIONARY_FORMS, MEANINGS_ONLY, NO_MEANINGS ",
"results in no visible output, except spacing lines. Default is N)o.");
OMIT_ARCHAIC_HELP : constant HELP_TYPE := (
"THIS OPTION IS CAN ONLY BE ACTIVE IF WORDS_MODE(TRIM_OUTPUT) IS SET! ",
"This option instructs the program to omit inflections and dictionary ",
"entries with an AGE code of A (Archaic). Archaic results are rarely ",
"of interest in general use. If there is no other possible form, then ",
"the Archaic (roughly defined) will be reported. The default is Y(es)." );
OMIT_MEDIEVAL_HELP : constant HELP_TYPE := (
"THIS OPTION IS CAN ONLY BE ACTIVE IF WORDS_MODE(TRIM_OUTPUT) IS SET! ",
"This option instructs the program to omit inflections and dictionary ",
"entries with AGE codes of E or later, those not in use in Roman times.",
"While later forms and words are a significant application, most users ",
"will not want them. If there is no other possible form, then the ",
"Medieval (roughly defined) will be reported. The default is Y(es). " );
OMIT_UNCOMMON_HELP : constant HELP_TYPE := (
"THIS OPTION IS CAN ONLY BE ACTIVE IF WORDS_MODE(TRIM_OUTPUT) IS SET! ",
"This option instructs the program to omit inflections and dictionary ",
"entries with FREQ codes indicating that the selection is uncommon. ",
"While these forms area significant feature of the program, many users ",
"will not want them. If there is no other possible form, then the ",
"uncommon (roughly defined) will be reported. The default is Y(es). " );
DO_I_FOR_J_HELP : constant HELP_TYPE := (
"This option instructs the program to modify the output so that the j/J",
"is represented as i/I. The consonant i was writen as j in cursive in ",
"Imperial times and called i longa, and often rendered as j in medieval",
"times. The capital is usually rendered as I, as in inscriptions. ",
"If this is NO/FALSE, the output will have the same character as input.",
"The program default, and the dictionary convention is to retain the j.",
"Reset if this ia unsuitable for your application. The default is N(o)." );
DO_U_FOR_V_HELP : constant HELP_TYPE := (
"This option instructs the program to modify the output so that the u ",
"is represented as v. The consonant u was writen sometimes as uu. ",
"The pronounciation was as current w, and important for poetic meter. ",
"With the printing press came the practice of distinguishing consonant ",
"u with the character v, and was common for centuries. The practice of",
"using only u has been adopted in some 20th century publications (OLD),",
" but it is confusing to many modern readers. The capital is commonly ",
"V in any case, as it was and is in inscriptions (easier to chisel). ",
"If this is NO/FALSE, the output will have the same character as input.",
"The program default, and the dictionary convention is to retain the v.",
"Reset If this ia unsuitable for your application. The default is N(o)." );
PAUSE_IN_SCREEN_OUTPUT_HELP : constant HELP_TYPE := (
"This option instructs the program to pause in output on the screen ",
"after about 16 lines so that the user can read the output, otherwise ",
"it would just scroll off the top. A RETURN/ENTER gives another page. ",
"If the program is waiting for a return, it cannot take other input. ",
"This option is active only for keyboard entry or command line input, ",
"and only when there is no output file. It is moot if only single word",
"input or brief output. The default is Y(es). " );
NO_SCREEN_ACTIVITY_HELP : constant HELP_TYPE := (
"This option instructs the program not to keep a running screen of the ",
"input. This is probably only to be used by the developer to calibrate",
"run times for large text file input, removing the time necessary to ",
"write to screen. The default is N(o). ");
UPDATE_LOCAL_DICTIONARY_HELP : constant HELP_TYPE := (
"This option instructs the program to invite the user to input a new ",
"word to the local dictionary on the fly. This is only active if the ",
"program is not using an (@) input file! If an UNKNOWN is discovered, ",
"the program asks for STEM, PART, and MEAN, the basic elements of a ",
"dictionary entry. These are put into the local dictionary right then,",
"and are available for the rest of the session, and all later sessions.",
"The use of this option requires a detailed knowledge of the structure ",
"of dictionary entries, and is not for the average user. If the entry ",
"is not valid, reloading the dictionary will raise and exception, and ",
"the invalid entry will be rejected, but the program will continue ",
"without that word. Any invalid entries can be corrected or deleted ",
"off-line with a text editor on the local dictionary file. If one does",
"not want to enter a word when this option is on, a simple RETURN at ",
"the STEM=> prompt will ignore and continue the program. This option ",
"is only for very experienced users and should normally be off. ",
" The default is N(o). ",
" ------ NOT AVAILABLE IN THIS VERSION ------- " );
UPDATE_MEANINGS_HELP : constant HELP_TYPE := (
"This option instructs the program to invite the user to modify the ",
"meaning displayed on a word translation. This is only active if the ",
"program is not using an (@) input file! These changes are put into ",
"the dictionary right then and permenently, and are available from ",
"then on, in this session, and all later sessions. Unfortunately, ",
"these changes will not survive the replacement of the dictionary by a ",
"new version from the developer. Changes can only be recovered by ",
"considerable prcessing by the deneloper, and should be left there. ",
"This option is only for experienced users and should remain off. ",
" The default is N(o). ",
" ------ NOT AVAILABLE IN THIS VERSION ------- " );
MINIMIZE_OUTPUT_HELP : constant HELP_TYPE := (
"This option instructs the program to minimize the output. This is a ",
"somewhat flexible term, but the use of this option will probably lead ",
"to less output. The default is Y(es). " );
SAVE_PARAMETERS_HELP : constant HELP_TYPE := (
"This option instructs the program, to save the current parameters, as ",
"just established by the user, in a file WORD.MDV. If such a file ",
"exists, the program will load those parameters at the start. If no ",
"such file can be found in the current subdirectory, the program will ",
"start with a default set of parameters. Since this parameter file is ",
"human-readable ASCII, it may also be created with a text editor. If ",
"the file found has been improperly created, is in the wrong format, or",
"otherwise uninterpretable by the program, it will be ignored and the ",
"default parameters used, until a proper parameter file in written by ",
"the program. Since one may want to make temporary changes during a ",
"run, but revert to the usual set, the default is N(o). " );
procedure PUT(HELP : HELP_TYPE) is
begin
NEW_LINE;
for I in HELP'FIRST..HELP'LAST loop
PUT_LINE(HELP(I));
end loop;
NEW_LINE;
end PUT;
procedure UPDATE_LOCAL_DICTIONARY_FILE is
use TEXT_IO;
BLANK_LINE : STRING(1..80) := (others => ' ');
LINE, STEM_LINE, PART_LINE, MEAN_LINE : STRING(1..80) := BLANK_LINE;
L, SL, PL, ML : INTEGER := 0; -- SL BAD NAME !!!!!!!!!!!
--DICT_LOC : DICTIONARY; -- Def in LINE_STUFF
DICT_LOC_FILE : FILE_TYPE;
DUMMY : FILE_TYPE;
-- Omit when put name here
DICT_LOC_NAME : constant STRING :=
ADD_FILE_NAME_EXTENSION(DICTIONARY_FILE_NAME, "LOCAL");
procedure READY_DICT_LOC_FILE is
-- Effectively goes to the end of DICT_LOC to ready for appending
-- Does this by making a new file and writing the old DICT_LOC into it
-- If there is not already a DICT_LOC, it creates one
begin
OPEN(DICT_LOC_FILE, IN_FILE, DICT_LOC_NAME);
CREATE(DUMMY, OUT_FILE);
while not END_OF_FILE(DICT_LOC_FILE) loop
GET_LINE(DICT_LOC_FILE, LINE, L);
PUT_LINE(DUMMY, LINE(1..L));
end loop;
RESET(DUMMY, IN_FILE);
DELETE(DICT_LOC_FILE); -- Might RESET, but environment might not support
CREATE(DICT_LOC_FILE, OUT_FILE, DICT_LOC_NAME);
while not END_OF_FILE(DUMMY) loop
GET_LINE(DUMMY, LINE, L);
PUT_LINE(DICT_LOC_FILE, LINE(1..L));
end loop;
DELETE(DUMMY);
exception
when NAME_ERROR =>
CREATE(DICT_LOC_FILE, OUT_FILE, DICT_LOC_NAME);
end READY_DICT_LOC_FILE;
procedure APPEND_TO_DICT_LOC_FILE is
-- This just appends the 3 lines of a dictionary entry to DICT_LOC
-- It prepares the file to write at the end, writes, then closes it
begin
READY_DICT_LOC_FILE;
PUT_LINE(DICT_LOC_FILE, STEM_LINE(1..SL)); -- SL bad name
PUT(DICT_LOC_FILE, PART_LINE(1..PL));
PUT_LINE(DICT_LOC_FILE, " X X X X X ");
PUT_LINE(DICT_LOC_FILE, MEAN_LINE(1..ML));
CLOSE(DICT_LOC_FILE);
end APPEND_TO_DICT_LOC_FILE;
begin
loop
TEXT_IO.PUT("STEMS =>");
GET_LINE(STEM_LINE, SL);
if SL > 0 then -- if no input for stems, then just skip the entry
TEXT_IO.PUT("PART =>");
GET_LINE(PART_LINE, PL);
TEXT_IO.PUT("MEAN =>");
GET_LINE(MEAN_LINE, ML);
else
exit; -- on no entry, just CR
end if;
begin
APPEND_TO_DICT_LOC_FILE;
DICT_LOC := NULL_DICTIONARY;
LOAD_DICTIONARY(DICT_LOC,
ADD_FILE_NAME_EXTENSION(DICTIONARY_FILE_NAME, "LOCAL"));
-- Need to carry LOC through consistently on LOAD_D and LOAD_D_FILE
LOAD_STEM_FILE(LOCAL);
DICTIONARY_AVAILABLE(LOCAL) := TRUE;
exit; -- If everything OK, otherwise loop back and try again
end;
end loop;
end UPDATE_LOCAL_DICTIONARY_FILE;
procedure PUT_MDEVS is
use MDEV_TYPE_IO;
use REPLY_TYPE_IO;
begin
if IS_OPEN(MDEV_FILE) then
CLOSE(MDEV_FILE);
end if;
CREATE(MDEV_FILE, OUT_FILE, MDEV_FULL_NAME);
for I in WORDS_MDEV'RANGE loop
PUT(MDEV_FILE, I);
SET_COL(MDEV_FILE, 35);
PUT(MDEV_FILE, REPLY(WORDS_MDEV(I)));
NEW_LINE(MDEV_FILE);
end loop;
PUT(MDEV_FILE, "START_FILE_CHARACTER '" &
START_FILE_CHARACTER &"'"); NEW_LINE(MDEV_FILE);
PUT(MDEV_FILE, "CHANGE_PARAMETERS_CHARACTER '" &
CHANGE_PARAMETERS_CHARACTER &"'"); NEW_LINE(MDEV_FILE);
PUT(MDEV_FILE, "CHANGE_DEVELOPER_MODES_CHARACTER '" &
CHANGE_DEVELOPER_MODES_CHARACTER &"'"); NEW_LINE(MDEV_FILE);
CLOSE(MDEV_FILE);
end PUT_MDEVS;
procedure GET_MDEVS is
use MDEV_TYPE_IO;
use REPLY_TYPE_IO;
MO : MDEV_TYPE;
REP : REPLY_TYPE;
LINE : STRING(1..100) := (others => ' ');
LAST : INTEGER := 0;
begin
OPEN(MDEV_FILE, IN_FILE, MDEV_FULL_NAME);
for I in WORDS_MDEV'RANGE loop
GET(MDEV_FILE, MO);
GET(MDEV_FILE, REP);
WORDS_MDEV(MO) := MDEV_OF_REPLY(REP);
end loop;
SKIP_LINE(MDEV_FILE);
GET_LINE(MDEV_FILE, LINE, LAST);
if LINE(1..20) = "START_FILE_CHARACTER" then
if ((LINE(35) in '!'..'/') or
(LINE(35) in ':'..'@') or
(LINE(35) in '['..'`') or
(LINE(35) in '{'..'~')) and
(LINE(35) /= CHANGE_PARAMETERS_CHARACTER) and
(LINE(35) /= CHANGE_DEVELOPER_MODES_CHARACTER) then
START_FILE_CHARACTER := LINE(35);
else
PUT_LINE("Not an acceptable START_FILE_CHARACTER, may conflict");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
else
raise BAD_MDEV_FILE;
end if;
GET_LINE(MDEV_FILE, LINE, LAST);
if LINE(1..27) = "CHANGE_PARAMETERS_CHARACTER" then
if ((LINE(35) in '!'..'/') or
(LINE(35) in ':'..'@') or
(LINE(35) in '['..'`') or
(LINE(35) in '{'..'~')) and
(LINE(35) /= START_FILE_CHARACTER) and
(LINE(35) /= CHANGE_DEVELOPER_MODES_CHARACTER) then
CHANGE_PARAMETERS_CHARACTER := LINE(35);
else
PUT_LINE("Not an acceptable CHANGE_PARAMETERS_CHARACTER, may conflict");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
else
raise BAD_MDEV_FILE;
end if;
GET_LINE(MDEV_FILE, LINE, LAST);
if LINE(1..32) = "CHANGE_DEVELOPER_MODES_CHARACTER" then
if ((LINE(35) in '!'..'/') or
(LINE(35) in ':'..'@') or
(LINE(35) in '['..'`') or
(LINE(35) in '{'..'~')) and
(LINE(35) /= START_FILE_CHARACTER) and
(LINE(35) /= CHANGE_PARAMETERS_CHARACTER) then
CHANGE_DEVELOPER_MODES_CHARACTER := LINE(35);
else
PUT_LINE("Not an acceptable CHANGE_DEVELOPER_MODES_CHARACTER, may conflict");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
else
raise BAD_MDEV_FILE;
end if;
CLOSE(MDEV_FILE);
exception
when NAME_ERROR =>
raise;
when others =>
raise BAD_MDEV_FILE;
end GET_MDEVS;
procedure INQUIRE(MO : MDEV_TYPE; HELP : in HELP_TYPE := NO_HELP) is
use MDEV_TYPE_IO;
use REPLY_TYPE_IO;
L1 : STRING(1..100);
LL : NATURAL;
R : REPLY_TYPE;
begin
PUT(MO);
PUT(" ? "); SET_COL(45); PUT("(Currently ");
PUT(REPLY(WORDS_MDEV(MO))); PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if TRIM(L1(1..LL)) = "" then
PUT_LINE("Blank input, skipping the rest of CHANGE_DEVELOPER_MODES");
raise BLANK_INPUT;
elsif L1(1) = '?' then
PUT(HELP);
INQUIRE(MO, HELP);
else
GET(L1(1..LL), R, LL);
WORDS_MDEV(MO) := MDEV_OF_REPLY(R);
end if;
end if;
NEW_LINE;
end INQUIRE;
procedure CHANGE_DEVELOPER_MODES is
L1 : STRING(1..100);
LL : NATURAL;
R : REPLY_TYPE;
begin
PUT_LINE("To set developer modes reply Y/y or N/n. Return accepts current value.");
PUT_LINE("A '?' reply gives infomation/help on that parameter. A space skips the rest.");
PUT_LINE("Developer modes are only for special requirements and may not all be operable.");
NEW_LINE;
-- Interactive MDEV - lets you do things on unknown words
-- You can say it is a noun and then look at the endings
-- Or look all the endings and guess what part of speech
-- You can look at the dictionary items that are close to the word
-- There may be cases in which the stem is found but is not of right part
-- So maybe the word list is deficient and that root goes also to a ADJ
-- even if it is listed only for a N.
-- One can also look for ADV here with ending 'e', etc.
-- You can look up the word in a paper dictionary (with the help of ending)
-- And then enter the word into DICT.LOC, so it will hit next time
-- All unknowns could be recorded in a file for later reference
-- A '?' gives information (help) about the item in question
-- One can change the symbol that the main program uses for change and file
-- One can save the new parameters or let them revert to previous
-- There should be a basic set of parameters that one can always go to
-- There should be moods of translation, maybe to switch dictionaries
-- Maybe to turn on or off pre/suffix
-- Maybe to allow the user to look at just all the prefixes that match
-- INQUIRE(HAVE_DEBUG_FILE, HAVE_DEBUG_FILE_HELP);
-- if IS_OPEN(DBG) and then not WORDS_MDEV(HAVE_DEBUG_FILE) then
-- DELETE(DBG);
-- WORDS_MDEV(WRITE_DEBUG_FILE) := FALSE;
-- end if;
-- if not IS_OPEN(DBG) and then WORDS_MDEV(HAVE_DEBUG_FILE) then
-- begin
-- CREATE(DBG, OUT_FILE, DEBUG_FULL_NAME);
-- exception
-- when others =>
-- PUT_LINE("Cannot CREATE WORD.DBG - Check if it is in use elsewhere");
-- end;
-- end if;
--
-- if WORDS_MDEV(HAVE_DEBUG_FILE) then
-- INQUIRE(WRITE_DEBUG_FILE, WRITE_DEBUG_FILE_HELP);
-- end if;
INQUIRE(HAVE_STATISTICS_FILE, HAVE_STATISTICS_FILE_HELP);
if IS_OPEN(STATS) and then not WORDS_MDEV(HAVE_STATISTICS_FILE) then
DELETE(STATS);
WORDS_MDEV(WRITE_STATISTICS_FILE) := FALSE;
end if;
if not IS_OPEN(STATS) and then WORDS_MDEV(HAVE_STATISTICS_FILE) then
begin
CREATE(STATS, OUT_FILE, STATS_FULL_NAME);
exception
when others =>
PUT_LINE("Cannot CREATE WORD.STA - Check if it is in use elsewhere");
end;
end if;
if WORDS_MDEV(HAVE_STATISTICS_FILE) then
INQUIRE(WRITE_STATISTICS_FILE, WRITE_STATISTICS_FILE_HELP);
end if;
INQUIRE(DO_ONLY_INITIAL_WORD, DO_ONLY_INITIAL_WORD_HELP);
if WORDS_MDEV(DO_ONLY_INITIAL_WORD) then
INQUIRE(FOR_WORD_LIST_CHECK, FOR_WORD_LIST_CHECK_HELP);
else
WORDS_MDEV(FOR_WORD_LIST_CHECK) := FALSE;
end if;
INQUIRE(SHOW_DICTIONARY, SHOW_DICTIONARY_HELP);
INQUIRE(SHOW_DICTIONARY_LINE, SHOW_DICTIONARY_LINE_HELP);
INQUIRE(SHOW_DICTIONARY_CODES, SHOW_DICTIONARY_CODES_HELP);
INQUIRE(DO_PEARSE_CODES, DO_PEARSE_CODES_HELP);
if WORDS_MODE(DO_FIXES) then
INQUIRE(DO_ONLY_FIXES, DO_ONLY_FIXES_HELP);
INQUIRE(DO_FIXES_ANYWAY, DO_FIXES_ANYWAY_HELP);
end if;
INQUIRE(USE_PREFIXES, USE_PREFIXES_HELP);
INQUIRE(USE_SUFFIXES, USE_SUFFIXES_HELP);
INQUIRE(USE_TACKONS, USE_TACKONS_HELP);
if WORDS_MODE(DO_TRICKS) then
INQUIRE(DO_MEDIEVAL_TRICKS, DO_MEDIEVAL_TRICKS_HELP);
end if;
INQUIRE(DO_SYNCOPE, DO_SYNCOPE_HELP);
INQUIRE(DO_TWO_WORDS, DO_TWO_WORDS_HELP);
INQUIRE(INCLUDE_UNKNOWN_CONTEXT, INCLUDE_UNKNOWN_CONTEXT_HELP);
INQUIRE(NO_MEANINGS, NO_MEANINGS_HELP);
INQUIRE(OMIT_ARCHAIC, OMIT_ARCHAIC_HELP);
INQUIRE(OMIT_MEDIEVAL, OMIT_MEDIEVAL_HELP);
INQUIRE(OMIT_UNCOMMON, OMIT_UNCOMMON_HELP);
INQUIRE(DO_I_FOR_J, DO_I_FOR_J_HELP);
INQUIRE(DO_U_FOR_V, DO_U_FOR_V_HELP);
INQUIRE(PAUSE_IN_SCREEN_OUTPUT, PAUSE_IN_SCREEN_OUTPUT_HELP);
INQUIRE(NO_SCREEN_ACTIVITY, NO_SCREEN_ACTIVITY_HELP);
INQUIRE(UPDATE_LOCAL_DICTIONARY, UPDATE_LOCAL_DICTIONARY_HELP);
INQUIRE(UPDATE_MEANINGS, UPDATE_MEANINGS_HELP);
INQUIRE(MINIMIZE_OUTPUT, MINIMIZE_OUTPUT_HELP);
PUT("START_FILE_CHARACTER ? "); SET_COL(45); PUT("(Currently '");
PUT(START_FILE_CHARACTER); PUT("'");
PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if ((L1(1) in '!'..'/') or
(L1(1) in ':'..'@') or
(L1(1) in '['..'`') or
(L1(1) in '{'..'~')) and
(L1(1) /= CHANGE_PARAMETERS_CHARACTER) and
(L1(1) /= CHANGE_DEVELOPER_MODES_CHARACTER) then
START_FILE_CHARACTER := L1(1);
else
PUT_LINE("Not an acceptable character, may conflict with other input");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
end if;
NEW_LINE;
PUT("CHANGE_PARAMETERS_CHARACTER ? "); SET_COL(45); PUT("(Currently '");
PUT(CHANGE_PARAMETERS_CHARACTER); PUT("'");
PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if ((L1(1) in '!'..'/') or
(L1(1) in ':'..'@') or
(L1(1) in '['..'`') or
(L1(1) in '{'..'~')) and
(L1(1) /= START_FILE_CHARACTER) and
(L1(1) /= CHANGE_DEVELOPER_MODES_CHARACTER) then
CHANGE_PARAMETERS_CHARACTER := L1(1);
else
PUT_LINE("Not an acceptable character, may conflict with other input");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
end if;
NEW_LINE;
PUT("CHANGE_DEVELOPER_MODES_CHARACTER ? ");
SET_COL(45); PUT("(Currently '");
PUT(CHANGE_DEVELOPER_MODES_CHARACTER); PUT("'");
PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if ((L1(1) in '!'..'/') or
(L1(1) in ':'..'@') or
(L1(1) in '['..'`') or
(L1(1) in '{'..'~')) and
(L1(1) /= START_FILE_CHARACTER) and
(L1(1) /= CHANGE_LANGUAGE_CHARACTER) and
(L1(1) /= CHANGE_PARAMETERS_CHARACTER) then
CHANGE_DEVELOPER_MODES_CHARACTER := L1(1);
else
PUT_LINE("Not an acceptable character, may conflict with other input");
PUT_LINE("NO CHANGE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
end if;
end if;
NEW_LINE;
PUT("Do you wish to save this set of parameters? Y or N (Default) ");
PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if L1(1) = '?' then
PUT(SAVE_PARAMETERS_HELP);
PUT("Do you wish to save this set of parameters? Y or N (Default) ");
PUT(" =>");
GET_LINE(L1, LL);
end if;
REPLY_TYPE_IO.GET(L1(1..LL), R, LL);
if MDEV_OF_REPLY(R) then
PUT_MDEVS;
PUT_LINE("MDEV_ARRAY saved in file " & MDEV_FULL_NAME);
end if;
end if;
NEW_LINE;
exception
when BLANK_INPUT =>
null;
when others =>
PUT_LINE("Bad input - terminating CHANGE_DEVELOPER_PARAMETERS");
end CHANGE_DEVELOPER_MODES;
procedure INITIALIZE_DEVELOPER_PARAMETERS is
begin
DO_MDEV_FILE:
begin
-- Read the MDEV file
GET_MDEVS;
PREFACE.PUT_LINE("MDEV_FILE found - Using those MDEVs and parameters");
exception
-- If there is any problem
-- Put that the MDEV file is corrupted and the options are:
-- to proceed with default parameters
-- to set parameters with a CHANGE (SET) PARAMETERS and save
-- to examine the MDEV file with a text editor and try to repair it
when NAME_ERROR =>
WORDS_MDEV := DEFAULT_MDEV_ARRAY;
when BAD_MDEV_FILE =>
PREFACE.PUT_LINE("MDEV_FILE exists, but empty or corupted - Default MDEVs used");
PREFACE.PUT_LINE("You can set new parameters with CHANGE PARAMETERS and save.");
WORDS_MDEV := DEFAULT_MDEV_ARRAY;
end DO_MDEV_FILE;
-- if not IS_OPEN(DBG) and then WORDS_MDEV(HAVE_DEBUG_FILE) then
-- CREATE(DBG, OUT_FILE, DEBUG_FULL_NAME);
-- PREFACE.PUT_LINE("WORD.DBG Created at Initialization");
-- end if;
if not IS_OPEN(STATS) and then WORDS_MDEV(HAVE_STATISTICS_FILE) then
CREATE(STATS, OUT_FILE, STATS_FULL_NAME);
PREFACE.PUT_LINE("WORD.STA Created at Initialization");
end if;
end INITIALIZE_DEVELOPER_PARAMETERS;
end DEVELOPER_PARAMETERS;

91
developer_parameters.ads Normal file
View File

@@ -0,0 +1,91 @@
with TEXT_IO;
package DEVELOPER_PARAMETERS is
-- These are a few strange declarations to be used in diagnostics;
SRA_MAX, SRAA_MAX, DMA_MAX : INTEGER := 0;
PA_LAST_MAX, FINAL_PA_LAST_MAX : INTEGER := 0;
-- This package defines a number of parameters that areused in the program
-- The default values are set in the body, so that they may be changed easily
-- These files are used by the program if requested, but not necessary
-- They are all text files and human readable
-- DEVELOPER MODE_FILE is used by the program to remember values
MDEV_FILE : TEXT_IO.FILE_TYPE;
MDEV_FULL_NAME : constant STRING := "WORD.MDV";
-- Debug not currently in use
-- -- DBG collects debug output for one entry at a time
-- DBG : TEXT_IO.FILE_TYPE;
-- DEBUG_FULL_NAME : constant STRING := "WORD.DBG";
-- STATS collects statistics on the program, stems used, inflections, etc.
STATS : TEXT_IO.FILE_TYPE;
STATS_FULL_NAME : constant STRING := "WORD.STA";
type MDEV_TYPE is (
-- HAVE_DEBUG_FILE, -- No longer in use
-- WRITE_DEBUG_FILE,
HAVE_STATISTICS_FILE,
WRITE_STATISTICS_FILE,
SHOW_DICTIONARY,
SHOW_DICTIONARY_LINE,
SHOW_DICTIONARY_CODES,
DO_PEARSE_CODES,
DO_ONLY_INITIAL_WORD,
FOR_WORD_LIST_CHECK,
DO_ONLY_FIXES,
DO_FIXES_ANYWAY,
USE_PREFIXES,
USE_SUFFIXES,
USE_TACKONS,
DO_MEDIEVAL_TRICKS,
DO_SYNCOPE,
DO_TWO_WORDS,
INCLUDE_UNKNOWN_CONTEXT,
NO_MEANINGS,
OMIT_ARCHAIC,
OMIT_MEDIEVAL,
OMIT_UNCOMMON,
DO_I_FOR_J,
DO_U_FOR_V,
PAUSE_IN_SCREEN_OUTPUT,
NO_SCREEN_ACTIVITY,
UPDATE_LOCAL_DICTIONARY,
UPDATE_MEANINGS,
MINIMIZE_OUTPUT );
package MDEV_TYPE_IO is new TEXT_IO.ENUMERATION_IO(MDEV_TYPE);
type MDEV_ARRAY is array (MDEV_TYPE) of BOOLEAN;
WORDS_MDEV : MDEV_ARRAY; -- Initialized in body
START_FILE_CHARACTER : CHARACTER := '@';
CHANGE_DEVELOPER_MODES_CHARACTER : CHARACTER := '!';
procedure CHANGE_DEVELOPER_MODES;
procedure UPDATE_LOCAL_DICTIONARY_FILE;
procedure INITIALIZE_DEVELOPER_PARAMETERS;
end DEVELOPER_PARAMETERS;

666
dictionary_form.adb Normal file
View File

@@ -0,0 +1,666 @@
with TEXT_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
function DICTIONARY_FORM(DE : DICTIONARY_ENTRY) return STRING is
NULL_OX : constant STRING(1..24) := (others => ' ');
OX : array (1..4) of STRING (1..24) := (others => NULL_OX);
FORM : STRING(1..100) := (others => ' ');
FST: array (WHICH_TYPE range 1..5) of STRING(1..3) :=
("1st", "2nd", "3rd", "4th", "5th");
NOT_FOUND : exception;
function ADD(STEM, INFL : STRING) return STRING is
begin
return HEAD(TRIM(STEM) & TRIM(INFL), 24);
end ADD;
procedure ADD_UP(FACTOR : STRING) is
begin
FORM := HEAD(TRIM(FORM) & TRIM(FACTOR), 100);
end ADD_UP;
procedure ADD_TO(FACTOR : STRING) is
begin
FORM := HEAD(TRIM(FORM) & FACTOR, 100);
end ADD_TO;
begin
--DICTIONARY_ENTRY_IO.PUT(DE);
-- So I can call with a NULL_DICTIONARY_ENTRY and not bomb
if DE = NULL_DICTIONARY_ENTRY then
return "";
end if;
if (DE.PART.POFS = PREP) then
return TRIM(DE.STEMS(1)) & " " & PART_OF_SPEECH_TYPE'IMAGE(DE.PART.POFS) &
" " & CASE_TYPE'IMAGE(DE.PART.PREP.OBJ);
end if;
if DE.STEMS(2) = NULL_STEM_TYPE and
DE.STEMS(3) = NULL_STEM_TYPE and
DE.STEMS(4) = NULL_STEM_TYPE and not
(((DE.PART.POFS = N) and then (DE.PART.N.DECL.WHICH = 9)) or
((DE.PART.POFS = ADJ) and then
((DE.PART.ADJ.DECL.WHICH = 9) or
(DE.PART.ADJ.CO = COMP or DE.PART.ADJ.CO = SUPER)) ) or
((DE.PART.POFS = V) and then (DE.PART.V.CON = (9, 8))) or
((DE.PART.POFS = V) and then (DE.PART.V.CON = (9, 9))))
then
return TRIM(DE.STEMS(1)) & " " & PART_OF_SPEECH_TYPE'IMAGE(DE.PART.POFS);
-- For UNIQUES, CONJ, INTERJ, ...
end if;
if DE.PART.POFS = N then
if DE.PART.N.DECL.WHICH = 1 then
if DE.PART.N.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "a");
OX(2) := ADD(DE.STEMS(2), "ae");
elsif DE.PART.N.DECL.VAR = 6 then
OX(1) := ADD(DE.STEMS(1), "e");
OX(2) := ADD(DE.STEMS(2), "es");
elsif DE.PART.N.DECL.VAR = 7 then
OX(1) := ADD(DE.STEMS(1), "es");
OX(2) := ADD(DE.STEMS(2), "ae");
elsif DE.PART.N.DECL.VAR = 8 then
OX(1) := ADD(DE.STEMS(1), "as");
OX(2) := ADD(DE.STEMS(2), "ae");
end if;
elsif DE.PART.N.DECL.WHICH = 2 then
if DE.PART.N.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "um");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 4 then
if DE.PART.N.GENDER = N then
OX(1) := ADD(DE.STEMS(1), "um");
else
OX(1) := ADD(DE.STEMS(1), "us");
end if;
OX(2) := ADD(DE.STEMS(2), "(i)");
elsif DE.PART.N.DECL.VAR = 5 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "");
elsif DE.PART.N.DECL.VAR = 6 then
OX(1) := ADD(DE.STEMS(1), "os");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 7 then
OX(1) := ADD(DE.STEMS(1), "os");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 8 then
OX(1) := ADD(DE.STEMS(1), "on");
OX(2) := ADD(DE.STEMS(2), "i");
elsif DE.PART.N.DECL.VAR = 9 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "i");
end if;
elsif DE.PART.N.DECL.WHICH = 3 then
OX(1) := ADD(DE.STEMS(1), "");
if (DE.PART.N.DECL.VAR = 7) or
(DE.PART.N.DECL.VAR = 9) then
OX(2) := ADD(DE.STEMS(2), "os/is");
else
OX(2) := ADD(DE.STEMS(2), "is");
end if;
elsif DE.PART.N.DECL.WHICH = 4 then
if DE.PART.N.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "us");
elsif DE.PART.N.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "u");
OX(2) := ADD(DE.STEMS(2), "us");
elsif DE.PART.N.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "u");
end if;
elsif DE.PART.N.DECL.WHICH = 5 then
OX(1) := ADD(DE.STEMS(1), "es");
OX(2) := ADD(DE.STEMS(2), "ei");
elsif DE.PART.N.DECL = (9, 8) then
OX(1) := ADD(DE.STEMS(1), ".");
OX(2) := ADD(NULL_OX, "abb.");
elsif DE.PART.N.DECL = (9, 9) then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "undeclined");
else
raise NOT_FOUND;
end if; -- N
elsif DE.PART.POFS = PRON then
if DE.PART.PRON.DECL.WHICH = 1 then
raise NOT_FOUND;
elsif DE.PART.PRON.DECL.WHICH = 3 then
OX(1) := ADD(DE.STEMS(1), "ic");
OX(2) := ADD(DE.STEMS(1), "aec");
if DE.PART.PRON.DECL.VAR = 1 then
OX(3) := ADD(DE.STEMS(1), "oc");
elsif DE.PART.PRON.DECL.VAR = 2 then
OX(3) := ADD(DE.STEMS(1), "uc");
end if;
elsif DE.PART.PRON.DECL.WHICH = 4 then
if DE.PART.PRON.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "s");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(1), "d");
elsif DE.PART.PRON.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "dem");
OX(2) := ADD(DE.STEMS(2), "adem");
OX(3) := ADD(DE.STEMS(1), "dem");
end if;
elsif DE.PART.PRON.DECL.WHICH = 6 then
OX(1) := ADD(DE.STEMS(1), "e");
OX(2) := ADD(DE.STEMS(1), "a");
if DE.PART.PRON.DECL.VAR = 1 then
OX(3) := ADD(DE.STEMS(1), "ud");
elsif DE.PART.PRON.DECL.VAR = 2 then
OX(3) := ADD(DE.STEMS(1), "um");
end if;
elsif DE.PART.ADJ.DECL = (9, 8) then
OX(1) := ADD(DE.STEMS(1), ".");
OX(2) := ADD(NULL_OX, "abb.");
elsif DE.PART.PRON.DECL = (9, 9) then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "undeclined");
else
raise NOT_FOUND;
end if; -- PRON
elsif DE.PART.POFS = ADJ then
--TEXT_IO.NEW_LINE;
--DICTIONARY_ENTRY_IO.PUT(DE);
--TEXT_IO.NEW_LINE;
if DE.PART.ADJ.CO = COMP then
OX(1) := ADD(DE.STEMS(1), "or");
OX(2) := ADD(DE.STEMS(1), "or");
OX(3) := ADD(DE.STEMS(1), "us");
elsif DE.PART.ADJ.CO = SUPER then
OX(1) := ADD(DE.STEMS(1), "mus");
OX(2) := ADD(DE.STEMS(1), "ma");
OX(3) := ADD(DE.STEMS(1), "mum");
elsif DE.PART.ADJ.CO = POS then
if DE.PART.ADJ.DECL.WHICH = 1 then
if DE.PART.ADJ.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(2), "um");
elsif DE.PART.ADJ.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(2), "um");
elsif DE.PART.ADJ.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(2), "um (gen -ius)");
elsif DE.PART.ADJ.DECL.VAR = 4 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(2), "um");
elsif DE.PART.ADJ.DECL.VAR = 5 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "a");
OX(3) := ADD(DE.STEMS(2), "ud");
else
raise NOT_FOUND;
end if;
elsif DE.PART.ADJ.DECL.WHICH = 2 then
if DE.PART.ADJ.DECL.VAR = 1 then
OX(1) := ADD(NULL_OX, "-");
OX(2) := ADD(DE.STEMS(1), "e");
OX(3) := ADD(NULL_OX, "-");
elsif DE.PART.ADJ.DECL.VAR = 2 then
OX(1) := ADD(NULL_OX, "-");
OX(2) := ADD(NULL_OX, "a");
OX(3) := ADD(NULL_OX, "-");
elsif DE.PART.ADJ.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "es");
OX(2) := ADD(DE.STEMS(1), "es");
OX(3) := ADD(DE.STEMS(1), "es");
elsif DE.PART.ADJ.DECL.VAR = 6 then
OX(1) := ADD(DE.STEMS(1), "os");
OX(2) := ADD(DE.STEMS(1), "os");
OX(3) := ADD(NULL_OX, "-");
elsif DE.PART.ADJ.DECL.VAR = 7 then
OX(1) := ADD(DE.STEMS(1), "os");
OX(2) := ADD(NULL_OX, "-");
OX(3) := ADD(NULL_OX, "-");
elsif DE.PART.ADJ.DECL.VAR = 8 then
OX(1) := ADD(NULL_OX, "-");
OX(2) := ADD(NULL_OX, "-");
OX(3) := ADD(DE.STEMS(2), "on");
end if;
elsif DE.PART.ADJ.DECL.WHICH = 3 then
if DE.PART.ADJ.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "(gen.)");
OX(3) := ADD(DE.STEMS(2), "is");
elsif DE.PART.ADJ.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "is");
OX(2) := ADD(DE.STEMS(2), "is");
OX(3) := ADD(DE.STEMS(2), "e");
elsif DE.PART.ADJ.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "is");
OX(3) := ADD(DE.STEMS(2), "e");
elsif DE.PART.ADJ.DECL.VAR = 6 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "(gen.)");
OX(3) := ADD(DE.STEMS(2), "os");
end if;
elsif DE.PART.ADJ.DECL = (9, 8) then
OX(1) := ADD(DE.STEMS(1), ".");
OX(2) := ADD(NULL_OX, "abb.");
elsif DE.PART.ADJ.DECL = (9, 9) then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "undeclined");
else
raise NOT_FOUND;
end if;
elsif DE.PART.ADJ.CO = X then
if DE.PART.ADJ.DECL.WHICH = 1 then
if DE.PART.ADJ.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(2), "a -um");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
elsif DE.PART.ADJ.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "a -um");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
end if;
elsif DE.PART.ADJ.DECL.WHICH = 3 then
if DE.PART.ADJ.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "is (gen.)");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
elsif DE.PART.ADJ.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "is");
OX(2) := ADD(DE.STEMS(2), "e");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
elsif DE.PART.ADJ.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "is -e");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
end if;
elsif DE.PART.ADJ.DECL.WHICH = 9 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "undeclined");
OX(3) := ADD(DE.STEMS(3), "or -or -us");
OX(4) := ADD(DE.STEMS(4), "mus -a -um");
else
raise NOT_FOUND;
end if;
else
raise NOT_FOUND;
end if;
elsif (DE.PART.POFS = ADV) and then (DE.PART.ADV.CO = X) then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "");
OX(3) := ADD(DE.STEMS(3), "");
elsif DE.PART.POFS = V then
if DE.PART.V.KIND = DEP then -- all DEP
OX(3) := ADD(NULL_OX, "DEP"); -- Flag for later use
OX(4) := ADD(DE.STEMS(4), "us sum");
if DE.PART.V.CON.WHICH = 1 then
OX(1) := ADD(DE.STEMS(1), "or");
OX(2) := ADD(DE.STEMS(2), "ari");
elsif DE.PART.V.CON.WHICH = 2 then
OX(1) := ADD(DE.STEMS(1), "eor");
OX(2) := ADD(DE.STEMS(2), "eri");
elsif DE.PART.V.CON.WHICH = 3 then
OX(1) := ADD(DE.STEMS(1), "or");
-- Would be wrong for 3 3, but no 3 3 DEP
if DE.PART.V.CON.VAR = 4 then
OX(2) := ADD(DE.STEMS(2), "iri");
else
OX(2) := ADD(DE.STEMS(2), "i");
end if;
-- elsif DE.PART.V.CON.WHICH = 4 then -- 4th amy be 3,4 or 4,1
-- OX(1) := ADD(DE.STEMS(1), "or"); -- depending on where in code
-- OX(2) := ADD(DE.STEMS(2), "iri"); -- In practice there is no problem
else
raise NOT_FOUND;
end if; -- all DEP handled
elsif DE.PART.V.KIND = PERFDEF then -- all PERFDEF handled
OX(1) := ADD(DE.STEMS(3), "i");
OX(2) := ADD(DE.STEMS(3), "isse");
OX(3) := ADD(DE.STEMS(4), "us");
OX(4) := NULL_OX; -- Flag for later use
elsif DE.PART.V.KIND = IMPERS and then
((DE.STEMS(1)(1..3) = "zzz") and -- Recognize as PERFDEF IMPERS
(DE.STEMS(2)(1..3) = "zzz")) then
OX(1) := ADD(DE.STEMS(3), "it");
OX(2) := ADD(DE.STEMS(3), "isse");
OX(3) := ADD(DE.STEMS(4), "us est");
-- OX(4) := ADD(NULL_OX, "PERFDEF");
else -- Not DEP/PERFDEF/IMPERS
if DE.PART.V.KIND = IMPERS then
if DE.PART.V.CON.WHICH = 1 then
OX(1) := ADD(DE.STEMS(1), "at");
elsif DE.PART.V.CON.WHICH = 2 then
OX(1) := ADD(DE.STEMS(1), "et");
elsif DE.PART.V.CON.WHICH = 3 then
if DE.PART.V.CON.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "t");
else
if DE.STEMS(1)(TRIM(DE.STEMS(1))'LAST) = 'i' then
OX(1) := ADD(DE.STEMS(1), "t");
else
OX(1) := ADD(DE.STEMS(1), "it");
end if;
end if;
elsif DE.PART.V.CON.WHICH = 5 then
if DE.PART.V.CON.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "est");
end if;
elsif DE.PART.V.CON.WHICH = 7 then
if DE.PART.V.CON.VAR = 1 or
DE.PART.V.CON.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "t");
end if;
end if;
else
-- OX 1
if DE.PART.V.CON.WHICH = 2 then
OX(1) := ADD(DE.STEMS(1), "eo");
elsif DE.PART.V.CON.WHICH = 5 then
OX(1) := ADD(DE.STEMS(1), "um");
elsif DE.PART.V.CON = (7, 2) then
OX(1) := ADD(DE.STEMS(1), "am");
else
OX(1) := ADD(DE.STEMS(1), "o");
end if; -- /= IMPERS handled
--end if;
-- OX(1) handled
end if;
-- OX 2
if DE.PART.V.CON.WHICH = 1 then
OX(2) := ADD(DE.STEMS(2), "are");
elsif DE.PART.V.CON.WHICH = 2 then
OX(2) := ADD(DE.STEMS(2), "ere");
elsif DE.PART.V.CON.WHICH = 3 then
if DE.PART.V.CON.VAR = 2 then
OX(2) := ADD(DE.STEMS(2), "re");
elsif DE.PART.V.CON.VAR = 3 then
OX(2) := ADD(DE.STEMS(2), "eri");
elsif DE.PART.V.CON.VAR = 4 then
OX(2) := ADD(DE.STEMS(2), "ire");
else
OX(2) := ADD(DE.STEMS(2), "ere");
end if;
-- elsif DE.PART.V.CON.WHICH = 4 then
-- OX(2) := ADD(DE.STEMS(2), "ire");
elsif DE.PART.V.CON.WHICH = 5 then
if DE.PART.V.CON.VAR = 1 then
OX(2) := ADD(DE.STEMS(2), "esse");
elsif DE.PART.V.CON.VAR = 2 then
OX(2) := ADD(DE.STEMS(1), "e"); -- tricky, but it is 1
end if;
elsif DE.PART.V.CON.WHICH = 6 then
if DE.PART.V.CON.VAR = 1 then
OX(2) := ADD(DE.STEMS(2), "re");
elsif DE.PART.V.CON.VAR = 2 then
OX(2) := ADD(DE.STEMS(2), "le");
end if;
elsif DE.PART.V.CON.WHICH = 7 then
if DE.PART.V.CON.VAR = 3 then
OX(2) := ADD(DE.STEMS(2), "se");
end if;
elsif DE.PART.V.CON.WHICH = 8 then
if DE.PART.V.CON.VAR = 1 then
OX(2) := ADD(DE.STEMS(2), "are");
elsif DE.PART.V.CON.VAR = 2 then
OX(2) := ADD(DE.STEMS(2), "ere");
elsif DE.PART.V.CON.VAR = 3 then
OX(2) := ADD(DE.STEMS(2), "ere");
elsif DE.PART.V.CON.VAR = 4 then
OX(2) := ADD(DE.STEMS(2), "ire");
else
OX(2) := ADD(DE.STEMS(2), "ere");
end if;
elsif DE.PART.V.CON = (9, 8) then
OX(1) := ADD(DE.STEMS(1), ".");
OX(2) := ADD(NULL_OX, "abb.");
elsif DE.PART.V.CON = (9, 9) then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(NULL_OX, "undeclined");
end if; -- OX(2) handled
-- OX 3 & 4
if DE.PART.V.KIND = IMPERS then
if (OX(3)(1..7) /= "PERFDEF") then
OX(3) := ADD(DE.STEMS(3), "it");
end if;
OX(4) := ADD(DE.STEMS(4), "us est");
elsif DE.PART.V.KIND = SEMIDEP then -- Finalization correction
OX(4) := ADD(DE.STEMS(4), "us sum");
elsif DE.PART.V.CON = (5, 1) then
OX(3) := ADD(DE.STEMS(3), "i");
OX(4) := ADD(DE.STEMS(4), "urus");
elsif DE.PART.V.CON.WHICH = 8 then
OX(3) := ADD("", "additional");
OX(4) := ADD("", "forms");
elsif DE.PART.V.CON.WHICH = 9 then
OX(3) := ADD(NULL_OX, "BLANK"); -- Flag for later use
OX(4) := ADD(NULL_OX, "BLANK"); -- Flag for later use
else
OX(3) := ADD(DE.STEMS(3), "i");
OX(4) := ADD(DE.STEMS(4), "us");
end if; -- OX(3 & 4) handled
end if; -- On V KIND
if DE.PART.V.CON = (6, 1) then -- Finalization correction
OX(3) := ADD(OX(3), " (ii)");
end if;
elsif (DE.PART.POFS = NUM) and then (DE.PART.NUM.SORT = X) then
if DE.PART.NUM.DECL.WHICH = 1 then
if DE.PART.NUM.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us -a -um");
OX(2) := ADD(DE.STEMS(2), "us -a -um");
OX(3) := ADD(DE.STEMS(3), "i -ae -a");
OX(4) := ADD(DE.STEMS(4), "");
elsif DE.PART.NUM.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "o -ae o");
OX(2) := ADD(DE.STEMS(2), "us -a -um");
OX(3) := ADD(DE.STEMS(3), "i -ae -a");
OX(4) := ADD(DE.STEMS(4), "");
elsif DE.PART.NUM.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "es -es -ia");
OX(2) := ADD(DE.STEMS(2), "us -a -um");
OX(3) := ADD(DE.STEMS(3), "i -ae -a");
OX(4) := ADD(DE.STEMS(4), "");
elsif DE.PART.NUM.DECL.VAR = 4 then
OX(1) := ADD(DE.STEMS(1), "i -ae -a");
OX(2) := ADD(DE.STEMS(2), "us -a -um");
OX(3) := ADD(DE.STEMS(3), "i -ae -a");
OX(4) := ADD(DE.STEMS(4), "ie(n)s");
end if;
elsif DE.PART.NUM.DECL.WHICH = 2 then
OX(1) := ADD(DE.STEMS(1), "");
OX(2) := ADD(DE.STEMS(2), "us -a -um");
OX(3) := ADD(DE.STEMS(3), "i -ae -a");
OX(4) := ADD(DE.STEMS(4), "ie(n)s");
end if;
elsif (DE.PART.POFS = NUM) and then (DE.PART.NUM.SORT = CARD) then
if DE.PART.NUM.DECL.WHICH = 1 then
if DE.PART.NUM.DECL.VAR = 1 then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(1), "a");
OX(3) := ADD(DE.STEMS(1), "um");
elsif DE.PART.NUM.DECL.VAR = 2 then
OX(1) := ADD(DE.STEMS(1), "o");
OX(2) := ADD(DE.STEMS(1), "ae");
OX(3) := ADD(DE.STEMS(1), "o");
elsif DE.PART.NUM.DECL.VAR = 3 then
OX(1) := ADD(DE.STEMS(1), "es");
OX(2) := ADD(DE.STEMS(1), "es");
OX(3) := ADD(DE.STEMS(1), "ia");
elsif DE.PART.NUM.DECL.VAR = 4 then
OX(1) := ADD(DE.STEMS(1), "i");
OX(2) := ADD(DE.STEMS(1), "ae");
OX(3) := ADD(DE.STEMS(1), "a");
end if;
elsif DE.PART.NUM.DECL.WHICH = 2 then
OX(1) := ADD(DE.STEMS(1), "");
end if;
elsif (DE.PART.POFS = NUM) and then (DE.PART.NUM.SORT = ORD) then
OX(1) := ADD(DE.STEMS(1), "us");
OX(2) := ADD(DE.STEMS(1), "a");
OX(3) := ADD(DE.STEMS(1), "um");
elsif (DE.PART.POFS = NUM) and then (DE.PART.NUM.SORT = DIST) then
OX(1) := ADD(DE.STEMS(1), "i");
OX(2) := ADD(DE.STEMS(1), "ae");
OX(3) := ADD(DE.STEMS(1), "a");
else
OX(1) := ADD(DE.STEMS(1), "");
end if; -- On PART
--TEXT_IO.PUT_LINE(OX(1) & "+" & OX(2) & "+" & OX(3) & "+" & OX(4));
-- Now clean up and output
-- Several flags have been set which modify OX's
if OX(1)(1..3) = "zzz" then
ADD_UP(" - ");
elsif OX(1) /= NULL_OX then
ADD_UP(TRIM(OX(1)));
end if;
if OX(2)(1..3) = "zzz" then
ADD_UP(", - ");
elsif OX(2) /= NULL_OX then
ADD_UP(", " & TRIM(OX(2)));
end if;
if OX(3)(1..3) = "zzz" then
ADD_UP(", - ");
elsif OX(3)(1..3) = "DEP" then
null;
elsif OX(3)(1..7) = "PERFDEF" then
null;
elsif OX(3)(1..5) = "BLANK" then
null;
elsif OX(3) /= NULL_OX then
ADD_UP(", " & TRIM(OX(3)));
end if;
if OX(4)(1..3) = "zzz" then
ADD_UP(", - ");
elsif OX(4)(1..5) = "BLANK" then
null;
elsif OX(4) /= NULL_OX then
ADD_UP(", " & TRIM(OX(4)));
end if;
ADD_TO(" " & PART_OF_SPEECH_TYPE'IMAGE(DE.PART.POFS)& " ");
if DE.PART.POFS = N then
-- For DICTPAGE
if DE.PART.N.DECL.WHICH in 1..5 and
DE.PART.N.DECL.VAR in 1..5 then
ADD_TO(" (" & FST(DE.PART.N.DECL.WHICH) & ")");
end if;
ADD_TO(" " & GENDER_TYPE'IMAGE(DE.PART.N.GENDER) & " ");
end if;
if (DE.PART.POFS = V) then
-- For DICTPAGE
if DE.PART.V.CON.WHICH in 1..3 then
if DE.PART.V.CON.VAR = 1 then
ADD_TO(" (" & FST(DE.PART.V.CON.WHICH) & ")");
elsif DE.PART.V.CON = (3, 4) then
ADD_TO(" (" & FST(4) & ")");
end if;
end if;
if (DE.PART.V.KIND in GEN..PERFDEF) then
ADD_TO(" " & VERB_KIND_TYPE'IMAGE(DE.PART.V.KIND) & " ");
end if;
end if;
--TEXT_IO.PUT_LINE(">>>>" & TRIM(FORM));
return TRIM(FORM);
exception
when NOT_FOUND =>
return "";
when others =>
return "";
end DICTIONARY_FORM;

1684
dictionary_package.adb Normal file
View File

File diff suppressed because it is too large Load Diff

476
dictionary_package.ads Normal file
View File

@@ -0,0 +1,476 @@
-- Need KIND_ENTRY and IO
-- Need to modify TRANS
with TEXT_IO;
with DIRECT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
package DICTIONARY_PACKAGE is
use TEXT_IO;
ZZZ_STEM : constant STEM_TYPE := "zzz" & (4..MAX_STEM_SIZE => ' ');
type STEMS_TYPE is array (STEM_KEY_TYPE range 1..4) of STEM_TYPE;
NULL_STEMS_TYPE : constant STEMS_TYPE := (others => NULL_STEM_TYPE);
type DICTIONARY_KIND is (X, -- null
ADDONS, -- For FIXES
XXX, -- TRICKS
YYY, -- Syncope
NNN, -- Unknown Name
RRR, -- Roman Numerals
PPP, -- Compounds
GENERAL, SPECIAL, LOCAL, UNIQUE);
package DICTIONARY_KIND_IO is new TEXT_IO.ENUMERATION_IO(DICTIONARY_KIND);
EXT : array (DICTIONARY_KIND) of STRING(1..3) := ("X ", "ADD", "XXX", "YYY",
"NNN", "RRR", "PPP",
"GEN", "SPE", "LOC",
"UNI");
DEFAULT_DICTIONARY_KIND : DICTIONARY_KIND := X;
DICTIONARY_AVAILABLE : array (DICTIONARY_KIND) of BOOLEAN := (FALSE,
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, -- don't SEARCH
FALSE, FALSE, FALSE, FALSE);
-- Start out as FALSE and set to TRUE when the DICT is loaded
type AREA_TYPE is (
X, -- All or none
A, -- Agriculture, Flora, Fauna, Land, Equipment, Rural
B, -- Biological, Medical, Body Parts
D, -- Drama, Music, Theater, Art, Painting, Sculpture
E, -- Ecclesiastic, Biblical, Religious
G, -- Grammar, Retoric, Logic, Literature, Schools
L, -- Legal, Government, Tax, Financial, Political, Titles
P, -- Poetic
S, -- Science, Philosophy, Mathematics, Units/Measures
T, -- Technical, Architecture, Topography, Surveying
W, -- War, Military, Naval, Ships, Armor
Y -- Mythology
);
package AREA_TYPE_IO is new TEXT_IO.ENUMERATION_IO(AREA_TYPE);
type GEO_TYPE is (
X, -- All or none
A, -- Africa
B, -- Britian
C, -- China
D, -- Scandinavia
E, -- Egypt
F, -- France, Gaul
G, -- Germany
H, -- Greece
I, -- Italy, Rome
J, -- India
K, -- Balkans
N, -- Netherlands
P, -- Persia
Q, -- Near East
R, -- Russia
S, -- Spain, Iberia
U -- Eastern Europe
);
package GEO_TYPE_IO is new TEXT_IO.ENUMERATION_IO(GEO_TYPE);
type SOURCE_TYPE is (
X, -- General or unknown or too common to say
A,
B, -- C.H.Beeson, A Primer of Medieval Latin, 1925 (Bee)
C, -- Charles Beard, Cassell's Latin Dictionary 1892 (Cas)
D, -- J.N.Adams, Latin Sexual Vocabulary, 1982 (Sex)
E, -- L.F.Stelten, Dictionary of Eccles. Latin, 1995 (Ecc)
F, -- Roy J. Deferrari, Dictionary of St. Thomas Aquinas, 1960 (DeF)
G, -- Gildersleeve + Lodge, Latin Grammar 1895 (G+L)
H, -- Collatinus Dictionary by Yves Ouvrard
I, -- Leverett, F.P., Lexicon of the Latin Language, Boston 1845
J, -- Bracton: De Legibus Et Consuetudinibus Angliæ
K, -- Calepinus Novus, modern Latin, by Guy Licoppe (Cal)
L, -- Lewis, C.S., Elementary Latin Dictionary 1891
M, -- Latham, Revised Medieval Word List, 1980 (Latham)
N, -- Lynn Nelson, Wordlist (Nel)
O, -- Oxford Latin Dictionary, 1982 (OLD)
P, -- Souter, A Glossary of Later Latin to 600 A.D., Oxford 1949 (Souter)
Q, -- Other, cited or unspecified dictionaries
R, -- Plater + White, A Grammar of the Vulgate, Oxford 1926 (Plater)
S, -- Lewis and Short, A Latin Dictionary, 1879 (L+S)
T, -- Found in a translation -- no dictionary reference
U, --
V, -- Vademecum in opus Saxonis - Franz Blatt (Saxo)
W, -- My personal guess, mostly obvious extrapolation (Whitaker or W)
Y, -- Temp special code
Z -- Sent by user -- no dictionary reference
-- Mostly John White of Blitz Latin
-- Consulted but used only indirectly
-- Liddell + Scott Greek-English Lexicon (Lid)
-- Oxford English Dictionary 2002 (OED)
-- Consulted but used only occasionally, seperately referenced
-- D.A. Kidd, Collins Latin Gem Dictionary, 1957 (Col)
-- Allen + Greenough, New Latin Grammar, 1888 (A+G)
-- Harrington/Pucci/Elliott, Medieval Latin 2nd Ed 1997 (Harr)
-- C.C./C.L. Scanlon Latin Grammar/Second Latin, TAN 1976 (SCANLON)
-- W. M. Lindsay, Short Historical Latin Grammar, 1895 (Lindsay)
-- Du Cange
-- Oxford English Dictionary (OED)
-- Note that the WORDS dictionary is not just a copy of source info, but the
-- indicated SOURCE is a main reference/check point used to derive the entry
);
package SOURCE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(SOURCE_TYPE);
type KIND_ENTRY(POFS : PART_OF_SPEECH_TYPE := X) is
record
case POFS is
when N =>
N_KIND : NOUN_KIND_TYPE := X;
when PRON =>
PRON_KIND : PRONOUN_KIND_TYPE := X;
when PACK =>
PACK_KIND : PRONOUN_KIND_TYPE := X;
when ADJ =>
null;
when NUM =>
NUM_VALUE : NUMERAL_VALUE_TYPE := 0;
when V =>
V_KIND : VERB_KIND_TYPE := X;
when VPAR =>
VPAR_KIND : VERB_KIND_TYPE := X;
when SUPINE =>
SUPINE_KIND : VERB_KIND_TYPE := X;
when others =>
null;
end case;
end record;
package KIND_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE;
PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY);
procedure GET(PS : in PART_OF_SPEECH_TYPE; P : out KIND_ENTRY);
procedure PUT(F : in FILE_TYPE;
PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY);
procedure PUT(PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY);
procedure GET(S : in STRING; PS : in PART_OF_SPEECH_TYPE;
P : out KIND_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING;
PS : in PART_OF_SPEECH_TYPE; P : in KIND_ENTRY);
end KIND_ENTRY_IO;
NULL_KIND_ENTRY : KIND_ENTRY;
type TRANSLATION_RECORD is
record
AGE : AGE_TYPE := X;
AREA : AREA_TYPE := X;
GEO : GEO_TYPE := X;
FREQ : FREQUENCY_TYPE := X;
SOURCE : SOURCE_TYPE := X;
end record;
NULL_TRANSLATION_RECORD : TRANSLATION_RECORD;
package TRANSLATION_RECORD_IO is
DEFAULT_WIDTH : TEXT_IO.FIELD;
procedure GET(F : in TEXT_IO.FILE_TYPE; TR : out TRANSLATION_RECORD);
procedure GET(TR : out TRANSLATION_RECORD);
procedure PUT(F : in TEXT_IO.FILE_TYPE; TR : in TRANSLATION_RECORD);
procedure PUT(TR : in TRANSLATION_RECORD);
procedure GET(S : in STRING; TR : out TRANSLATION_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; TR : in TRANSLATION_RECORD);
end TRANSLATION_RECORD_IO;
type NOUN_ENTRY is
record
DECL : DECN_RECORD := (0, 0);
GENDER : GENDER_TYPE := X;
KIND : NOUN_KIND_TYPE := X;
end record;
package NOUN_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; N : out NOUN_ENTRY);
procedure GET(N : out NOUN_ENTRY);
procedure PUT(F : in FILE_TYPE; N : in NOUN_ENTRY);
procedure PUT(N : in NOUN_ENTRY);
procedure GET(S : in STRING; N : out NOUN_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; N : in NOUN_ENTRY);
end NOUN_ENTRY_IO;
type PRONOUN_ENTRY is
record
DECL : DECN_RECORD := (0,0);
KIND : PRONOUN_KIND_TYPE := X;
end record;
package PRONOUN_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PRONOUN_ENTRY);
procedure GET(P : out PRONOUN_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in PRONOUN_ENTRY);
procedure PUT(P : in PRONOUN_ENTRY);
procedure GET(S : in STRING; P : out PRONOUN_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PRONOUN_ENTRY);
end PRONOUN_ENTRY_IO;
type PROPACK_ENTRY is
record
DECL : DECN_RECORD := (0,0);
KIND : PRONOUN_KIND_TYPE := X;
end record;
package PROPACK_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PROPACK_ENTRY);
procedure GET(P : out PROPACK_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in PROPACK_ENTRY);
procedure PUT(P : in PROPACK_ENTRY);
procedure GET(S : in STRING; P : out PROPACK_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PROPACK_ENTRY);
end PROPACK_ENTRY_IO;
type ADJECTIVE_ENTRY is
record
DECL : DECN_RECORD := (0, 0);
CO : COMPARISON_TYPE := X;
end record;
package ADJECTIVE_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; A : out ADJECTIVE_ENTRY);
procedure GET(A : out ADJECTIVE_ENTRY);
procedure PUT(F : in FILE_TYPE; A : in ADJECTIVE_ENTRY);
procedure PUT(A : in ADJECTIVE_ENTRY);
procedure GET(S : in STRING; A : out ADJECTIVE_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; A : in ADJECTIVE_ENTRY);
end ADJECTIVE_ENTRY_IO;
type NUMERAL_ENTRY is
record
DECL : DECN_RECORD := (0,0);
SORT : NUMERAL_SORT_TYPE := X;
VALUE : NUMERAL_VALUE_TYPE := 0;
end record;
package NUMERAL_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; NUM : out NUMERAL_ENTRY);
procedure GET(NUM : out NUMERAL_ENTRY);
procedure PUT(F : in FILE_TYPE; NUM : in NUMERAL_ENTRY);
procedure PUT(NUM : in NUMERAL_ENTRY);
procedure GET(S : in STRING; NUM : out NUMERAL_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; NUM : in NUMERAL_ENTRY);
end NUMERAL_ENTRY_IO;
type ADVERB_ENTRY is
record
CO : COMPARISON_TYPE := X;
end record;
package ADVERB_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; A : out ADVERB_ENTRY);
procedure GET(A : out ADVERB_ENTRY);
procedure PUT(F : in FILE_TYPE; A : in ADVERB_ENTRY);
procedure PUT(A : in ADVERB_ENTRY);
procedure GET(S : in STRING; A : out ADVERB_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; A : in ADVERB_ENTRY);
end ADVERB_ENTRY_IO;
type VERB_ENTRY is
record
CON : DECN_RECORD := (0,0);
KIND : VERB_KIND_TYPE := X;
end record;
package VERB_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; V : out VERB_ENTRY);
procedure GET(V : out VERB_ENTRY);
procedure PUT(F : in FILE_TYPE; V : in VERB_ENTRY);
procedure PUT(V : in VERB_ENTRY);
procedure GET(S : in STRING; V : out VERB_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; V : in VERB_ENTRY);
end VERB_ENTRY_IO;
type PREPOSITION_ENTRY is
record
OBJ : CASE_TYPE := X;
end record;
package PREPOSITION_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PREPOSITION_ENTRY);
procedure GET(P : out PREPOSITION_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in PREPOSITION_ENTRY);
procedure PUT(P : in PREPOSITION_ENTRY);
procedure GET(S : in STRING; P : out PREPOSITION_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PREPOSITION_ENTRY);
end PREPOSITION_ENTRY_IO;
type CONJUNCTION_ENTRY is
record
null;
end record;
package CONJUNCTION_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; C : out CONJUNCTION_ENTRY);
procedure GET(C : out CONJUNCTION_ENTRY);
procedure PUT(F : in FILE_TYPE; C : in CONJUNCTION_ENTRY);
procedure PUT(C : in CONJUNCTION_ENTRY);
procedure GET(S : in STRING; C : out CONJUNCTION_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; C : in CONJUNCTION_ENTRY);
end CONJUNCTION_ENTRY_IO;
type INTERJECTION_ENTRY is
record
null;
end record;
package INTERJECTION_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; I : out INTERJECTION_ENTRY);
procedure GET(I : out INTERJECTION_ENTRY);
procedure PUT(F : in FILE_TYPE; I : in INTERJECTION_ENTRY);
procedure PUT(I : in INTERJECTION_ENTRY);
procedure GET(S : in STRING; I : out INTERJECTION_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; I : in INTERJECTION_ENTRY);
end INTERJECTION_ENTRY_IO;
type PART_ENTRY(POFS : PART_OF_SPEECH_TYPE := X) is
record
case POFS is
when N =>
N : NOUN_ENTRY;
when PRON =>
PRON : PRONOUN_ENTRY;
when PACK =>
PACK : PROPACK_ENTRY;
when ADJ =>
ADJ : ADJECTIVE_ENTRY;
when NUM =>
NUM : NUMERAL_ENTRY;
when ADV =>
ADV : ADVERB_ENTRY;
when V =>
V : VERB_ENTRY;
when VPAR =>
null; -- There will be no VPAR dictionary entries
when SUPINE =>
null; -- There will be no SUPINE dictionary entries
when PREP =>
PREP : PREPOSITION_ENTRY;
when CONJ =>
CONJ : CONJUNCTION_ENTRY;
when INTERJ =>
INTERJ : INTERJECTION_ENTRY;
when others =>
null;
end case;
end record;
package PART_ENTRY_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PART_ENTRY);
procedure GET(P : out PART_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in PART_ENTRY);
procedure PUT(P : in PART_ENTRY);
procedure GET(S : in STRING; P : out PART_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PART_ENTRY);
end PART_ENTRY_IO;
NULL_PART_ENTRY : PART_ENTRY;
function "<" (LEFT, RIGHT : PART_ENTRY) return BOOLEAN;
type DICTIONARY_ENTRY is
record
STEMS : STEMS_TYPE := NULL_STEMS_TYPE;
PART : PART_ENTRY := NULL_PART_ENTRY;
-- KIND : KIND_ENTRY := NULL_KIND_ENTRY;
TRAN : TRANSLATION_RECORD := NULL_TRANSLATION_RECORD;
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
end record;
package DICTIONARY_ENTRY_IO is
DEFAULT_WIDTH : FIELD;
procedure GET(F : in FILE_TYPE; D : out DICTIONARY_ENTRY);
procedure GET(D : out DICTIONARY_ENTRY);
procedure PUT(F : in FILE_TYPE; D : in DICTIONARY_ENTRY);
procedure PUT(D : in DICTIONARY_ENTRY);
procedure GET(S : in STRING; D : out DICTIONARY_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; D : in DICTIONARY_ENTRY);
end DICTIONARY_ENTRY_IO;
NULL_DICTIONARY_ENTRY : DICTIONARY_ENTRY;
package DICT_IO is new DIRECT_IO(DICTIONARY_ENTRY);
DICT_FILE : array (DICTIONARY_KIND) of DICT_IO.FILE_TYPE;
package MNPC_IO is new TEXT_IO.INTEGER_IO(DICT_IO.COUNT);
subtype MNPC_TYPE is DICT_IO.COUNT;
NULL_MNPC : DICT_IO.COUNT := DICT_IO.COUNT'FIRST;
type PARSE_RECORD is
record
STEM : STEM_TYPE := NULL_STEM_TYPE;
IR : INFLECTION_RECORD := NULL_INFLECTION_RECORD;
D_K : DICTIONARY_KIND := DEFAULT_DICTIONARY_KIND;
MNPC : DICT_IO.COUNT := NULL_MNPC;
end record;
NULL_PARSE_RECORD : PARSE_RECORD;
package PARSE_RECORD_IO is
DEFAULT_WIDTH : TEXT_IO.FIELD;
procedure GET(F : in TEXT_IO.FILE_TYPE; PR : out PARSE_RECORD);
procedure GET(PR : out PARSE_RECORD);
procedure PUT(F : in TEXT_IO.FILE_TYPE; PR : in PARSE_RECORD);
procedure PUT(PR : in PARSE_RECORD);
procedure GET(S : in STRING; PR : out PARSE_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; PR : in PARSE_RECORD);
end PARSE_RECORD_IO;
type PARSE_ARRAY is array (INTEGER range <>) of PARSE_RECORD;
function NUMBER_OF_STEMS(P : PART_OF_SPEECH_TYPE) return STEM_KEY_TYPE;
function "<=" (LEFT, RIGHT : AREA_TYPE) return BOOLEAN;
end DICTIONARY_PACKAGE;

151
english_support_package.adb Normal file
View File

@@ -0,0 +1,151 @@
package body ENGLISH_SUPPORT_PACKAGE is
--use EWDS_DIRECT_IO;
use TEXT_IO;
package body EWDS_RECORD_IO is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
use PART_OF_SPEECH_TYPE_IO;
use FREQUENCY_TYPE_IO;
use TEXT_IO;
use INTEGER_IO;
SPACER : CHARACTER := ' ';
NWIDTH : constant := 5;
procedure GET(F : in TEXT_IO.FILE_TYPE; P : out EWDS_RECORD) is
begin
GET(F, P.W);
GET(F, SPACER);
GET(F, P.AUX);
GET(F, SPACER);
GET(F, P.N);
GET(F, SPACER);
GET(F, P.POFS);
GET(F, SPACER);
GET(F, P.FREQ);
GET(F, SPACER);
GET(F, P.SEMI);
GET(F, SPACER);
GET(F, P.KIND);
GET(F, SPACER);
GET(F, P.RANK);
end GET;
procedure GET(P : out EWDS_RECORD) is
begin
GET(P.W);
GET(SPACER);
GET(P.AUX);
GET(SPACER);
GET(P.N);
GET(SPACER);
GET(P.POFS);
GET(SPACER);
GET(P.FREQ);
GET(SPACER);
GET(P.SEMI);
GET(SPACER);
GET(P.KIND);
GET(SPACER);
GET(P.RANK);
end GET;
procedure PUT(F : in TEXT_IO.FILE_TYPE; P : in EWDS_RECORD) is
begin
PUT(F, P.W);
PUT(F, ' ');
PUT(F, P.AUX);
PUT(F, ' ');
PUT(F, P.N);
PUT(F, ' ');
PUT(F, P.POFS);
PUT(F, ' ');
PUT(F, P.FREQ);
PUT(F, ' ');
PUT(F, P.SEMI, NWIDTH);
PUT(F, ' ');
PUT(F, P.KIND, NWIDTH);
PUT(F, ' ');
PUT(F, P.RANK, NWIDTH);
end PUT;
procedure PUT(P : in EWDS_RECORD) is
begin
PUT(P.W);
PUT(' ');
PUT(P.AUX);
PUT(' ');
PUT(P.N);
PUT(' ');
PUT(P.POFS);
PUT(' ');
PUT(P.FREQ);
PUT(' ');
PUT(P.SEMI, NWIDTH);
PUT(' ');
PUT(P.KIND, NWIDTH);
PUT(' ');
PUT(P.RANK, NWIDTH);
end PUT;
procedure GET(S : in STRING; P : out EWDS_RECORD; LAST : out INTEGER) is
L : INTEGER := S'FIRST - 1;
begin
P.W := S(L+1..L+EWORD_SIZE);
L := L + EWORD_SIZE + 1;
P.AUX := S(L+1..L+AUX_WORD_SIZE);
L := L + AUX_WORD_SIZE + 1;
GET(S(L+1..S'LAST), P.N, L);
L := L + 1;
GET(S(L+1..S'LAST), P.POFS, L);
L := L + 1;
GET(S(L+1..S'LAST), P.FREQ, L);
L := L + 1;
GET(S(L+1..S'LAST), P.SEMI, L);
L := L + 1;
GET(S(L+1..S'LAST), P.KIND, L);
L := L + 1;
GET(S(L+1..S'LAST), P.RANK, LAST);
end GET;
procedure PUT(S : out STRING; P : in EWDS_RECORD) is
L : INTEGER := S'FIRST - 1;
M : INTEGER := 0;
begin
M := L + EWORD_SIZE;
S(L+1..M) := P.W;
L := M + 1;
S(L) := ' ';
M := L + AUX_WORD_SIZE;
S(L+1..M) := P.AUX;
L := M + 1;
S(L) := ' ';
M := L + LINE_NUMBER_WIDTH;
PUT(S(L+1..M), P.N);
S(L) := ' ';
M := L + PART_OF_SPEECH_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.POFS);
S(L) := ' ';
M := L + FREQUENCY_TYPE_IO.DEFAULT_WIDTH;
PUT(S(L+1..M), P.FREQ);
S(L) := ' ';
M := L + PRIORITY_WIDTH;
PUT(S(L+1..M), P.SEMI, NWIDTH);
S(L) := ' ';
M := L + PRIORITY_WIDTH;
PUT(S(L+1..M), P.KIND, NWIDTH);
S(L) := ' ';
M := L + PRIORITY_WIDTH;
PUT(S(L+1..M), P.RANK, NWIDTH);
S(M+1..S'LAST) := (others => ' ');
end PUT;
end EWDS_RECORD_IO;
end ENGLISH_SUPPORT_PACKAGE;

62
english_support_package.ads Normal file
View File

@@ -0,0 +1,62 @@
with Text_IO;
with Direct_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 WORD_SUPPORT_PACKAGE; use WORD_SUPPORT_PACKAGE;
package ENGLISH_SUPPORT_PACKAGE is
EWORD_SIZE : constant := 24;
AUX_WORD_SIZE : constant := 12;
LINE_NUMBER_WIDTH : constant := 10;
PRIORITY_WIDTH : constant := 3;
subtype EWORD is STRING(1..EWORD_SIZE);
NULL_EWORD : EWORD := (others => ' ');
subtype AUXWORD is STRING(1..AUX_WORD_SIZE);
NULL_AUXWORD : AUXWORD := (others => ' ');
subtype PRIORITY_TYPE is INTEGER range 0..99;
NUMBER_OF_EWORDS : INTEGER := 0;
type EWDS_RECORD is
record
W : EWORD := NULL_EWORD;
AUX : AUXWORD := NULL_AUXWORD;
N : INTEGER := 0;
POFS : PART_OF_SPEECH_TYPE := X;
FREQ : FREQUENCY_TYPE := X;
SEMI : INTEGER := 0;
KIND : INTEGER := 0;
RANK : INTEGER := 0;
end record;
NULL_EWDS_RECORD : EWDS_RECORD := ((others => ' '),
(others => ' '), 0, X, X, 0, 0, 0);
type EWDS_ARRAY is array (POSITIVE range <>) of EWDS_RECORD;
package EWDS_DIRECT_IO is new DIRECT_IO(EWDS_RECORD);
package EWDS_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in TEXT_IO.FILE_TYPE; P : out EWDS_RECORD);
procedure GET(P : out EWDS_RECORD);
procedure PUT(F : in TEXT_IO.FILE_TYPE; P : in EWDS_RECORD);
procedure PUT(P : in EWDS_RECORD);
procedure GET(S : in STRING; P : out EWDS_RECORD;
LAST : out INTEGER);
procedure PUT(S : out STRING; P : in EWDS_RECORD);
end EWDS_RECORD_IO;
ENGLISH_DICTIONARY_AVAILABLE : array (DICTIONARY_KIND) of BOOLEAN := (FALSE,
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, -- don't SEARCH
FALSE, FALSE, FALSE, FALSE);
EWDS_FILE : EWDS_DIRECT_IO.FILE_TYPE;
end ENGLISH_SUPPORT_PACKAGE;

2633
inflections_package.adb Normal file
View File

File diff suppressed because it is too large Load Diff

729
inflections_package.ads Normal file
View File

@@ -0,0 +1,729 @@
with TEXT_IO;
with DIRECT_IO;
package INFLECTIONS_PACKAGE is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
use TEXT_IO;
-- Generally simple/enumeration types have names ending in _TYPE
-- complex/record types have names ending in _RECORD
-- array types have names ending in _ARRAY
MAX_STEM_SIZE : constant := 18;
MAX_MEANING_SIZE : constant := 80;
subtype STEM_TYPE is STRING(1..MAX_STEM_SIZE);
NULL_STEM_TYPE : constant STEM_TYPE := (others => ' ');
package STEM_TYPE_IO is
DEFAULT_WIDTH : NATURAL := MAX_STEM_SIZE;
procedure GET(F : in FILE_TYPE; D : out STEM_TYPE);
procedure GET(D : out STEM_TYPE);
procedure PUT(F : in FILE_TYPE; D : in STEM_TYPE);
procedure PUT(D : in STEM_TYPE);
procedure GET(S : in STRING; D : out STEM_TYPE;
LAST : out INTEGER);
procedure PUT(S : out STRING; D : in STEM_TYPE);
end STEM_TYPE_IO;
subtype MEANING_TYPE is STRING(1..MAX_MEANING_SIZE);
NULL_MEANING_TYPE : constant MEANING_TYPE := (others => ' ');
type PART_OF_SPEECH_TYPE is (
X, -- all, none, or unknown
N, -- Noun
PRON, -- PRONoun
PACK, -- PACKON -- artificial for code
ADJ, -- ADJective
NUM, -- NUMeral
ADV, -- ADVerb
V, -- Verb
VPAR, -- Verb PARticiple
SUPINE, -- SUPINE
PREP, -- PREPosition
CONJ, -- CONJunction
INTERJ, -- INTERJection
TACKON, -- TACKON -- artificial for code
PREFIX, -- PREFIX -- here artificial for code
SUFFIX -- SUFFIX -- here artificial for code
);
package PART_OF_SPEECH_TYPE_IO is
new TEXT_IO.ENUMERATION_IO(PART_OF_SPEECH_TYPE);
subtype WHICH_TYPE is NATURAL range 0..9;
subtype VARIANT_TYPE is NATURAL range 0..9;
WHICH_TYPE_IO_DEFAULT_WIDTH : INTEGER := 1;
VARIANT_TYPE_IO_DEFAULT_WIDTH : INTEGER := 1;
type DECN_RECORD is
record
WHICH : WHICH_TYPE := 0;
VAR : VARIANT_TYPE := 0;
end record;
function "<" (LEFT, RIGHT : DECN_RECORD) return BOOLEAN;
package DECN_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; D : out DECN_RECORD);
procedure GET(D : out DECN_RECORD);
procedure PUT(F : in FILE_TYPE; D : in DECN_RECORD);
procedure PUT(D : in DECN_RECORD);
procedure GET(S : in STRING; D : out DECN_RECORD;
LAST : out INTEGER);
procedure PUT(S : out STRING; D : in DECN_RECORD);
end DECN_RECORD_IO;
type GENDER_TYPE is (
X, -- all, none, or unknown
M, -- Masculine
F, -- Feminine
N, -- Neuter
C -- Common (masculine and/or feminine)
);
package GENDER_TYPE_IO is new TEXT_IO.ENUMERATION_IO(GENDER_TYPE);
type CASE_TYPE is (
X, -- all, none, or unknown
NOM, -- NOMinative
VOC, -- VOCative
GEN, -- GENitive
LOC, -- LOCative
DAT, -- DATive
ABL, -- ABLative
ACC -- ACCusitive
);
package CASE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(CASE_TYPE);
type NUMBER_TYPE is (
X, -- all, none, or unknown
S, -- Singular
P -- Plural
);
package NUMBER_TYPE_IO is new TEXT_IO.ENUMERATION_IO(NUMBER_TYPE);
type PERSON_TYPE is range 0..3;
package PERSON_TYPE_IO is new TEXT_IO.INTEGER_IO(PERSON_TYPE);
type COMPARISON_TYPE is (
X, -- all, none, or unknown
POS, -- POSitive
COMP, -- COMParative
SUPER -- SUPERlative
);
package COMPARISON_TYPE_IO is new TEXT_IO.ENUMERATION_IO(COMPARISON_TYPE);
type STEM_KEY_TYPE is new NATURAL range 0..9;
package STEM_KEY_TYPE_IO is new TEXT_IO.INTEGER_IO(STEM_KEY_TYPE);
STEM_KEY_TYPE_IO_DEFAULT_WIDTH : INTEGER := 1;
type NUMERAL_SORT_TYPE is (
X, -- all, none, or unknown
CARD, -- CARDinal
ORD, -- ORDinal
DIST, -- DISTributive
ADVERB -- numeral ADVERB
);
package NUMERAL_SORT_TYPE_IO is
new TEXT_IO.ENUMERATION_IO(NUMERAL_SORT_TYPE);
type TENSE_TYPE is (
X, -- all, none, or unknown
PRES, -- PRESent
IMPF, -- IMPerFect
FUT, -- FUTure
PERF, -- PERFect
PLUP, -- PLUPerfect
FUTP -- FUTure Perfect
);
package TENSE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(TENSE_TYPE);
type VOICE_TYPE is (
X, -- all, none, or unknown
ACTIVE, -- ACTIVE
PASSIVE -- PASSIVE
);
package VOICE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(VOICE_TYPE);
type MOOD_TYPE is (
X, -- all, none, or unknown
IND, -- INDicative
SUB, -- SUBjunctive
IMP, -- IMPerative
INF, -- INFinative
PPL -- ParticiPLe
);
package MOOD_TYPE_IO is new TEXT_IO.ENUMERATION_IO(MOOD_TYPE);
type TENSE_VOICE_MOOD_RECORD is
record
TENSE : TENSE_TYPE := X;
VOICE : VOICE_TYPE := X;
MOOD : MOOD_TYPE := X;
end record;
package TENSE_VOICE_MOOD_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; T : out TENSE_VOICE_MOOD_RECORD);
procedure GET(T : out TENSE_VOICE_MOOD_RECORD);
procedure PUT(F : in FILE_TYPE; T : in TENSE_VOICE_MOOD_RECORD);
procedure PUT(T : in TENSE_VOICE_MOOD_RECORD);
procedure GET(S : in STRING; T : out TENSE_VOICE_MOOD_RECORD;
LAST : out INTEGER);
procedure PUT(S : out STRING; T : in TENSE_VOICE_MOOD_RECORD);
end TENSE_VOICE_MOOD_RECORD_IO;
type NOUN_KIND_TYPE is (
X, -- unknown, nondescript
S, -- Singular "only" -- not really used
M, -- plural or Multiple "only" -- not really used
A, -- Abstract idea
G, -- Group/collective Name -- Roman(s)
N, -- proper Name
P, -- a Person
T, -- a Thing
L, -- Locale, name of country/city
W -- a place Where
);
package NOUN_KIND_TYPE_IO is new TEXT_IO.ENUMERATION_IO(NOUN_KIND_TYPE);
type PRONOUN_KIND_TYPE is (
X, -- unknown, nondescript
PERS, -- PERSonal
REL, -- RELative
REFLEX, -- REFLEXive
DEMONS, -- DEMONStrative
INTERR, -- INTERRogative
INDEF, -- INDEFinite
ADJECT -- ADJECTival
);
package PRONOUN_KIND_TYPE_IO is
new TEXT_IO.ENUMERATION_IO(PRONOUN_KIND_TYPE);
subtype NUMERAL_VALUE_TYPE is NATURAL range 0..1000;
NUMERAL_VALUE_TYPE_IO_DEFAULT_WIDTH : INTEGER := 5;
type VERB_KIND_TYPE is (
X, -- all, none, or unknown
TO_BE, -- only the verb TO BE (esse)
TO_BEING, -- compounds of the verb to be (esse)
GEN, -- verb taking the GENitive
DAT, -- verb taking the DATive
ABL, -- verb taking the ABLative
TRANS, -- TRANSitive verb
INTRANS, -- INTRANSitive verb
IMPERS, -- IMPERSonal verb (implied subject 'it', 'they', 'God')
-- agent implied in action, subject in predicate
DEP, -- DEPonent verb
-- only passive form but with active meaning
SEMIDEP, -- SEMIDEPonent verb (forms perfect as deponent)
-- (perfect passive has active force)
PERFDEF -- PERFect DEFinite verb
-- having only perfect stem, but with present force
);
package VERB_KIND_TYPE_IO is
new TEXT_IO.ENUMERATION_IO(VERB_KIND_TYPE);
type NOUN_RECORD is
record
DECL : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
end record;
package NOUN_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; N : out NOUN_RECORD);
procedure GET(N : out NOUN_RECORD);
procedure PUT(F : in FILE_TYPE; N : in NOUN_RECORD);
procedure PUT(N : in NOUN_RECORD);
procedure GET(S : in STRING; N : out NOUN_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; N : in NOUN_RECORD);
end NOUN_RECORD_IO;
type PRONOUN_RECORD is
record
DECL : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
end record;
package PRONOUN_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PRONOUN_RECORD);
procedure GET(P : out PRONOUN_RECORD);
procedure PUT(F : in FILE_TYPE; P : in PRONOUN_RECORD);
procedure PUT(P : in PRONOUN_RECORD);
procedure GET(S : in STRING; P : out PRONOUN_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PRONOUN_RECORD);
end PRONOUN_RECORD_IO;
type PROPACK_RECORD is
record
DECL : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
end record;
package PROPACK_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PROPACK_RECORD);
procedure GET(P : out PROPACK_RECORD);
procedure PUT(F : in FILE_TYPE; P : in PROPACK_RECORD);
procedure PUT(P : in PROPACK_RECORD);
procedure GET(S : in STRING; P : out PROPACK_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PROPACK_RECORD);
end PROPACK_RECORD_IO;
type ADJECTIVE_RECORD is
record
DECL : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
CO : COMPARISON_TYPE := X;
end record;
package ADJECTIVE_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; A : out ADJECTIVE_RECORD);
procedure GET(A : out ADJECTIVE_RECORD);
procedure PUT(F : in FILE_TYPE; A : in ADJECTIVE_RECORD);
procedure PUT(A : in ADJECTIVE_RECORD);
procedure GET(S : in STRING; A : out ADJECTIVE_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; A : in ADJECTIVE_RECORD);
end ADJECTIVE_RECORD_IO;
type NUMERAL_RECORD is
record
DECL : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
SORT : NUMERAL_SORT_TYPE := X;
end record;
package NUMERAL_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; NUM : out NUMERAL_RECORD);
procedure GET(NUM : out NUMERAL_RECORD);
procedure PUT(F : in FILE_TYPE; NUM : in NUMERAL_RECORD);
procedure PUT(NUM : in NUMERAL_RECORD);
procedure GET(S : in STRING; NUM : out NUMERAL_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; NUM : in NUMERAL_RECORD);
end NUMERAL_RECORD_IO;
type ADVERB_RECORD is
record
CO : COMPARISON_TYPE := X;
end record;
package ADVERB_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; A : out ADVERB_RECORD);
procedure GET(A : out ADVERB_RECORD);
procedure PUT(F : in FILE_TYPE; A : in ADVERB_RECORD);
procedure PUT(A : in ADVERB_RECORD);
procedure GET(S : in STRING; A : out ADVERB_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; A : in ADVERB_RECORD);
end ADVERB_RECORD_IO;
type VERB_RECORD is
record
CON : DECN_RECORD;
TENSE_VOICE_MOOD : TENSE_VOICE_MOOD_RECORD;
PERSON : PERSON_TYPE := 0;
NUMBER : NUMBER_TYPE := X;
end record;
package VERB_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; V : out VERB_RECORD);
procedure GET(V : out VERB_RECORD);
procedure PUT(F : in FILE_TYPE; V : in VERB_RECORD);
procedure PUT(V : in VERB_RECORD);
procedure GET(S : in STRING; V : out VERB_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; V : in VERB_RECORD);
end VERB_RECORD_IO;
type VPAR_RECORD is
record
CON : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
TENSE_VOICE_MOOD : TENSE_VOICE_MOOD_RECORD;
end record;
package VPAR_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; VP : out VPAR_RECORD);
procedure GET(VP : out VPAR_RECORD);
procedure PUT(F : in FILE_TYPE; VP : in VPAR_RECORD);
procedure PUT(VP : in VPAR_RECORD);
procedure GET(S : in STRING; VP : out VPAR_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; VP : in VPAR_RECORD);
end VPAR_RECORD_IO;
type SUPINE_RECORD is
record
CON : DECN_RECORD;
CS : CASE_TYPE := X;
NUMBER : NUMBER_TYPE := X;
GENDER : GENDER_TYPE := X;
end record;
package SUPINE_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; VP : out SUPINE_RECORD);
procedure GET(VP : out SUPINE_RECORD);
procedure PUT(F : in FILE_TYPE; VP : in SUPINE_RECORD);
procedure PUT(VP : in SUPINE_RECORD);
procedure GET(S : in STRING; VP : out SUPINE_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; VP : in SUPINE_RECORD);
end SUPINE_RECORD_IO;
type PREPOSITION_RECORD is
record
OBJ : CASE_TYPE := X;
end record;
package PREPOSITION_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PREPOSITION_RECORD);
procedure GET(P : out PREPOSITION_RECORD);
procedure PUT(F : in FILE_TYPE; P : in PREPOSITION_RECORD);
procedure PUT(P : in PREPOSITION_RECORD);
procedure GET(S : in STRING; P : out PREPOSITION_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PREPOSITION_RECORD);
end PREPOSITION_RECORD_IO;
type CONJUNCTION_RECORD is
record
null;
end record;
package CONJUNCTION_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; C : out CONJUNCTION_RECORD);
procedure GET(C : out CONJUNCTION_RECORD);
procedure PUT(F : in FILE_TYPE; C : in CONJUNCTION_RECORD);
procedure PUT(C : in CONJUNCTION_RECORD);
procedure GET(S : in STRING; C : out CONJUNCTION_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; C : in CONJUNCTION_RECORD);
end CONJUNCTION_RECORD_IO;
type INTERJECTION_RECORD is
record
null;
end record;
package INTERJECTION_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; I : out INTERJECTION_RECORD);
procedure GET(I : out INTERJECTION_RECORD);
procedure PUT(F : in FILE_TYPE; I : in INTERJECTION_RECORD);
procedure PUT(I : in INTERJECTION_RECORD);
procedure GET(S : in STRING; I : out INTERJECTION_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; I : in INTERJECTION_RECORD);
end INTERJECTION_RECORD_IO;
-- TACKON, PREFIX, SUFFIX are nulls put in to allow easy printing later
type TACKON_RECORD is
record
null;
end record;
NULL_TACKON_RECORD : TACKON_RECORD;
package TACKON_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; I : out TACKON_RECORD);
procedure GET(I : out TACKON_RECORD);
procedure PUT(F : in FILE_TYPE; I : in TACKON_RECORD);
procedure PUT(I : in TACKON_RECORD);
procedure GET(S : in STRING; I : out TACKON_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; I : in TACKON_RECORD);
end TACKON_RECORD_IO;
type PREFIX_RECORD is
record
null;
end record;
NULL_PREFIX_RECORD : PREFIX_RECORD;
package PREFIX_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PREFIX_RECORD);
procedure GET(P : out PREFIX_RECORD);
procedure PUT(F : in FILE_TYPE; P : in PREFIX_RECORD);
procedure PUT(P : in PREFIX_RECORD);
procedure GET(S : in STRING; P : out PREFIX_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PREFIX_RECORD);
end PREFIX_RECORD_IO;
type SUFFIX_RECORD is
record
null;
end record;
NULL_SUFFIX_RECORD : SUFFIX_RECORD;
package SUFFIX_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out SUFFIX_RECORD);
procedure GET(P : out SUFFIX_RECORD);
procedure PUT(F : in FILE_TYPE; P : in SUFFIX_RECORD);
procedure PUT(P : in SUFFIX_RECORD);
procedure GET(S : in STRING; P : out SUFFIX_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in SUFFIX_RECORD);
end SUFFIX_RECORD_IO;
type QUALITY_RECORD(POFS : PART_OF_SPEECH_TYPE := X) is
record
case POFS is
when N =>
N : NOUN_RECORD;
when PRON =>
PRON : PRONOUN_RECORD;
when PACK =>
PACK : PROPACK_RECORD;
when ADJ =>
ADJ : ADJECTIVE_RECORD;
when NUM =>
NUM : NUMERAL_RECORD;
when ADV =>
ADV : ADVERB_RECORD;
when V =>
V : VERB_RECORD;
when VPAR =>
VPAR : VPAR_RECORD;
when SUPINE =>
SUPINE : SUPINE_RECORD;
when PREP =>
PREP : PREPOSITION_RECORD;
when CONJ =>
CONJ : CONJUNCTION_RECORD;
when INTERJ =>
INTERJ : INTERJECTION_RECORD;
when TACKON =>
TACKON : TACKON_RECORD;
when PREFIX =>
PREFIX : PREFIX_RECORD;
when SUFFIX =>
SUFFIX : SUFFIX_RECORD;
when others =>
null;
end case;
end record;
NULL_QUALITY_RECORD : QUALITY_RECORD;
function "<" (LEFT, RIGHT : QUALITY_RECORD) return BOOLEAN;
package QUALITY_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out QUALITY_RECORD);
procedure GET(P : out QUALITY_RECORD);
procedure PUT(F : in FILE_TYPE; P : in QUALITY_RECORD);
procedure PUT(P : in QUALITY_RECORD);
procedure GET(S : in STRING; P : out QUALITY_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in QUALITY_RECORD);
end QUALITY_RECORD_IO;
type QUALITY_ARRAY is array (INTEGER range <>) of QUALITY_RECORD;
MAX_ENDING_SIZE : constant := 7;
subtype ENDING_SIZE_TYPE is INTEGER range 0..MAX_ENDING_SIZE;
ENDING_SIZE_TYPE_IO_DEFAULT_WIDTH : INTEGER := 3;
subtype ENDING is STRING(1..MAX_ENDING_SIZE);
type ENDING_RECORD is
record
SIZE : ENDING_SIZE_TYPE := 0;
SUF : ENDING := (others => ' ');
end record;
package ENDING_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; X : out ENDING_RECORD);
procedure GET(X : out ENDING_RECORD);
procedure PUT(F : in FILE_TYPE; X : in ENDING_RECORD);
procedure PUT(X : in ENDING_RECORD);
procedure GET(S : in STRING; X : out ENDING_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; X : in ENDING_RECORD);
end ENDING_RECORD_IO;
NULL_ENDING_RECORD : ENDING_RECORD;
type AGE_TYPE is (
X, -- -- In use throughout the ages/unknown -- the default
A, -- archaic -- Very early forms, obsolete by classical times
B, -- early -- Early Latin, pre-classical, used for effect/poetry
C, -- classical -- Limited to classical (~150 BC - 200 AD)
D, -- late -- Late, post-classical (3rd-5th centuries)
E, -- later -- Latin not in use in Classical times (6-10), Christian
F, -- medieval -- Medieval (11th-15th centuries)
G, -- scholar -- Latin post 15th - Scholarly/Scientific (16-18)
H -- modern -- Coined recently, words for new things (19-20)
);
package AGE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(AGE_TYPE);
type FREQUENCY_TYPE is ( -- For dictionary entries
X, -- -- Unknown or unspecified
A, -- very freq -- Very frequent, in all Elementry Latin books
B, -- frequent -- Frequent, in top 10 percent
C, -- common -- For Dictionary, in top 10,000 words
D, -- lesser -- For Dictionary, in top 20,000 words
E, -- uncommon -- 2 or 3 citations
F, -- very rare -- Having only single citation in OLD or L+S
I, -- inscription -- Only citation is inscription
M, -- graffiti -- Presently not much used
N -- Pliny -- Things that appear (almost) only in Pliny Natural History
);
-- For inflections, the same type is used with different weights
-- X, -- -- Unknown or unspecified
-- A, -- most freq -- Very frequent, the most common
-- B, -- sometimes -- sometimes, a not unusual VARIANT
-- C, -- uncommon -- occasionally seen
-- D, -- infrequent -- recognizable variant, but unlikely
-- E, -- rare -- for a few cases, very unlikely
-- F, -- very rare -- singular examples,
-- I, -- inscription -- Only citation is inscription
-- M, -- -- Presently not used
-- N -- -- Presently not used
package FREQUENCY_TYPE_IO is new TEXT_IO.ENUMERATION_IO(FREQUENCY_TYPE);
type INFLECTION_RECORD is
record
QUAL : QUALITY_RECORD := NULL_QUALITY_RECORD;
KEY : STEM_KEY_TYPE := 0;
ENDING : ENDING_RECORD := NULL_ENDING_RECORD;
AGE : AGE_TYPE := X;
FREQ : FREQUENCY_TYPE := X;
end record;
NULL_INFLECTION_RECORD : INFLECTION_RECORD;
package INFLECTION_RECORD_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out INFLECTION_RECORD);
procedure GET(P : out INFLECTION_RECORD);
procedure PUT(F : in FILE_TYPE; P : in INFLECTION_RECORD);
procedure PUT(P : in INFLECTION_RECORD);
procedure GET(S : in STRING; P : out INFLECTION_RECORD; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in INFLECTION_RECORD);
end INFLECTION_RECORD_IO;
-- This implies a knowledge of the inflections last character
subtype INFLECTIONS_SECTION_1 is CHARACTER range 'a'..'i';
subtype INFLECTIONS_SECTION_2 is CHARACTER range 'm'..'r';
subtype INFLECTIONS_SECTION_3 is CHARACTER range 's'..'s';
subtype INFLECTIONS_SECTION_4 is CHARACTER range 't'..'u';
SIZE_OF_BLANK_INFLECTIONS : constant INTEGER := 80; -- ############
SIZE_OF_INFLECTIONS_SECTION : constant INTEGER := 570; -- ############
type INFLECTION_ARRAY is array (POSITIVE range <>) of INFLECTION_RECORD;
subtype LEL_SECTION is INFLECTION_ARRAY(1..SIZE_OF_INFLECTIONS_SECTION);
package LEL_SECTION_IO is new DIRECT_IO(LEL_SECTION);
BEL : INFLECTION_ARRAY(1..SIZE_OF_BLANK_INFLECTIONS);
LEL : LEL_SECTION;
type INFLECTION_ARRAY_INDEX is array (INTEGER range <>,
CHARACTER range <>) of INTEGER;
BELF, BELL : INFLECTION_ARRAY_INDEX(0..0, ' '..' ') := (0 => (others => 0));
LELF, LELL : INFLECTION_ARRAY_INDEX(1..MAX_ENDING_SIZE,
'a'..'z') := (others => (others => 0));
PELF, PELL : INFLECTION_ARRAY_INDEX(1..MAX_ENDING_SIZE,
'a'..'z') := (others => (others => 0));
NUMBER_OF_INFLECTIONS : INTEGER := 0;
procedure ESTABLISH_INFLECTIONS_SECTION;
-- <= means for this purpose "contained in"
function "<=" (LEFT, RIGHT : PART_OF_SPEECH_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : DECN_RECORD) return BOOLEAN;
function "<=" (LEFT, RIGHT : GENDER_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : CASE_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : NUMBER_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : PERSON_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : COMPARISON_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : TENSE_VOICE_MOOD_RECORD) return BOOLEAN;
function "<=" (LEFT, RIGHT : NOUN_KIND_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : PRONOUN_KIND_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : STEM_KEY_TYPE) return BOOLEAN; -- not verbs
function "<=" (LEFT, RIGHT : AGE_TYPE) return BOOLEAN;
function "<=" (LEFT, RIGHT : FREQUENCY_TYPE) return BOOLEAN;
GIVE_UP : exception;
end INFLECTIONS_PACKAGE;

21
latin_file_names.adb Normal file
View File

@@ -0,0 +1,21 @@
package body LATIN_FILE_NAMES is
function ADD_FILE_NAME_EXTENSION(NAME, EXTENSION : STRING) return STRING is
-- This is the version that creates a DOS file name
-- One that has a name, a '.', and an extension no longer than 3 characters
-- Arbitarily, we also truncate the NAME to 8 characters
-- To port to another system, one needs to do this function appropriately
NAME_LENGTH : INTEGER := NAME'LENGTH;
EXTENSION_LENGTH : INTEGER := EXTENSION'LENGTH;
begin
if NAME_LENGTH >= 8 then
NAME_LENGTH := 8;
end if;
if EXTENSION'LENGTH >= 3 then
EXTENSION_LENGTH := 3;
end if;
return NAME(1..NAME_LENGTH) & '.' & EXTENSION(1..EXTENSION_LENGTH);
end ADD_FILE_NAME_EXTENSION;
end LATIN_FILE_NAMES;

57
latin_file_names.ads Normal file
View File

@@ -0,0 +1,57 @@
package LATIN_FILE_NAMES is
-- In order to port the program LATIN to another system, the file names
-- must be made consistent with that system.
-- This package is withed into all units that declare external file names
-- and its modification should take care of the system dependence of names
-- Then one needs to copy the ASCII data files on the disk to files named
-- in accordance with the modified package.
-- Note that there are some files that take extensions in DOS, and there
-- is a function that takes those extensions and makes a legal file name.
-- In other systems this will have to be handled to create a legal file name
-- This package can be presented as the first to be compiled, however
-- the actual need for file mames does not come until deep in the system
-- Conventionally, the naming is put off until the file is actually
-- used, and the name is passed as a parameter from there to the
-- earlier procedures which call them
-- The following files are used in the DOS LATIN program and are
-- DOS legal, names no longer than 8 characters, with '.' and extension
-- Single files, that is, that need only the one FULL name, no variations
-- These files are input files and may have any name legal in your system
-- and contain the ASCII information copied from the porting system
INFLECTIONS_FULL_NAME : constant STRING := "INFLECTS.LAT";
INFLECTIONS_SECTIONS_NAME : constant STRING := "INFLECTS.SEC";
UNIQUES_FULL_NAME : constant STRING := "UNIQUES.LAT";
ADDONS_FULL_NAME : constant STRING := "ADDONS.LAT";
-- These files may be created and used by the program
MODE_FULL_NAME : constant STRING := "WORD.MOD";
OUTPUT_FULL_NAME : constant STRING := "WORD.OUT";
UNKNOWNS_FULL_NAME : constant STRING := "WORD.UNK";
PARSE_FULL_NAME : constant STRING := "WORD.PRS";
-- These file names are used with extensions (e.g., GEN, SPE, LOC)
-- for the various dictionaries
-- The function ADD_FILE_NAME_EXTENSION below is used to create
-- a full file name
-- Note that for DOS they are not complete names (no '.')
-- but DOS is forgiving and will give it a pass
DICTIONARY_FILE_NAME : constant STRING := "DICT";
DICT_FILE_NAME : constant STRING := "DICTFILE";
DICT_LINE_NAME : constant STRING := "DICTLINE";
STEM_LIST_NAME : constant STRING := "STEMLIST";
STEM_FILE_NAME : constant STRING := "STEMFILE";
INDX_FILE_NAME : constant STRING := "INDXFILE";
function ADD_FILE_NAME_EXTENSION(NAME, EXTENSION : STRING) return STRING;
-- This is the function that creates a file name legal for your system
-- with a FILE_NAME defined above and a program specified extension
end LATIN_FILE_NAMES;

1032
line_stuff.adb Normal file
View File

File diff suppressed because it is too large Load Diff

114
line_stuff.ads Normal file
View File

@@ -0,0 +1,114 @@
with TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
with ADDONS_PACKAGE; use ADDONS_PACKAGE;
with UNIQUES_PACKAGE; use UNIQUES_PACKAGE;
package LINE_STUFF is
use TEXT_IO;
type DICTIONARY_ITEM;
type DICTIONARY_LIST is access DICTIONARY_ITEM;
type DICTIONARY_ITEM is
record
DE : DICTIONARY_ENTRY := NULL_DICTIONARY_ENTRY;
SUCC : DICTIONARY_LIST;
end record;
type DICTIONARY is array (CHARACTER) of DICTIONARY_LIST;
NULL_DICTIONARY : DICTIONARY := (others => null);
--DICT, UNIQUES, QUES : DICTIONARY := NULL_DICTIONARY;
DICT, UNIQUES : DICTIONARY := NULL_DICTIONARY;
DICT_LOC : DICTIONARY := NULL_DICTIONARY;
type TACKON_LINE is
record
POFS : PART_OF_SPEECH_TYPE := TACKON;
TACK : STEM_TYPE := NULL_STEM_TYPE;
ENTR : TACKON_ENTRY := NULL_TACKON_ENTRY;
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
end record;
NULL_TACKON_LINE : TACKON_LINE;
package TACKON_LINE_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out TACKON_LINE);
procedure GET(P : out TACKON_LINE);
procedure PUT(F : in FILE_TYPE; P : in TACKON_LINE);
procedure PUT(P : in TACKON_LINE);
procedure GET(S : in STRING; P : out TACKON_LINE; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in TACKON_LINE);
end TACKON_LINE_IO;
type PREFIX_LINE is
record
POFS : PART_OF_SPEECH_TYPE := PREFIX;
FIX : FIX_TYPE := NULL_FIX_TYPE;
CONNECT : CHARACTER := ' ';
ENTR : PREFIX_ENTRY := NULL_PREFIX_ENTRY;
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
end record;
NULL_PREFIX_LINE : PREFIX_LINE;
package PREFIX_LINE_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out PREFIX_LINE);
procedure GET(P : out PREFIX_LINE);
procedure PUT(F : in FILE_TYPE; P : in PREFIX_LINE);
procedure PUT(P : in PREFIX_LINE);
procedure GET(S : in STRING; P : out PREFIX_LINE; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in PREFIX_LINE);
end PREFIX_LINE_IO;
type SUFFIX_LINE is
record
POFS : PART_OF_SPEECH_TYPE := SUFFIX;
FIX : FIX_TYPE := NULL_FIX_TYPE;
CONNECT : CHARACTER := ' ';
ENTR : SUFFIX_ENTRY := NULL_SUFFIX_ENTRY;
MEAN : MEANING_TYPE := NULL_MEANING_TYPE;
end record;
NULL_SUFFIX_LINE : SUFFIX_LINE;
package SUFFIX_LINE_IO is
DEFAULT_WIDTH : NATURAL;
procedure GET(F : in FILE_TYPE; P : out SUFFIX_LINE);
procedure GET(P : out SUFFIX_LINE);
procedure PUT(F : in FILE_TYPE; P : in SUFFIX_LINE);
procedure PUT(P : in SUFFIX_LINE);
procedure GET(S : in STRING; P : out SUFFIX_LINE; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in SUFFIX_LINE);
end SUFFIX_LINE_IO;
type UNIQUE_ENTRY is
record
STEM : STEM_TYPE := NULL_STEM_TYPE;
QUAL : QUALITY_RECORD := NULL_QUALITY_RECORD;
KIND : KIND_ENTRY := NULL_KIND_ENTRY;
TRAN : TRANSLATION_RECORD := NULL_TRANSLATION_RECORD;
end record;
package UNIQUE_ENTRY_IO is
DEFAULT_WIDTH : FIELD;
procedure GET(F : in FILE_TYPE; P : out UNIQUE_ENTRY);
procedure GET(P : out UNIQUE_ENTRY);
procedure PUT(F : in FILE_TYPE; P : in UNIQUE_ENTRY);
procedure PUT(P : in UNIQUE_ENTRY);
procedure GET(S : in STRING; P : out UNIQUE_ENTRY; LAST : out INTEGER);
procedure PUT(S : out STRING; P : in UNIQUE_ENTRY);
end UNIQUE_ENTRY_IO;
procedure LOAD_STEM_FILE(D_K : DICTIONARY_KIND);
procedure LOAD_DICTIONARY(DICT : in out DICTIONARY;
DICTIONARY_FILE_NAME : STRING);
procedure LOAD_UNIQUES(UNQ : in out LATIN_UNIQUES; FILE_NAME : in STRING);
end LINE_STUFF;

1598
list_package.adb Normal file
View File

File diff suppressed because it is too large Load Diff

28
list_package.ads Normal file
View File

@@ -0,0 +1,28 @@
with TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
package LIST_PACKAGE is
-- SCROLL_LINE_NUMBER : INTEGER := 0;
-- OUTPUT_SCROLL_COUNT : INTEGER := 0;
--
procedure LIST_STEMS(OUTPUT : TEXT_IO.FILE_TYPE;
RAW_WORD : STRING;
INPUT_LINE : STRING;
PA : in out PARSE_ARRAY;
PA_LAST : in out INTEGER);
procedure LIST_ENTRY(OUTPUT : TEXT_IO.FILE_TYPE;
D_K : DICTIONARY_KIND;
MN : DICT_IO.COUNT);
procedure UNKNOWN_SEARCH(UNKNOWN : in STRING;
UNKNOWN_COUNT : out DICT_IO.COUNT);
procedure LIST_NEIGHBORHOOD(OUTPUT : TEXT_IO.FILE_TYPE; INPUT_WORD : STRING);
end LIST_PACKAGE;

910
list_sweep.adb Normal file
View 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;

478
makedict.adb Normal file
View File

@@ -0,0 +1,478 @@
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;
procedure MAKEDICT is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
use TEXT_IO;
use STEM_KEY_TYPE_IO;
use DICTIONARY_ENTRY_IO;
use PART_ENTRY_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 DICT_IO;
PORTING : constant BOOLEAN := TRUE;
BE_VE : VERB_ENTRY := (CON => (5, 1), KIND => TO_BE);
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;
DICTFILE : DICT_IO.FILE_TYPE;
INPUT, STEMLIST : TEXT_IO.FILE_TYPE;
DE : DICTIONARY_ENTRY;
S, LINE, BLANK_LINE : STRING(1..400) := (others => ' ');
L, LL, LAST : INTEGER := 0;
J : DICT_IO.COUNT := 0;
MEAN_TO_BE : constant MEANING_TYPE :=
HEAD("be; exist; (also used to form verb perfect passive tenses)" &
" with NOM PERF PPL", MAX_MEANING_SIZE);
begin
PUT_LINE(
"Takes a DICTLINE.D_K and produces a STEMLIST.D_K and DICTFILE.D_K");
PUT_LINE("This version inserts ESSE when D_K = GEN");
PUT("What dictionary to list, GENERAL or SPECIAL (Reply G or S) =>");
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;
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;
OPEN(INPUT, IN_FILE, ADD_FILE_NAME_EXTENSION(DICT_LINE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
if not PORTING then
CREATE(STEMLIST, OUT_FILE, ADD_FILE_NAME_EXTENSION(STEM_LIST_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
end if;
CREATE(DICTFILE, OUT_FILE, ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
-- if D_K = GENERAL then
-- PUT_LINE("WAKEDICT reads DICTLINE.d_k and produces DICTFILE.d_k");
-- PUT_LINE("WAKEDICT also produces STEMLIST.d_k");
-- PUT_LINE("This version inserts ESSE when d_k = GEN");
--
-- J := J + 1;
--
-- -- First construct ESSE
-- DE.STEMS(1) := "s ";
-- DE.STEMS(2) := " ";
-- DE.STEMS(3) := "fu ";
-- DE.STEMS(4) := "fut ";
-- --DE.PART := (PART => V, CON => (5, 10));
-- --DE.PART := (V, ((5, 1)));
-- DE.PART := (V, BE_VE);
-- DE.KIND := (V, TO_BE);
-- DE.TRAN := (X, X, X, A, X);
-- DE.MEAN := MEAN_TO_BE;
--
--
-- if not PORTING then
-- -- Load ESSE
-- for I in STEM_KEY_TYPE range 1..4 loop
-- PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 50);
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end loop;
-- end if;
--
-- WRITE(DICTFILE, DE, J); -- J = 1
-- 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
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.PART.POFS.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("Exception");
PUT_LINE(S(1..LAST));
INTEGER_IO.PUT(INTEGER(J)); NEW_LINE;
PUT(DE); NEW_LINE;
end FORM_DE;
J := J + 1;
WRITE(DICTFILE, DE, J);
if not PORTING then
if DE.PART.POFS = N and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
-- PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end if;
-- if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
-- PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end if;
elsif DE.PART.POFS = ADJ and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
elsif DE.PART.POFS = ADJ and then
-- POS taken care of by position
DE.PART.ADJ.CO = COMP then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADJ and then
DE.PART.ADJ.CO = SUPER then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADV and then
-- POS taken care of by position
DE.PART.ADV.CO = COMP then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 2, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADV and then
DE.PART.ADV.CO = SUPER then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = V and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = CARD then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 1, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = ORD then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 2, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = DIST then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = ADVERB then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
else
for I in STEM_KEY_TYPE range 1..4 loop
if DE.STEMS(I) /= ZZZ_STEM and
DE.STEMS(I) /= NULL_STEM_TYPE then
PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
end loop;
end if;
end if; -- PORTING
end if;
end loop OVER_LINES;
if D_K = GENERAL then
J := J + 1;
-- First construct ESSE
DE.STEMS(1) := "s ";
DE.STEMS(2) := " ";
DE.STEMS(3) := "fu ";
DE.STEMS(4) := "fut ";
--DE.PART := (PART => V, CON => (5, 10));
--DE.PART := (V, ((5, 1)));
DE.PART := (V, BE_VE);
--DE.KIND := (V, TO_BE);
DE.TRAN := (X, X, X, A, X);
DE.MEAN := MEAN_TO_BE;
if not PORTING then
-- Load ESSE
for I in STEM_KEY_TYPE range 1..4 loop
PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end loop;
end if;
WRITE(DICTFILE, DE, J);
end if;
if not PORTING then
CLOSE(STEMLIST);
end if;
exception
when TEXT_IO.DATA_ERROR =>
null;
when others =>
PUT_LINE(S(1..LAST));
INTEGER_IO.PUT(INTEGER(J)); NEW_LINE;
CLOSE(STEMLIST);
end MAKEDICT;

52
makeefil.adb Normal file
View File

@@ -0,0 +1,52 @@
with TEXT_IO;
with ENGLISH_SUPPORT_PACKAGE; use ENGLISH_SUPPORT_PACKAGE;
procedure MAKEEFIL is
use TEXT_IO;
use EWDS_DIRECT_IO;
EWDS_LIST : TEXT_IO.FILE_TYPE;
EWDS, NEW_EWDS : EWDS_RECORD := NULL_EWDS_RECORD;
begin
TEXT_IO.OPEN(EWDS_LIST, TEXT_IO.IN_FILE, "EWDSLIST.GEN");
CREATE(EWDS_FILE, OUT_FILE, "EWDSFILE.GEN");
while not TEXT_IO.END_OF_FILE(EWDS_LIST) loop
EWDS_RECORD_IO.GET(EWDS_LIST, NEW_EWDS);
TEXT_IO.SKIP_LINE(EWDS_LIST);
-- Eliminate doubles -- If sort is OK
if EWDS.W = NEW_EWDS.W and -- AUX ????
EWDS.N = NEW_EWDS.N then
-- PUT_LINE("DOUBLES ");
-- EWDS_RECORD_IO.PUT(EWDS); NEW_LINE;
-- EWDS_RECORD_IO.PUT(NEW_EWDS); NEW_LINE;
if EWDS.KIND > NEW_EWDS.KIND then -- Large KIND = high priority
null;
elsif EWDS.KIND < NEW_EWDS.KIND then
EWDS := NEW_EWDS;
elsif EWDS.KIND = NEW_EWDS.KIND then
if EWDS.SEMI > NEW_EWDS.SEMI then
EWDS := NEW_EWDS;
end if;
end if;
else
WRITE(EWDS_FILE, EWDS);
EWDS := NEW_EWDS;
NUMBER_OF_EWORDS := NUMBER_OF_EWORDS + 1;
end if;
--PUT('.');
end loop;
CLOSE(EWDS_FILE);
TEXT_IO.NEW_LINE;
TEXT_IO.PUT_LINE("NUMBER_OF_EWORDS = " & INTEGER'IMAGE(NUMBER_OF_EWORDS));
exception
when others =>
CLOSE(EWDS_FILE);
TEXT_IO.NEW_LINE;
TEXT_IO.PUT_LINE("MAKEEFIL terminated on an exception");
TEXT_IO.PUT_LINE("NUMBER_OF_EWORDS = " & INTEGER'IMAGE(NUMBER_OF_EWORDS));
end MAKEEFIL;

875
makeewds.adb Normal file
View 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;

362
makeinfl.adb Normal file
View File

@@ -0,0 +1,362 @@
with TEXT_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with IO_EXCEPTIONS;
procedure MAKEINFL is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
use TEXT_IO;
use INTEGER_IO;
use STEM_KEY_TYPE_IO;
use INFLECTION_RECORD_IO;
use QUALITY_RECORD_IO;
use ENDING_RECORD_IO;
use AGE_TYPE_IO;
use FREQUENCY_TYPE_IO;
use LEL_SECTION_IO;
PORTING : constant BOOLEAN := TRUE; --FALSE for WAKEINFL;
M, N : INTEGER := 0;
N1, N2, N3, N4, N5 : INTEGER := 0;
OUTPUT : TEXT_IO.FILE_TYPE;
INFLECTIONS_SECTIONS_FILE : LEL_SECTION_IO.FILE_TYPE;
procedure FILE_INFLECTIONS_SECTIONS is
-- Reads the INFLECTS. file and prepares an inflections list
-- Then it writes that list into an array
-- Loads the inflection array into a file for later retrieval
use TEXT_IO;
use INFLECTION_RECORD_IO;
use INTEGER_IO;
INFLECTIONS_FILE : TEXT_IO.FILE_TYPE;
INFLECTIONS_SECTIONS_FILE : LEL_SECTION_IO.FILE_TYPE;
IR : INFLECTION_RECORD;
LINE, BLANKS : STRING(1..100) := (others => ' ');
LAST, L : INTEGER := 0;
SN : ENDING_SIZE_TYPE := ENDING_SIZE_TYPE'FIRST;
SX : CHARACTER := ' ';
type INFLECTION_ITEM;
type INFLECTION_LIST is access INFLECTION_ITEM;
type INFLECTION_ITEM is
record
IR : INFLECTION_RECORD;
SUCC : INFLECTION_LIST;
end record;
type LATIN_INFLECTIONS is array (INTEGER range 0..MAX_ENDING_SIZE,
CHARACTER range ' '..'z') of INFLECTION_LIST;
NULL_LATIN_INFLECTIONS : LATIN_INFLECTIONS := (others => (others => null));
L_I : LATIN_INFLECTIONS := NULL_LATIN_INFLECTIONS;
LEL : LEL_SECTION := (others => NULL_INFLECTION_RECORD);
J1, J2, J3, J4, J5 : INTEGER := 0;
procedure NULL_LEL is
begin
for I in LEL'RANGE loop
LEL(I) := NULL_INFLECTION_RECORD;
end loop;
end NULL_LEL;
procedure LOAD_INFLECTIONS_LIST is
-- Takes the INFLECT. file and populates the L_I list of inflections
-- indexed on ending size and last letter of ending
begin
PUT_LINE("Begin LOAD_INFLECTIONS_LIST");
NUMBER_OF_INFLECTIONS := 0;
L_I := NULL_LATIN_INFLECTIONS;
OPEN(INFLECTIONS_FILE, IN_FILE, INFLECTIONS_FULL_NAME);
TEXT_IO.PUT("INFLECTIONS file loading");
while not END_OF_FILE(INFLECTIONS_FILE) loop
READ_A_LINE:
begin
GET_NON_COMMENT_LINE(INFLECTIONS_FILE, LINE, LAST);
if LAST > 0 then
GET(LINE(1..LAST), IR, L);
SN := IR.ENDING.SIZE;
if SN = 0 then
SX := ' ';
else
SX := IR.ENDING.SUF(SN);
end if;
L_I(SN, SX) := new INFLECTION_ITEM'(IR, L_I(SN, SX));
NUMBER_OF_INFLECTIONS := NUMBER_OF_INFLECTIONS + 1;
--TEXT_IO.PUT(INTEGER'IMAGE(NUMBER_OF_INFLECTIONS) & " "); INFLECTION_RECORD_IO.PUT(IR); NEW_LINE;
end if;
exception
when CONSTRAINT_ERROR | IO_EXCEPTIONS.DATA_ERROR =>
PUT_LINE("****" & LINE(1..LAST));
end READ_A_LINE;
end loop;
CLOSE(INFLECTIONS_FILE);
PUT_LINE("INFLECTIONS_LIST LOADED " & INTEGER'IMAGE(NUMBER_OF_INFLECTIONS));
end LOAD_INFLECTIONS_LIST;
procedure LIST_TO_LEL_FILE is
-- From ILC (=L_I) list of inflections, prepares the LEL inflections array
use LEL_SECTION_IO;
I : INTEGER := 0;
ILC : LATIN_INFLECTIONS := L_I;
begin
CREATE(INFLECTIONS_SECTIONS_FILE, OUT_FILE, INFLECTIONS_SECTIONS_NAME);
NULL_LEL;
ILC := L_I; -- Resetting the list to start over
while ILC(0, ' ') /= null loop
J5 := J5 + 1;
LEL(J5) := ILC(0, ' ').IR;
ILC(0, ' ') := ILC(0, ' ').SUCC;
end loop;
WRITE(INFLECTIONS_SECTIONS_FILE, LEL, 5);
N5 := J5;
NULL_LEL;
ILC := L_I; -- Resetting the list to start over
for CH in CHARACTER range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
while ILC(N, CH) /= null loop
if not
(ILC(N, CH).IR.QUAL.POFS = PRON and then
(ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 1 or
ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 2)) then
if CH in INFLECTIONS_SECTION_1 then
J1 := J1 + 1;
LEL(J1) := ILC(N, CH).IR;
end if;
end if;
ILC(N, CH) := ILC(N, CH).SUCC;
end loop;
end loop;
end loop;
WRITE(INFLECTIONS_SECTIONS_FILE, LEL, 1);
N1 := J1;
NULL_LEL;
ILC := L_I; -- Resetting the list to start over
for CH in CHARACTER range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
while ILC(N, CH) /= null loop
if not
(ILC(N, CH).IR.QUAL.POFS = PRON and then
(ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 1 or
ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 2)) then
if CH in INFLECTIONS_SECTION_2 then
J2 := J2 + 1;
LEL(J2) := ILC(N, CH).IR;
end if;
end if;
ILC(N, CH) := ILC(N, CH).SUCC;
end loop;
end loop;
end loop;
WRITE(INFLECTIONS_SECTIONS_FILE, LEL, 2);
N2 := J2;
NULL_LEL;
ILC := L_I; -- Resetting the list to start over
for CH in CHARACTER range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
while ILC(N, CH) /= null loop
if not
(ILC(N, CH).IR.QUAL.POFS = PRON and then
(ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 1 or
ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 2)) then
if CH in INFLECTIONS_SECTION_3 then
J3 := J3 + 1;
LEL(J3) := ILC(N, CH).IR;
end if;
end if;
ILC(N, CH) := ILC(N, CH).SUCC;
end loop;
end loop;
end loop;
WRITE(INFLECTIONS_SECTIONS_FILE, LEL, 3);
N3 := J3;
NULL_LEL;
ILC := L_I; -- Resetting the list to start over
for CH in CHARACTER range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
while ILC(N, CH) /= null loop
if not
(ILC(N, CH).IR.QUAL.POFS = PRON and then
(ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 1 or
ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 2)) then
if (CH in INFLECTIONS_SECTION_4) then
J4 := J4 + 1;
LEL(J4) := ILC(N, CH).IR;
end if;
end if;
ILC(N, CH) := ILC(N, CH).SUCC;
end loop;
end loop;
end loop;
-- Now put the PACK in 4 -- Maybe it should be in 5 ????
ILC := L_I; -- Resetting the list to start over
for CH in CHARACTER range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
while ILC(N, CH) /= null loop
if (ILC(N, CH).IR.QUAL.POFS = PRON and then
(ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 1 or
ILC(N, CH).IR.QUAL.PRON.DECL.WHICH = 2)) then -- 2 no longer PACK
J4 := J4 + 1;
LEL(J4) := ILC(N, CH).IR;
end if;
ILC(N, CH) := ILC(N, CH).SUCC;
end loop;
end loop;
end loop;
WRITE(INFLECTIONS_SECTIONS_FILE, LEL, 4);
N4 := J4;
CLOSE(INFLECTIONS_SECTIONS_FILE);
end LIST_TO_LEL_FILE;
begin
LOAD_INFLECTIONS_LIST;
TEXT_IO.SET_COL(33);
TEXT_IO.PUT("-- ");
INTEGER_IO.PUT(NUMBER_OF_INFLECTIONS);
TEXT_IO.PUT_LINE(" entries -- Loaded correctly");
LIST_TO_LEL_FILE; -- Load arrays to file
TEXT_IO.PUT_LINE("File INFLECTS.SEC -- Loaded");
exception
when others =>
TEXT_IO.PUT_LINE("Exception in FILE_INFLECTIONS_SECTIONS");
end FILE_INFLECTIONS_SECTIONS;
use INFLECTIONS_PACKAGE;
begin
PUT_LINE("Produces INFLECTS.SEC file from INFLECTS.");
FILE_INFLECTIONS_SECTIONS;
if not PORTING then
PUT_LINE("using FILE_INFLECTIONS_SECTIONS, also produces INFLECTS.LIN file");
CREATE(OUTPUT, OUT_FILE, "INFLECTS.LIN");
end if;
ESTABLISH_INFLECTIONS_SECTION;
LEL_SECTION_IO.OPEN(INFLECTIONS_SECTIONS_FILE, IN_FILE,
INFLECTIONS_SECTIONS_NAME);
if not PORTING then
for I in BEL'RANGE loop -- Blank endings
if BEL(I) /= NULL_INFLECTION_RECORD then
M := M + 1;
PUT(OUTPUT, BEL(I).QUAL);
SET_COL(OUTPUT, 50);
PUT(OUTPUT, BEL(I).KEY, 1);
SET_COL(OUTPUT, 52);
PUT(OUTPUT, BEL(I).ENDING);
SET_COL(OUTPUT, 62);
PUT(OUTPUT, BEL(I).AGE);
SET_COL(OUTPUT, 64);
PUT(OUTPUT, BEL(I).FREQ);
NEW_LINE(OUTPUT);
end if;
end loop;
end if;
for N in 1..4 loop
READ(INFLECTIONS_SECTIONS_FILE, LEL, LEL_SECTION_IO.POSITIVE_COUNT(N));
if not PORTING then
for I in LEL'RANGE loop -- Non-blank endings
if LEL(I) /= NULL_INFLECTION_RECORD then
M := M + 1;
PUT(OUTPUT, LEL(I).QUAL);
SET_COL(OUTPUT, 50);
PUT(OUTPUT, LEL(I).KEY, 1);
SET_COL(OUTPUT, 52);
PUT(OUTPUT, LEL(I).ENDING);
SET_COL(OUTPUT, 62);
PUT(OUTPUT, LEL(I).AGE);
SET_COL(OUTPUT, 64);
PUT(OUTPUT, LEL(I).FREQ);
NEW_LINE(OUTPUT);
end if;
end loop;
end if;
end loop;
NEW_LINE;
PUT("LINE_INFLECTIONS finds "); PUT(M); PUT_LINE(" inflections"); NEW_LINE;
for I in Character range ' '..' ' loop
INTEGER_IO.PUT(0); PUT(" "); PUT(I); PUT(" "); PUT(BELF(0, I));
PUT(" "); PUT(BELL(0, I));
PUT(" "); PUT(BELL(0, I) - BELF(0, I) + 1); NEW_LINE;
end loop;
NEW_LINE;
for I in Character range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
if (LELL(N, I) > 0) and then (LELF(N, I) <= LELL(N, I)) then
PUT(N); PUT(" "); PUT(I); PUT(" "); PUT(LELF(N, I));
PUT(" "); PUT(LELL(N, I));
PUT(" "); PUT(LELL(N, I) - LELF(N, I) + 1); NEW_LINE;
end if;
end loop;
end loop;
NEW_LINE;
for I in Character range 'a'..'z' loop
for N in reverse 1..MAX_ENDING_SIZE loop
if (PELL(N, I) > 0) and then (PELF(N, I) <= PELL(N, I)) then
PUT(N); PUT(" "); PUT(I); PUT(" "); PUT(PELF(N, I));
PUT(" "); PUT(PELL(N, I));
PUT(" "); PUT(PELL(N, I) - PELF(N, I) + 1); NEW_LINE;
end if;
end loop;
end loop;
NEW_LINE;
NEW_LINE;
PUT(N5); PUT(" ");
PUT(N1); PUT(" ");
PUT(N2); PUT(" ");
PUT(N3); PUT(" ");
PUT(N4); PUT(" ");
NEW_LINE;
end MAKEINFL;

277
makestem.adb Normal file
View File

@@ -0,0 +1,277 @@
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 Word_Support_Package; use Word_Support_Package;
procedure MAKESTEM is
use Integer_Io;
use STEM_KEY_TYPE_IO;
use COUNT_IO;
use Text_IO;
use STEM_IO;
use MNPC_IO;
use Part_Entry_IO;
D_K : Dictionary_Kind := XXX; -- ######################
I : STEM_IO.COUNT := 0;
Line, Blanks : String(1..200) := (others => ' ');
Last, Ll : Integer := 0;
M : STEM_IO.Positive_Count := 1;
Ds : Dictionary_Stem;
Fc, Ofc : Character := ' ';
Sc, Osc : Character := ' ';
procedure Put_Indices(Ch : String;
D_K : Dictionary_Kind) is
Wd : String(1..2) := Ch(1..2);
begin
--Put_Line("Put_Indices");
if Ch = " " then
if (Bblf(Ch(1), Ch(2), D_K) > 0) and then
(Bbll(Ch(1), Ch(2), D_K) >= Bblf(Ch(1), Ch(2), D_K)) then
Put("CH = ("); Put(Ch); Put(") index is of range ");
Put(Bblf(Ch(1), Ch(2), D_K)); Put(".."); Put(Bbll(Ch(1), Ch(2), D_K));
Put(" number ");
Put(Bbll(Ch(1), Ch(2), D_K) - Bblf(Ch(1), Ch(2), D_K) + 1);
New_Line;
end if;
elsif Ch(2) = ' ' then
if (Bdlf(Ch(1), Ch(2), D_K) > 0) and then
(Bdll(Ch(1), Ch(2), D_K) >= Bdlf(Ch(1), Ch(2), D_K)) then
Put("CH = ("); Put(Ch); Put(") index is of range ");
Put(Bdlf(Ch(1), Ch(2), D_K)); Put(".."); Put(Bdll(Ch(1), Ch(2), D_K));
Put(" number ");
Put(Bdll(Ch(1), Ch(2), D_K) - Bdlf(Ch(1), Ch(2), D_K) + 1);
New_Line;
end if;
else
if (First_Index(Wd, D_K) > 0) and then
(Last_Index(Wd, D_K) >= First_Index(Wd, D_K)) then
Put("CH = ("); Put(Wd); Put(") index is of range ");
Put(First_Index(Wd, D_K)); Put(".."); Put(Last_Index(Wd, D_K));
Put(" number ");
Put(Last_Index(Wd, D_K) - First_Index(Wd, D_K) + 1);
New_Line;
end if;
end if;
end Put_Indices;
begin
Put_Line("Creates STEMFILE.D_K and INDXFILE.D_K from STEMLIST.D_K");
Put("What dictionary to load, 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;
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;
Open( STEM_List(D_K), In_File,
Add_File_Name_Extension(STEM_List_Name,
Dictionary_Kind'Image(D_K)));
Create(STEM_File(D_K), Inout_File,
Add_File_Name_Extension(STEM_File_Name,
Dictionary_Kind'Image(D_K)));
Create(Indx_File(D_K), Out_File,
Add_File_Name_Extension(Indx_File_Name,
Dictionary_Kind'Image(D_K)));
------------------------------------------------------------------
-- This section assumes the blank ESSE stem is first - D_K GENERAL
if D_K = General then
I := I + 1;
Bblf(' ', ' ', General) := I;
Bbll(' ', ' ', General) := 0;
Line := Blanks;
Get_Line(STEM_List(D_K), Line, Last);
PUT_LINE(LINE(1..LAST));
Fc := Line(1);
Sc := Line(2);
Ds.Stem := Line(1..Max_Stem_Size);
--PUT_LINE("#" & LINE(MAX_STEM_SIZE+1..LAST));
Get(Line(Max_Stem_Size+1..Last), Ds.Part, Ll);
--PUT(DS.PART); NEW_LINE;
--PUT_LINE("#" & LINE(LL+1..LAST));
Get(Line(Ll+1..Last), Ds.Key , Ll);
--PUT(DS.KEY ); NEW_LINE;
--PUT_LINE("#" & LINE(LL+1..LAST));
Get(Line(Ll+1..Last), Ds.mnpc , Ll);
--PUT(DS.AAMNPC); NEW_LINE;
Write(STEM_File(D_K), Ds);
Bbll(Fc, Sc, General) := I; -- 1
Put(Indx_File(D_K), " ");
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Bblf(' ', ' ', General));
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Bbll(' ', ' ', General));
Put(Indx_File(D_K), ' ');
New_Line(Indx_File(D_K));
Put_Indices(" ", General);
end if;
------------------------------------------------------------------
Fc := 'a';
Ofc := 'a';
Sc := ' ';
Osc := ' ';
Bdlf(Ofc, ' ', D_K) := I + 1;
--DEBUG.PUT(" bf1 BDLF("); DEBUG.PUT(OFC);
--DEBUG.PUT(' '); DEBUG.PUT(") "); DEBUG.PUT(BDLF(OFC, ' ', D_K));
--DEBUG.NEW_LINE;
First_Character_Loop:
while not End_Of_File(STEM_List(D_K)) loop
--OSC := ' ';
Osc := Sc;
Second_Character_Loop:
while not End_Of_File(STEM_List(D_K)) loop
Inner_Loop:
while not End_Of_File(STEM_List(D_K)) loop
Line := Blanks;
Get_Line(STEM_List(D_K), Line, Last);
--Put_Line("* " & Line(1..Last));
if Trim(Line(1..Last)) = "" then Put_Line("Trim(Line(1..Last)) BLANK"); end if;
exit First_Character_Loop when Trim(Line(1..Last)) = "";
Fc := Lower_Case(Line(1));
Sc := Lower_Case(Line(2));
--------------------------------------------------------------------
if Fc = 'v' then Fc := 'u'; end if;
if Sc = 'v' then Sc := 'u'; end if;
if Fc = 'j' then Fc := 'i'; end if;
if Sc = 'j' then Sc := 'i'; end if;
--------------------------------------------------------------------
I := I + 1;
if Sc = ' ' then
--Put("BDL I -> "); Put(I ); New_Line;
if Fc /= Ofc then
Bdlf(Fc, ' ', D_K) := I;
--Put(" bf2 BDLF("); Put(Fc);Put(' '); Put(") ");
--Put(Bdlf(Fc, ' ', D_K)); New_Line;
end if;
else
null;
--Put("I -> "); Put(I); New_Line;
end if;
Ds.Stem := Line(1..Max_Stem_Size);
Get(Line(Max_Stem_Size+1..Last), Ds.Part, Ll);
Get(Line(Ll+1..Last), Ds.Key , Ll);
Get(Line(Ll+1..Last), Ds.mnpc , Ll);
Write(STEM_File(D_K), Ds);
--Put_Line("Wrote STEMfile");
if Fc /= Ofc then -- Jumped FC, effectively must have jumped a SC
--Put_Line("Jumped FC");
if Osc = ' ' then
Bdll(Ofc, Osc, D_K) := I - 1;
else
Ddll(Ofc, Osc, D_K) := I - 1;
end if;
if Sc = ' ' then
--Put("BDLF "); Put(Bdlf(Fc, Sc, D_K)); New_Line;
Bdlf(Fc, Sc, D_K) := I;
else
Ddlf(Fc, Sc, D_K) := I;
end if;
--Put_Line("if Sc done");
--Put("Ofc = '"); Put(Ofc); Put("' Osc = '"); Put(Osc); Put_Line("'");
Put_Indices(Ofc & Osc, D_K);
Ofc := Fc;
Osc := Sc;
--Put_Line("exit Second_Character_Loop");
exit Second_Character_Loop;
else
if Sc /= Osc then -- Jumped a SC, but not a FC
if Osc = ' ' then -- Jumped a SC from ' ' to something
Bdll(Fc, Osc, D_K) := I - 1; -- So set BDLL
--DEBUG.PUT(" bl1 BDLL("); DEBUG.PUT(FC); DEBUG.PUT(OSC); DEBUG.PUT(") ");
--DEBUG.PUT(BDLL(FC, OSC, D_K)); DEBUG.NEW_LINE;
Ddlf(Fc, Sc, D_K) := I;
--DEBUG.PUT(" df1 DDLF("); DEBUG.PUT( FC); DEBUG.PUT( SC); DEBUG.PUT(") ");
--DEBUG.PUT(DDLF( FC, SC, D_K)); DEBUG.NEW_LINE;
Put_Indices(Fc & Osc, D_K);
Osc := Sc;
exit Inner_Loop;
else -- Jumped a SL from something, not ' '
Ddll(Fc, Osc, D_K) := I - 1; -- So set DDLL
--DEBUG.PUT(" dl2 DDLL("); DEBUG.PUT(FC); DEBUG.PUT(OSC); DEBUG.PUT(") ");
--DEBUG.PUT(DDLL(FC, OSC, D_K)); DEBUG.NEW_LINE;
Ddlf(Fc, Sc, D_K) := I;
--DEBUG.PUT(" df2 DDLF("); DEBUG.PUT( FC); DEBUG.PUT( SC); DEBUG.PUT(") ");
--DEBUG.PUT(DDLF( FC, SC, D_K)); DEBUG.NEW_LINE;
Put_Indices(Fc & Osc, D_K);
Osc := Sc;
exit Inner_Loop;
end if;
end if;
end if;
end loop Inner_Loop;
--Put_Line("Exitted Inner_Loop");
end loop Second_Character_Loop;
--Put_Line("Exitted Second_Character_Loop");
end loop First_Character_Loop;
--Put_Line("Exitted First_Character_Loop");
Ddll(Ofc, Osc, D_K) := I;
-- To reprint correctly the last letter information
--Put_Line("-- To reprint correctly the last letter information");
Put_Indices(Ofc & Osc, D_K);
Close(STEM_File(D_K));
for I in Character'('a')..Character'('z') loop
for J in Character'(' ')..Character'(' ') loop
Text_Io.Put(Indx_File(D_K), (I, J));
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Bdlf(I, J, D_K));
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Bdll(I, J, D_K));
Put(Indx_File(D_K), ' ');
New_Line(Indx_File(D_K));
end loop;
end loop;
for I in Character'('a')..Character'('z') loop
for J in Character'('a')..Character'('z') loop
Text_Io.Put(Indx_File(D_K), (I, J));
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Ddlf(I, J, D_K));
Put(Indx_File(D_K), ' ');
Put(Indx_File(D_K), Ddll(I, J, D_K));
Put(Indx_File(D_K), ' ');
New_Line(Indx_File(D_K));
end loop;
end loop;
Close(Indx_File(D_K));
end MAKESTEM;

145
meanings.adb Normal file
View File

@@ -0,0 +1,145 @@
with Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with CONFIG; use CONFIG;
with WORD_PARAMETERS; use WORD_PARAMETERS;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
with WORD_PACKAGE; use WORD_PACKAGE;
with PARSE;
procedure MEANINGS is
INPUT_LINE : STRING(1..250) := (others => ' ');
ARGUMENTS_START : INTEGER := 1;
begin
-- The language shift in argumants must take place here
-- since later parsing of line ignores non-letter characters
CONFIGURATION := ONLY_MEANINGS;
--The main mode of usage for WORDS is a simple call, followed by screen interaction.
if Ada.Command_Line.ARGUMENT_COUNT = 0 then -- Simple WORDS
METHOD := INTERACTIVE; -- Interactive
SUPPRESS_PREFACE := FALSE;
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
INITIALIZE_WORD_PARAMETERS;
INITIALIZE_DEVELOPER_PARAMETERS;
INITIALIZE_WORD_PACKAGE;
PARSE;
--But there are other, command line options.
--WORDS may be called with arguments on the same line,
--in a number of different modes.
--
else
SUPPRESS_PREFACE := TRUE;
INITIALIZE_WORD_PARAMETERS;
INITIALIZE_DEVELOPER_PARAMETERS;
INITIALIZE_WORD_PACKAGE;
--Single parameter, either a simple Latin word or an input file.
--WORDS amo
--WORDS infile
if Ada.Command_Line.ARGUMENT_COUNT = 1 then -- Input 1 word in-line
ONE_ARGUMENT:
declare
INPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(1));
begin
OPEN(INPUT, IN_FILE, INPUT_NAME); -- Try file name, not raises NAME_ERROR
METHOD := COMMAND_LINE_FILES;
SET_INPUT(INPUT);
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
PARSE; -- No additional arguments, so just go to PARSE now
exception -- Triggers on INPUT
when NAME_ERROR => -- Raised NAME_ERROR therefore
METHOD := COMMAND_LINE_INPUT; -- Found word in command line
end ONE_ARGUMENT;
--With two arguments the options are: inputfile and outputfile,
--two Latin words, or a language shift to English (Latin being the startup default)
--and an English word (with no part of speech).
--WORDS infile outfile
--WORDS amo amas
--WORDS ^e love
elsif Ada.Command_Line.ARGUMENT_COUNT = 2 then -- INPUT and OUTPUT files
TWO_ARGUMENTS: -- or multiwords in-line
declare
INPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(1));
OUTPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(2));
begin
if INPUT_NAME(1) = CHANGE_LANGUAGE_CHARACTER then
if (INPUT_NAME'LENGTH > 1) then
CHANGE_LANGUAGE(INPUT_NAME(2));
ARGUMENTS_START := 2;
METHOD := COMMAND_LINE_INPUT; -- Parse the one word
end if;
else
OPEN(INPUT, IN_FILE, INPUT_NAME);
CREATE(OUTPUT, OUT_FILE, OUTPUT_NAME);
METHOD := COMMAND_LINE_FILES;
SET_INPUT(INPUT);
SET_OUTPUT(OUTPUT);
SUPPRESS_PREFACE := TRUE;
OUTPUT_SCREEN_SIZE := INTEGER'LAST;
PARSE; -- No additional arguments, so just go to PARSE now
SET_INPUT(Ada.TEXT_IO.STANDARD_INPUT); -- Clean up
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
CLOSE(OUTPUT);
end if;
exception -- Triggers on either INPUT or OUTPUT !!!
when NAME_ERROR =>
METHOD := COMMAND_LINE_INPUT; -- Found words in command line
end TWO_ARGUMENTS;
--With three arguments there could be three Latin words or a language shift
--and and English word and part of speech.
--WORDS amo amas amat
--WORDS ^e love v
elsif Ada.Command_Line.ARGUMENT_COUNT = 3 then -- INPUT and OUTPUT files
THREE_ARGUMENTS: -- or multiwords in-line
declare
ARG1 : constant STRING := TRIM(Ada.Command_Line.Argument(1));
ARG2 : constant STRING := TRIM(Ada.Command_Line.Argument(2));
ARG3 : constant STRING := TRIM(Ada.Command_Line.Argument(3));
begin
if ARG1(1) = CHANGE_LANGUAGE_CHARACTER then
if (ARG1'LENGTH > 1) then
CHANGE_LANGUAGE(ARG1(2));
ARGUMENTS_START := 2;
METHOD := COMMAND_LINE_INPUT; -- Parse the one word
end if;
else
METHOD := COMMAND_LINE_INPUT;
end if;
end THREE_ARGUMENTS;
--More than three arguments must all be Latin words.
--WORDS amo amas amat amamus amatis amant
else -- More than three arguments
METHOD := COMMAND_LINE_INPUT;
end if;
if METHOD = COMMAND_LINE_INPUT then -- Process words in command line
MORE_ARGUMENTS:
begin
--Ada.TEXT_IO.PUT_LINE("MORE_ARG ARG_START = " & INTEGER'IMAGE(ARGUMENTS_START));
SUPPRESS_PREFACE := TRUE;
for I in ARGUMENTS_START..Ada.Command_Line.Argument_Count loop -- Assemble input words
INPUT_LINE := HEAD(TRIM(INPUT_LINE) & " " & Ada.Command_Line.Argument(I), 250);
end loop;
--Ada.TEXT_IO.PUT_LINE("To PARSE >" & TRIM(INPUT_LINE));
PARSE(TRIM(INPUT_LINE));
end MORE_ARGUMENTS;
end if;
end if;
end MEANINGS;

1192
parse.adb Normal file
View File

File diff suppressed because it is too large Load Diff

41
preface.adb Normal file
View File

@@ -0,0 +1,41 @@
with CONFIG;
package body PREFACE is
procedure PUT(S : STRING) is
begin
if not CONFIG.SUPPRESS_PREFACE then
TEXT_IO.PUT(TEXT_IO.CURRENT_OUTPUT, S);
end if;
end PUT;
procedure SET_COL(PC : TEXT_IO.POSITIVE_COUNT) is
begin
if not CONFIG.SUPPRESS_PREFACE then
TEXT_IO.SET_COL(TEXT_IO.CURRENT_OUTPUT, PC);
end if;
end SET_COL;
procedure PUT_LINE(S : STRING) is
begin
if not CONFIG.SUPPRESS_PREFACE then
TEXT_IO.PUT_LINE(TEXT_IO.CURRENT_OUTPUT, S);
end if;
end PUT_LINE;
procedure NEW_LINE(SPACING : TEXT_IO.POSITIVE_COUNT := 1) is
begin
if not CONFIG.SUPPRESS_PREFACE then
TEXT_IO.NEW_LINE(TEXT_IO.CURRENT_OUTPUT, SPACING);
end if;
end NEW_LINE;
procedure PUT(N : INTEGER; WIDTH : TEXT_IO.FIELD := INTEGER'WIDTH) is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
begin
if not CONFIG.SUPPRESS_PREFACE then
INTEGER_IO.PUT(TEXT_IO.CURRENT_OUTPUT, N, WIDTH);
end if;
end PUT;
end PREFACE;

9
preface.ads Normal file
View File

@@ -0,0 +1,9 @@
with TEXT_IO;
package PREFACE is
procedure PUT(S: STRING);
procedure SET_COL(PC : TEXT_IO.POSITIVE_COUNT);
procedure PUT_LINE(S : STRING);
procedure NEW_LINE(SPACING : TEXT_IO.POSITIVE_COUNT := 1);
procedure PUT(N : INTEGER; WIDTH : TEXT_IO.FIELD := INTEGER'WIDTH);
end PREFACE;

384
put_example_line.adb Normal file
View File

@@ -0,0 +1,384 @@
with TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
with CONFIG; use CONFIG;
with WORD_PARAMETERS; use WORD_PARAMETERS;
--with LATIN_DEBUG;
procedure PUT_EXAMPLE_LINE(OUTPUT : TEXT_IO.FILE_TYPE; IR : in INFLECTION_RECORD;
DE : in DICTIONARY_ENTRY) is
-- use LATIN_DEBUG;
VK : VERB_KIND_TYPE;
procedure PUT_VERB_EXAMPLE(OUTPUT : TEXT_IO.FILE_TYPE; IR : in INFLECTION_RECORD;
VK : in VERB_KIND_TYPE) is
PERSON : constant PERSON_TYPE := IR.QUAL.V.PERSON;
NUMBER : constant NUMBER_TYPE := IR.QUAL.V.NUMBER;
TENSE : constant TENSE_TYPE := IR.QUAL.V.TENSE_VOICE_MOOD.TENSE;
MOOD : constant MOOD_TYPE := IR.QUAL.V.TENSE_VOICE_MOOD.MOOD;
VOICE : VOICE_TYPE := IR.QUAL.V.TENSE_VOICE_MOOD.VOICE;
KIND : VERB_KIND_TYPE := VK;
-- Nothing on (part), gerund,
function THEY return STRING is
begin
if KIND = IMPERS then
return "it ";
end if;
if MOOD = INF then
return "to ";
end if;
if MOOD = IMP and TENSE = PRES and NUMBER = P then
return "(you) ";
end if;
if MOOD = SUB and TENSE = PRES and
PERSON = 1 and NUMBER = P then
return "let us "; -- G&L 263 1
end if;
if NUMBER = S then
if PERSON = 1 then
return "I ";
elsif PERSON = 2 then
return "you ";
elsif PERSON = 3 then
return "he/it ";
else
return "";
end if;
elsif NUMBER = P then
if PERSON = 1 then
return "we ";
elsif PERSON = 2 then
return "you ";
elsif PERSON = 3 then
return "they ";
else
return "";
end if;
else
return "";
end if;
end THEY;
function SHALL return STRING is
begin -- ACTIVE only !!!!!!!!!!!!!!!!
if (TENSE = FUT or TENSE = FUTP ) then
if (MOOD = IND) or (MOOD = SUB) then
if PERSON = 1 then
return "shall ";
elsif PERSON = 2 then
return "will ";
elsif PERSON = 3 then
return "will ";
else
return "";
end if;
elsif MOOD = IMP then
if PERSON = 1 then
return "will ";
elsif PERSON = 2 then
return "(shall) ";
elsif PERSON = 3 then
return "(shall) ";
else
return "";
end if;
elsif MOOD = INF then
if TENSE = FUT then
return "be about to be ";
else
return "";
end if;
else
return "";
end if;
else
return "";
end if;
end SHALL;
function HAVE return STRING is
begin
if TENSE in PRES..FUT then
return "";
elsif TENSE = PERF then
if (TENSE = PERF) and (PERSON = 3) and (NUMBER = S) then
return "has ";
else
return "have "; -- works for INF too
end if;
elsif TENSE = PLUP then
if MOOD = IND then
return "had";
elsif MOOD = SUB then
return "have ";
else
return "";
end if;
elsif TENSE = FUTP then
return "have ";
else
return "";
end if;
end HAVE;
function BEEN return STRING is
begin
if VOICE = PASSIVE then
if MOOD = IND then
if TENSE = PRES then
if (PERSON = 1) and (NUMBER = S) then
return "am/am being ";
elsif (PERSON = 3) and (NUMBER = S) then
return "is/is being ";
else
return "are/are being ";
end if;
elsif TENSE = IMPF then
if (PERSON = 1 or PERSON = 3) and (NUMBER = S) then
return "was/was being ";
else
return "were/were being ";
end if;
elsif TENSE = FUT then
return "be ";
elsif TENSE = PERF then
if (PERSON = 1 or PERSON = 3) and (NUMBER = S) then
return "been/was ";
else
return "been/were ";
end if;
elsif TENSE in PLUP..FUTP then
return "been ";
else
return "";
end if;
elsif MOOD = SUB then
return ""; --????????
elsif MOOD = INF then
if TENSE = PRES then
return "be ";
elsif TENSE = PERF then
return "been ";
else
return "";
end if;
elsif MOOD = IMP then
return "be ";
else
return "";
end if;
else
return "";
end if;
end BEEN;
function ED return STRING is
begin
if MOOD = IMP then
if VOICE = ACTIVE then
return "!";
elsif VOICE = PASSIVE then
return "ed!";
else
return "";
end if;
elsif MOOD = INF then
if VOICE = ACTIVE then
return "";
elsif VOICE = PASSIVE then
return "ed";
else
return "";
end if;
elsif MOOD = IND then
if VOICE = ACTIVE then
if TENSE = PRES then
if (PERSON = 3) and (NUMBER = S) then
return "s";
else
return "";
end if;
elsif TENSE = IMPF then
if (PERSON = 1 or PERSON = 3) and (NUMBER = S) then
return "ed/was ~ing";
else
return "ed/were ~ing";
end if;
elsif TENSE in PERF..FUTP then
return "ed";
else
return "";
end if;
elsif VOICE = PASSIVE then
return "ed";
else
return "";
end if;
elsif MOOD = SUB then
if TENSE in PERF..PLUP then
return "ed";
else
return "";
end if;
else
return "";
end if;
end ED;
function SUB return STRING is
begin
if MOOD = SUB then
return "may/must/should ";
else
return "";
end if;
end SUB;
begin -- PUT_VERB_EXAMPLE
if KIND = DEP then
VOICE := ACTIVE; -- Should only have allowed PASSIVE at this point
elsif KIND = SEMIDEP and then TENSE in PERF..FUTP then
VOICE := ACTIVE; -- Should only have allowed PASSIVE at this point
end if;
TEXT_IO.PUT(OUTPUT, THEY & SUB & SHALL & HAVE & BEEN & "~" & ED);
end PUT_VERB_EXAMPLE;
begin -- PUT_EXAMPLE_LINE
--TEXT_IO.PUT("In EXAMPLES ");
--TEXT_IO.PUT(" LKM "); BOOLEAN_IO.PUT(WORDS_MDEV(LOCK_MEANINGS));
--TEXT_IO.PUT(" /LKM "); BOOLEAN_IO.PUT((not WORDS_MDEV(LOCK_MEANINGS)) );
if WORDS_MODE(DO_EXAMPLES) and then (not (CONFIGURATION = ONLY_MEANINGS)) then
case IR.QUAL.POFS is
when N =>
case IR.QUAL.N.CS is
when GEN =>
TEXT_IO.PUT(OUTPUT, "~'s; of ~");
TEXT_IO.NEW_LINE(OUTPUT);
when ABL =>
TEXT_IO.NEW_LINE(OUTPUT); -- Info too much for same line
TEXT_IO.SET_COL(OUTPUT, 6);
TEXT_IO.PUT(OUTPUT,
"from _ (separ); because of ~ (cause); than ~ (compar); of ~ (circumstance)");
TEXT_IO.NEW_LINE(OUTPUT);
when DAT =>
TEXT_IO.NEW_LINE(OUTPUT); -- Info too much for same line
TEXT_IO.SET_COL(OUTPUT, 6);
TEXT_IO.PUT(OUTPUT,
"for _ (purpose, reference); to ~ (w/adjectives); to ~ (double dative)");
TEXT_IO.NEW_LINE(OUTPUT);
when LOC =>
TEXT_IO.PUT(OUTPUT, "at ~ (place where)");
TEXT_IO.NEW_LINE(OUTPUT);
when others =>
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end case;
when ADJ =>
case IR.QUAL.ADJ.CO is
when COMP =>
TEXT_IO.PUT(OUTPUT, "~er; more/too _");
TEXT_IO.NEW_LINE(OUTPUT);
when SUPER =>
TEXT_IO.PUT(OUTPUT, "~est; most/very");
TEXT_IO.NEW_LINE(OUTPUT);
when others =>
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end case;
when ADV =>
case IR.QUAL.ADV.CO is
when COMP =>
TEXT_IO.PUT(OUTPUT, "more/too ~(ly)");
TEXT_IO.NEW_LINE(OUTPUT);
when SUPER =>
TEXT_IO.PUT(OUTPUT, "most/very ~(ly)");
TEXT_IO.NEW_LINE(OUTPUT);
when others =>
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end case;
when V =>
--TEXT_IO.NEW_LINE(OUTPUT); -- Verb info too much for same line
VK := DE.PART.V.KIND;
TEXT_IO.SET_COL(OUTPUT, 6);
PUT_VERB_EXAMPLE(OUTPUT, IR, VK);
TEXT_IO.NEW_LINE(OUTPUT);
when VPAR =>
-- TEXT_IO.NEW_LINE(OUTPUT); -- Verb info too much for same line
case IR.QUAL.VPAR.TENSE_VOICE_MOOD.TENSE is
when PERF =>
TEXT_IO.PUT(OUTPUT,
"~ed PERF PASSIVE PPL often used as ADJ or N (amatus => belov.ed)");
TEXT_IO.NEW_LINE(OUTPUT);
when PRES =>
TEXT_IO.PUT(OUTPUT,
"~ing PRES ACTIVE PPL often used as ADJ or N (lov.ing, curl.y)");
TEXT_IO.NEW_LINE(OUTPUT);
when FUT =>
if IR.QUAL.VPAR.TENSE_VOICE_MOOD.VOICE = ACTIVE then
TEXT_IO.PUT(OUTPUT,
"about/going/intending/destined to ~ FUT ACTIVE PPL often used as ADJ or N ");
TEXT_IO.NEW_LINE(OUTPUT);
else
case IR.QUAL.VPAR.CS is
when GEN =>
TEXT_IO.PUT(OUTPUT,
"to(/must) be ~ed FUT PASSIVE PPL, often used as gerund or gerundive (of ~ing)");
when DAT =>
TEXT_IO.PUT(OUTPUT,
"to(/must) be ~ed FUT PASSIVE PPL, often used as gerund or gerundive (to/for ~ing)");
when ABL =>
TEXT_IO.PUT(OUTPUT,
"to(/must) be ~ed FUT PASSIVE PPL, often used as gerund or gerundive (by/in ~ing)");
when ACC =>
TEXT_IO.PUT(OUTPUT,
"to(/must) be ~ed FUT PASSIVE PPL, often used as gerund or gerundive (for ~ing/to ~)");
when others =>
TEXT_IO.PUT(OUTPUT,
"to(/must) be ~ed FUT PASSIVE PPL, often used as gerund or gerundive (~ing)");
end case;
TEXT_IO.NEW_LINE(OUTPUT);
end if;
when others =>
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end case; -- TENSE
when SUPINE =>
--TEXT_IO.NEW_LINE(OUTPUT);
if IR.QUAL.SUPINE.CS = ACC then
TEXT_IO.PUT(OUTPUT,
"to ~ expresses purpose of verb of motion; may take a direct object");
TEXT_IO.NEW_LINE(OUTPUT);
elsif IR.QUAL.SUPINE.CS = ABL then
TEXT_IO.PUT(OUTPUT,
"to ~ after ADJ indicating aspect/respect in which something is/is done");
TEXT_IO.NEW_LINE(OUTPUT);
end if;
when others =>
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end case; -- PART
else
null;
--TEXT_IO.NEW_LINE(OUTPUT);
end if;
end PUT_EXAMPLE_LINE;

12
put_stat.adb Normal file
View File

@@ -0,0 +1,12 @@
with TEXT_IO;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
procedure PUT_STAT(S : STRING) is
begin
if TEXT_IO.IS_OPEN(STATS) then
TEXT_IO.PUT_LINE(STATS, S);
end if;
end PUT_STAT;

303
search_english.adb Normal file
View File

@@ -0,0 +1,303 @@
with TEXT_IO; use TEXT_IO;
with Strings_Package; use Strings_Package;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with CONFIG;
with WORD_PARAMETERS; use WORD_PARAMETERS;
with Inflections_Package; use Inflections_Package;
with Dictionary_Package; use Dictionary_Package;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
with WORD_PACKAGE; use WORD_PACKAGE;
with ENGLISH_SUPPORT_PACKAGE; use ENGLISH_SUPPORT_PACKAGE;
with DICTIONARY_FORM;
procedure SEARCH_ENGLISH(INPUT_ENGLISH_WORD : STRING; POFS : PART_OF_SPEECH_TYPE := X) is
use EWDS_DIRECT_IO;
INPUT_WORD : EWORD := LOWER_CASE(HEAD(INPUT_ENGLISH_WORD, EWORD_SIZE));
INPUT_POFS : PART_OF_SPEECH_TYPE := POFS;
OUTPUT_ARRAY : EWDS_ARRAY(1..500) := (others => NULL_EWDS_RECORD);
NUMBER_OF_HITS : INTEGER := 0;
J1, J2, J, JJ : EWDS_DIRECT_IO.COUNT := 0;
D_K : DICTIONARY_KIND := GENERAL; -- For the moment
EWDS : EWDS_RECORD := NULL_EWDS_RECORD;
FIRST_TRY, SECOND_TRY : BOOLEAN := TRUE;
procedure LOAD_OUTPUT_ARRAY(EWDS : in EWDS_RECORD) is
begin
--PUT("LOAD a " & PART_OF_SPEECH_TYPE'IMAGE(INPUT_POFS));
--PUT("LOAD b " & PART_OF_SPEECH_TYPE'IMAGE(INPUT_POFS));
if EWDS.POFS <= INPUT_POFS then
NUMBER_OF_HITS := NUMBER_OF_HITS + 1;
OUTPUT_ARRAY(NUMBER_OF_HITS) := EWDS;
-- PUT("$ " & INTEGER'IMAGE(NUMBER_OF_HITS));
-- EWDS_RECORD_IO.PUT(OUTPUT_ARRAY(NUMBER_OF_HITS));
-- TEXT_IO.NEW_LINE;
end if;
end LOAD_OUTPUT_ARRAY;
--procedure TRIM_OUTPUT_ARRAY is
procedure SORT_OUTPUT_ARRAY is
HITS : INTEGER := 0;
begin
-- Bubble sort
HIT_LOOP:
loop
HITS := 0;
SWITCH:
declare
DW, EW : EWDS_RECORD := NULL_EWDS_RECORD;
begin
INNER_LOOP: -- Order by RANK, FREQ, SEMI
for I in 1..NUMBER_OF_HITS-1 loop
if OUTPUT_ARRAY(I+1).RANK > OUTPUT_ARRAY(I).RANK or else
(OUTPUT_ARRAY(I+1).RANK = OUTPUT_ARRAY(I).RANK and then
OUTPUT_ARRAY(I+1).FREQ < OUTPUT_ARRAY(I).FREQ) or else
(OUTPUT_ARRAY(I+1).RANK = OUTPUT_ARRAY(I).RANK and then
OUTPUT_ARRAY(I+1).FREQ = OUTPUT_ARRAY(I).FREQ and then
OUTPUT_ARRAY(I+1).SEMI < OUTPUT_ARRAY(I).SEMI) then
DW := OUTPUT_ARRAY(I);
OUTPUT_ARRAY(I) := OUTPUT_ARRAY(I+1);
OUTPUT_ARRAY(I+1) := DW;
HITS := HITS + 1;
--PUT_LINE("HITS " & INTEGER'IMAGE(HITS));
end if;
end loop INNER_LOOP;
end SWITCH;
exit when HITS = 0;
end loop HIT_LOOP;
end SORT_OUTPUT_ARRAY;
-- begin
-- SORT_OUTPUT_ARRAY;
-- end TRIM_OUTPUT_ARRAY;
procedure DUMP_OUTPUT_ARRAY(OUTPUT : in TEXT_IO.FILE_TYPE) is
DE : DICTIONARY_ENTRY := NULL_DICTIONARY_ENTRY;
NUMBER_TO_SHOW : INTEGER := NUMBER_OF_HITS;
ONE_SCREEN : INTEGER := 6;
begin
--TEXT_IO.PUT_LINE("DUMP_OUTPUT");
if NUMBER_OF_HITS = 0 then
TEXT_IO.PUT_LINE(OUTPUT, "No Match");
else
--PUT_LINE("Unsorted EWDS");
--for I in 1..NUMBER_TO_SHOW loop
-- PUT(INTEGER'IMAGE(I)); PUT("*"); EWDS_RECORD_IO.PUT(OUTPUT_ARRAY(I)); NEW_LINE;
--end loop;
SORT_OUTPUT_ARRAY;
--TEXT_IO.PUT_LINE("DUMP_OUTPUT SORTED");
TRIMMED := FALSE;
if WORDS_MODE(TRIM_OUTPUT) then
if NUMBER_OF_HITS > ONE_SCREEN then
NUMBER_TO_SHOW := ONE_SCREEN;
TRIMMED := TRUE;
else
NUMBER_TO_SHOW := NUMBER_OF_HITS;
end if;
end if;
for I in 1..NUMBER_TO_SHOW loop
TEXT_IO.NEW_LINE(OUTPUT);
DO_PAUSE:
begin
--PUT(INTEGER'IMAGE(INTEGER(TEXT_IO.LINE(OUTPUT))) & " ");
--PUT(INTEGER'IMAGE(INTEGER(SCROLL_LINE_NUMBER)) & " ");
--PUT(INTEGER'IMAGE(INTEGER(CONFIG.OUTPUT_SCREEN_SIZE)) & " ");
if (INTEGER(TEXT_IO.LINE(OUTPUT)) >
SCROLL_LINE_NUMBER + CONFIG.OUTPUT_SCREEN_SIZE) then
PAUSE(OUTPUT);
SCROLL_LINE_NUMBER := INTEGER(TEXT_IO.LINE(OUTPUT));
end if;
end DO_PAUSE;
-- EWDS_RECORD_IO.PUT(OUTPUT_ARRAY(I));
-- TEXT_IO.NEW_LINE;
DICT_IO.READ(DICT_FILE(GENERAL), DE, DICT_IO.COUNT(OUTPUT_ARRAY(I).N));
--TEXT_IO.PUT_LINE("DUMP_OUTPUT READ");
-- DICTIONARY_ENTRY_IO.PUT(DE); TEXT_IO.NEW_LINE;
PUT(OUTPUT, DICTIONARY_FORM(DE));
TEXT_IO.PUT(OUTPUT, " ");
--PART_ENTRY_IO.PUT(OUTPUT, DE.PART);
--TEXT_IO.PUT_LINE("DUMP_OUTPUT PART");
if DE.PART.POFS = N then
TEXT_IO.PUT(OUTPUT, " "); DECN_RECORD_IO.PUT(OUTPUT, DE.PART.N.DECL);
TEXT_IO.PUT(OUTPUT, " " & GENDER_TYPE'IMAGE(DE.PART.N.GENDER) & " ");
end if;
if (DE.PART.POFS = V) then
TEXT_IO.PUT(OUTPUT, " "); DECN_RECORD_IO.PUT(OUTPUT, DE.PART.V.CON);
end if;
if (DE.PART.POFS = V) and then (DE.PART.V.KIND in GEN..PERFDEF) then
TEXT_IO.PUT(OUTPUT, " " & VERB_KIND_TYPE'IMAGE(DE.PART.V.KIND) & " ");
end if;
--TEXT_IO.PUT_LINE("DUMP_OUTPUT CODE");
if WORDS_MDEV(SHOW_DICTIONARY_CODES) then
TEXT_IO.PUT(OUTPUT, " [");
AGE_TYPE_IO.PUT(OUTPUT, DE.TRAN.AGE);
AREA_TYPE_IO.PUT(OUTPUT, DE.TRAN.AREA);
GEO_TYPE_IO.PUT(OUTPUT, DE.TRAN.GEO);
FREQUENCY_TYPE_IO.PUT(OUTPUT, DE.TRAN.FREQ);
SOURCE_TYPE_IO.PUT(OUTPUT, DE.TRAN.SOURCE);
TEXT_IO.PUT(OUTPUT, "] ");
end if;
if WORDS_MDEV(SHOW_DICTIONARY) then
TEXT_IO.PUT(OUTPUT, EXT(D_K) & ">");
end if;
--TEXT_IO.PUT_LINE("DUMP_OUTPUT SHOW");
if WORDS_MDEV(SHOW_DICTIONARY_LINE) then
TEXT_IO.PUT(OUTPUT, "("
& TRIM(INTEGER'IMAGE(OUTPUT_ARRAY(I).N)) & ")");
end if;
TEXT_IO.NEW_LINE(OUTPUT);
--TEXT_IO.PUT_LINE("DUMP_OUTPUT MEAN");
TEXT_IO.PUT(OUTPUT, TRIM(DE.MEAN));
TEXT_IO.NEW_LINE(OUTPUT);
end loop;
--TEXT_IO.PUT_LINE("DUMP_OUTPUT TRIMMED");
if TRIMMED then
PUT_LINE(OUTPUT, "*");
end if;
end if; -- On HITS = 0
exception
when others =>
null; -- If N not in DICT_FILE
end DUMP_OUTPUT_ARRAY;
begin
J1 := 1;
J2 := SIZE(EWDS_FILE);
FIRST_TRY := TRUE;
SECOND_TRY := TRUE;
J := (J1 + J2) / 2;
BINARY_SEARCH:
loop
-- TEXT_IO.PUT_LINE("J = " & INTEGER'IMAGE(INTEGER(J)));
if (J1 = J2-1) or (J1 = J2) then
if FIRST_TRY then
-- TEXT_IO.PUT_LINE("FIRST_TRY");
J := J1;
FIRST_TRY := FALSE;
elsif SECOND_TRY then
-- TEXT_IO.PUT_LINE("SECOND_TRY");
J := J2;
SECOND_TRY := FALSE;
else
-- TEXT_IO.PUT_LINE("THIRD_TRY exit BINARY_SEARCH");
JJ := J;
exit BINARY_SEARCH;
end if;
end if;
-- Should D_K
SET_INDEX(EWDS_FILE, EWDS_DIRECT_IO.COUNT(J));
READ(EWDS_FILE, EWDS);
-- EWDS_RECORD_IO.PUT(EWDS);
-- TEXT_IO.NEW_LINE;
-- PUT_LINE(LOWER_CASE(EWDS.W));
-- PUT_LINE(INPUT_WORD);
-- TEXT_IO.PUT_LINE("J = " & INTEGER'IMAGE(INTEGER(J)) &
-- " J1 = " & INTEGER'IMAGE(INTEGER(J1)) &
-- " J2 = " & INTEGER'IMAGE(INTEGER(J2)));
--
if "<"(LOWER_CASE(EWDS.W), INPUT_WORD) then -- Not LTU, not u=v
J1 := J;
J := (J1 + J2) / 2;
elsif ">"(LOWER_CASE(EWDS.W), INPUT_WORD) then
J2 := J;
J := (J1 + J2) / 2;
else
for I in reverse J1..J loop
SET_INDEX(EWDS_FILE, EWDS_DIRECT_IO.COUNT(I));
READ(EWDS_FILE, EWDS); -- Reads and advances index!!
if "="(LOWER_CASE(EWDS.W), INPUT_WORD) then
JJ := I;
-- PUT(INTEGER'IMAGE(INTEGER(I))); PUT("-"); EWDS_RECORD_IO.PUT(EWDS); NEW_LINE;
LOAD_OUTPUT_ARRAY(EWDS);
else
exit;
end if;
end loop;
for I in J+1..J2 loop
SET_INDEX(EWDS_FILE, EWDS_DIRECT_IO.COUNT(I));
READ(EWDS_FILE, EWDS);
if "="(LOWER_CASE(EWDS.W), INPUT_WORD) then
JJ := I;
-- PUT(INTEGER'IMAGE(INTEGER(I))); PUT("+"); EWDS_RECORD_IO.PUT(EWDS); NEW_LINE;
LOAD_OUTPUT_ARRAY(EWDS);
else
exit BINARY_SEARCH;
end if;
end loop;
exit BINARY_SEARCH;
end if;
end loop BINARY_SEARCH;
if WORDS_MODE(WRITE_OUTPUT_TO_FILE) then
DUMP_OUTPUT_ARRAY(OUTPUT);
else
DUMP_OUTPUT_ARRAY(CURRENT_OUTPUT);
end if;
-- DUMP_OUTPUT_ARRAY(;
-- TEXT_IO.PUT_LINE("Leaving SEARCH NUMBER_OF_HITS = " &
-- INTEGER'IMAGE(NUMBER_OF_HITS));
exception
when others =>
TEXT_IO.PUT_LINE("exception SEARCH NUMBER_OF_HITS = " &
INTEGER'IMAGE(NUMBER_OF_HITS));
raise;
end SEARCH_ENGLISH;

1125
sorter.adb Normal file
View File

File diff suppressed because it is too large Load Diff

147
strings_package.adb Normal file
View File

@@ -0,0 +1,147 @@
with TEXT_IO; use TEXT_IO;
package body STRINGS_PACKAGE is
function MAX(A, B : INTEGER) return INTEGER is
begin
if A >= B then
return A; end if;
return B;
end MAX;
function MIN(A, B : INTEGER) return INTEGER is
begin
if A <= B then
return A; end if;
return B;
end MIN;
function LOWER_CASE(C : CHARACTER) return CHARACTER is
begin
if C in 'A'..'Z' then
return CHARACTER'VAL(CHARACTER'POS(C) + 32);
else
return C;
end if;
end LOWER_CASE;
function LOWER_CASE(S : STRING) return STRING is
T : STRING(S'RANGE);
begin
for I in S'RANGE loop
T(I) := LOWER_CASE(S(I));
end loop;
return T;
end LOWER_CASE;
function UPPER_CASE(C : CHARACTER) return CHARACTER is
begin
if C in 'a'..'z' then
return CHARACTER'VAL(CHARACTER'POS(C) - 32);
else
return C;
end if;
end UPPER_CASE;
function UPPER_CASE(S : STRING) return STRING is
T : STRING(S'RANGE);
begin
for I in S'RANGE loop
T(I) := UPPER_CASE(S(I));
end loop;
return T;
end UPPER_CASE;
function TRIM(SOURCE : in STRING;
SIDE : in TRIM_END := BOTH) return STRING is
-- Removes leading and trailing blanks and returns a STRING staring at 1
-- For a string of all blanks as input it returns NULL_STRING
T : STRING(1..SOURCE'LENGTH) := SOURCE;
FIRST: NATURAL := SOURCE'FIRST;
LAST : NATURAL := SOURCE'LAST;
begin
if SIDE /= RIGHT then
FIRST := SOURCE'LAST + 1;
for I in SOURCE'RANGE loop
if SOURCE(I) /= ' ' then
FIRST := I;
exit;
end if;
end loop;
else
FIRST := SOURCE'FIRST;
end if;
if SIDE /= LEFT then
LAST := SOURCE'FIRST - 1;
for I in reverse SOURCE'RANGE loop
if SOURCE(I) /= ' ' then
LAST := I;
exit;
end if;
end loop;
else
LAST := SOURCE'LAST;
end if;
if FIRST > LAST then
return NULL_STRING;
else
T(1..LAST-FIRST+1) := SOURCE(FIRST..LAST);
return T(1..LAST-FIRST+1);
end if;
end TRIM;
function HEAD(SOURCE : in STRING;
COUNT : in NATURAL;
PAD : in CHARACTER := ' ') return STRING is
-- Truncates or fills a string to exactly N in length
T : STRING(1..COUNT) := (others => ' ');
begin
if COUNT < SOURCE'LENGTH then
T(1..COUNT) := SOURCE(SOURCE'FIRST..SOURCE'FIRST+COUNT-1);
else
T(1..SOURCE'LENGTH) := SOURCE(SOURCE'FIRST..SOURCE'LAST);
end if;
return T;
end HEAD;
procedure GET_NON_COMMENT_LINE(F : in TEXT_IO.FILE_TYPE;
S : out STRING; LAST : out INTEGER) is
-- Reads a text file and outs a string that is as much of the
-- first line encountered that is not a comment, that is not a comment
T : STRING(1..250) := (others => ' ');
L, LX : INTEGER := 0;
begin
LAST := 0;
FILE_LOOP:
while not TEXT_IO.END_OF_FILE(F) loop -- Loop until data - Finish on EOF
TEXT_IO.GET_LINE(F, T, L);
if (HEAD(TRIM(T), 250)(1..2) = " " or
HEAD(TRIM(T), 250)(1..2) = "--") then
null;
else
LX := L;
LINE_LOOP:
for I in 2..L loop
-- Any leading comment does not get to here
if (T(I-1) = '-') and (T(I) = '-') then -- We have a comment
LX := I - 2;
exit FILE_LOOP;
end if;
end loop LINE_LOOP;
exit FILE_LOOP;
end if;
end loop FILE_LOOP;
S(1..LX) := T(1..LX);
LAST := LX;
end GET_NON_COMMENT_LINE;
end STRINGS_PACKAGE;

31
strings_package.ads Normal file
View File

@@ -0,0 +1,31 @@
with TEXT_IO;
package STRINGS_PACKAGE is
type TRIM_END is (LEFT, RIGHT, BOTH);
NULL_STRING : constant STRING(2..1) := (others => ' ');
function MAX(A, B : INTEGER) return INTEGER;
function MIN(A, B : INTEGER) return INTEGER;
function LOWER_CASE(C : CHARACTER) return CHARACTER;
function LOWER_CASE(S : STRING) return STRING;
function UPPER_CASE(C : CHARACTER) return CHARACTER;
function UPPER_CASE(S : STRING) return STRING;
function TRIM(SOURCE : in STRING;
SIDE : in TRIM_END := BOTH) return STRING;
-- Equivalent to Ada.Strings.Fixed.Trim(Source, Both);
function HEAD(SOURCE : in STRING;
COUNT : in NATURAL;
PAD : in CHARACTER := ' ') return STRING;
procedure GET_NON_COMMENT_LINE(F : in TEXT_IO.FILE_TYPE;
S : out STRING; LAST : out INTEGER);
end STRINGS_PACKAGE;

2221
tricks_package.adb Normal file
View File

File diff suppressed because it is too large Load Diff

19
tricks_package.ads Normal file
View File

@@ -0,0 +1,19 @@
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
package TRICKS_PACKAGE is
procedure SYNCOPE(W : STRING;
PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER);
procedure TRY_TRICKS(W : STRING;
PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER;
LINE_NUMBER : INTEGER; WORD_NUMBER : INTEGER);
procedure TRY_SLURY(W : STRING;
PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER;
LINE_NUMBER : INTEGER; WORD_NUMBER : INTEGER);
procedure ROMAN_NUMERALS(INPUT_WORD : STRING;
PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER);
end TRICKS_PACKAGE;

25
uniques_package.ads Normal file
View File

@@ -0,0 +1,25 @@
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
package UNIQUES_PACKAGE is
type UNIQUE_ITEM;
type UNIQUE_LIST is access UNIQUE_ITEM;
type UNIQUE_ITEM is
record
STEM : STEM_TYPE := NULL_STEM_TYPE;
QUAL : QUALITY_RECORD := NULL_QUALITY_RECORD;
KIND : KIND_ENTRY := NULL_KIND_ENTRY;
MNPC : DICT_IO.COUNT := NULL_MNPC;
SUCC : UNIQUE_LIST;
end record;
type LATIN_UNIQUES is array (CHARACTER range 'a'..'z') of UNIQUE_LIST;
NULL_LATIN_UNIQUES : LATIN_UNIQUES := (others => null);
UNQ : LATIN_UNIQUES := NULL_LATIN_UNIQUES;
type UNIQUES_DE_ARRAY is array (DICT_IO.POSITIVE_COUNT range <>) of DICTIONARY_ENTRY;
UNIQUES_DE : UNIQUES_DE_ARRAY(1..100) := (others => NULL_DICTIONARY_ENTRY);
end UNIQUES_PACKAGE;

482
wakedict.adb Normal file
View File

@@ -0,0 +1,482 @@
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;
procedure WAKEDICT is
package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
use TEXT_IO;
use STEM_KEY_TYPE_IO;
use DICTIONARY_ENTRY_IO;
use PART_ENTRY_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 DICT_IO;
PORTING : constant BOOLEAN := FALSE;
BE_VE : VERB_ENTRY := (CON => (5, 1), KIND => TO_BE);
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;
DICTFILE : DICT_IO.FILE_TYPE;
INPUT, STEMLIST : TEXT_IO.FILE_TYPE;
DE : DICTIONARY_ENTRY;
S, LINE, BLANK_LINE : STRING(1..400) := (others => ' ');
L, LL, LAST : INTEGER := 0;
J : DICT_IO.COUNT := 0;
MEAN_TO_BE : constant MEANING_TYPE :=
HEAD("be; exist; (also used to form verb perfect passive tenses)" &
" with NOM PERF PPL", MAX_MEANING_SIZE);
begin
PUT_LINE(
"Takes a DICTLINE.D_K and produces a STEMLIST.D_K and DICTFILE.D_K");
PUT_LINE("This version inserts ESSE when D_K = GEN");
PUT("What dictionary to list, GENERAL or SPECIAL (Reply G or S) =>");
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;
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;
OPEN(INPUT, IN_FILE, ADD_FILE_NAME_EXTENSION(DICT_LINE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
if not PORTING then
CREATE(STEMLIST, OUT_FILE, ADD_FILE_NAME_EXTENSION(STEM_LIST_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
end if;
CREATE(DICTFILE, OUT_FILE, ADD_FILE_NAME_EXTENSION(DICT_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
-- if D_K = GENERAL then
-- PUT_LINE("WAKEDICT reads DICTLINE.d_k and produces DICTFILE.d_k");
-- PUT_LINE("WAKEDICT also produces STEMLIST.d_k");
-- PUT_LINE("This version inserts ESSE when d_k = GEN");
--
-- J := J + 1;
--
-- -- First construct ESSE
-- DE.STEMS(1) := "s ";
-- DE.STEMS(2) := " ";
-- DE.STEMS(3) := "fu ";
-- DE.STEMS(4) := "fut ";
-- --DE.PART := (PART => V, CON => (5, 10));
-- --DE.PART := (V, ((5, 1)));
-- DE.PART := (V, BE_VE);
-- DE.KIND := (V, TO_BE);
-- DE.TRAN := (X, X, X, A, X);
-- DE.MEAN := MEAN_TO_BE;
--
--
-- if not PORTING then
-- -- Load ESSE
-- for I in STEM_KEY_TYPE range 1..4 loop
-- PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- -- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 50);
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end loop;
-- end if;
--
-- WRITE(DICTFILE, DE, J); -- J = 1
-- 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
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("Exception");
PUT_LINE(S(1..LAST));
INTEGER_IO.PUT(INTEGER(J)); NEW_LINE;
PUT(DE); NEW_LINE;
end FORM_DE;
J := J + 1;
WRITE(DICTFILE, DE, J);
if not PORTING then
if DE.PART.POFS = N and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
-- PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
---- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end if;
-- if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
-- PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
-- SET_COL(STEMLIST, 45);
-- INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
-- INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
-- end if;
elsif DE.PART.POFS = ADJ and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
elsif DE.PART.POFS = ADJ and then
-- POS taken care of by position
DE.PART.ADJ.CO = COMP then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADJ and then
DE.PART.ADJ.CO = SUPER then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADV and then
-- POS taken care of by position
DE.PART.ADV.CO = COMP then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 2, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = ADV and then
DE.PART.ADV.CO = SUPER then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = V and then
DE.STEMS(1) = DE.STEMS(2) and then
DE.STEMS(1) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 0, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
if DE.STEMS(3) /= NULL_STEM_TYPE and DE.STEMS(3) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(3)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
if DE.STEMS(4) /= NULL_STEM_TYPE and DE.STEMS(4) /= ZZZ_STEM then
PUT(STEMLIST, DE.STEMS(4)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = CARD then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 1, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = ORD then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 2, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = DIST then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 3, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
elsif DE.PART.POFS = NUM and then
DE.PART.NUM.SORT = ADVERB then
PUT(STEMLIST, DE.STEMS(1)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
INTEGER_IO.PUT(STEMLIST, 4, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
else
for I in STEM_KEY_TYPE range 1..4 loop
if DE.STEMS(I) /= ZZZ_STEM and
DE.STEMS(I) /= NULL_STEM_TYPE then
PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end if;
end loop;
end if;
end if; -- PORTING
end if;
end loop OVER_LINES;
if D_K = GENERAL then
J := J + 1;
-- First construct ESSE
DE.STEMS(1) := "s ";
DE.STEMS(2) := " ";
DE.STEMS(3) := "fu ";
DE.STEMS(4) := "fut ";
--DE.PART := (PART => V, CON => (5, 10));
--DE.PART := (V, ((5, 1)));
DE.PART := (V, BE_VE);
--DE.KIND := (V, TO_BE);
DE.TRAN := (X, X, X, A, X);
DE.MEAN := MEAN_TO_BE;
if not PORTING then
-- Load ESSE
for I in STEM_KEY_TYPE range 1..4 loop
PUT(STEMLIST, DE.STEMS(I)); PUT(STEMLIST, ' ');
PUT(STEMLIST, DE.PART); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 45);
PUT(STEMLIST, I, 2); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AGE); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.AREA); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.GEO); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.FREQ); PUT(STEMLIST, ' ');
-- PUT(STEMLIST, DE.TRAN.SOURCE); PUT(STEMLIST, ' ');
SET_COL(STEMLIST, 50);
INTEGER_IO.PUT(STEMLIST, INTEGER(J), 6); NEW_LINE(STEMLIST);
end loop;
end if;
WRITE(DICTFILE, DE, J);
end if;
if not PORTING then
CLOSE(STEMLIST);
end if;
exception
when TEXT_IO.DATA_ERROR =>
null;
when others =>
PUT_LINE(S(1..LAST));
INTEGER_IO.PUT(INTEGER(J)); NEW_LINE;
CLOSE(STEMLIST);
end WAKEDICT;

502
weed.adb Normal file
View File

@@ -0,0 +1,502 @@
with TEXT_IO; use TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
procedure WEED(W : in out STRING;
POFS : in PART_OF_SPEECH_TYPE) is
-- In contrast to the Latin phase where the prioritization takes is at runtime
-- for the English most of the work is done beforehand
-- both the setting of a priority class for each entry in the scan of DICTLINE
-- and the WEEDing/TRIMming done herein
-- There may not be much reason to WEED
-- If there are a hundred "the", does it matter. No one should input "the"
-- But it is a matter of logic and secondary effects (special on "the")
KILL : BOOLEAN := FALSE;
begin
--PUT_LINE("WEED " & W & '|');
-- if -- WORDS words
-- W = "ACC" or
-- W = "ABL" or
-- W = "AD" or
-- W = "BC" or
-- W = "DAT" or
-- W = "DEMONST" or
-- W = "INDEF" or
-- W = "INF" or
-- W = "KLUDGE" or
-- W = "NE" or
-- W = "NW" or
-- W = "NT" or
-- W = "OT" or
-- W = "PASS" or
-- W = "SE" or
-- W = "SW" or
-- W = "St"
--
-- then
--
-- KILL := TRUE;
-- end if;
-- -- Articles
-- W = "a" or
-- W = "an" or
-- W = "the" or
-- Conjunctions
if (POFS /= CONJ) and then
(W = "and" or
W = "or" or
W = "but" or
W = "if" )
then
KILL := TRUE;
end if;
-- Prepositions
if (POFS /= PREP) and then
(W = "of" or
W = "to" or
W = "in" or
W = "into" or
W = "with" or
W = "w" or
W = "without" or
W = "for" or
W = "per" or
W = "on" or
W = "upon" or
W = "by" or
W = "from" or
W = "between" or
W = "at" or
W = "towards" or
W = "under" or
W = "before" or
W = "against" or
W = "around" or
W = "through" or
W = "after" or
W = "like" or
W = "similar" or
W = "than" or
W = "as" )
then
KILL := TRUE;
end if;
if
(POFS /= N) and then
(-- General nouns
W = "person" or
W = "man" or
W = "men" or
W = "woman" or
W = "member" or
W = "species" or
W = "instrument" or
W = "word" or
W = "words" or
--W = "shape" or
W = "parts" or
W = "title" or
W = "office" or
W = "thing" or
W = "day" or
W = "land" or
W = "plant" or
W = "plants" or
W = "tree" or
W = "fish" or
W = "stone" or
W = "stones" or
W = "gem" or
W = "vessel" or
W = "pieces" or
W = "animal" or
W = "bird" or
W = "measure" or
W = "inhabitant" or
W = "place" or
W = "tribe" or
W = "group" or
W = "official" or
W = "thing" or
W = "things" or
W = "something" or
--W = "matter" or
W = "law" )
then
KILL := TRUE;
end if;
if
W = "something" or
W = "quality" or
W = "heap" or
W = "amount" or
W = "money" or
W = "part" or
W = "front" or
W = "preparation" or
W = "purpose" or
W = "bit" or
W = "way" or
W = "maker" or
W = "material" or
W = "action" or
W = "act" or
W = "form" or
W = "point" or
W = "right" or
W = "order" or
W = "area" or
W = "rest" or
W = "cover" or
-- Common nouns
W = "Rome" or
W = "rome" or
W = "praenomen" or
W = "gens" or
W = "offering" or
W = "note" or
W = "water" or
W = "ear" or
W = "end" or
W = "ritual" or
W = "rite" or
W = "hair" or
W = "time" or
W = "charactistic" or
W = "building" or
W = "sea" or
W = "ship"
then
KILL := TRUE;
end if;
if
(POFS /= ADJ) and then
(--Adjectives
W = "some" or
W = "several" or
W = "another" or
W = "male" or
W = "legal" or
W = "female" or
W = "official" or
W = "no" or
W = "wild" or
W = "dark" or
W = "sacred" or
W = "Roman" or
W = "roman" or
W = "precious" or
W = "short" or
W = "long" or
W = "low" or
W = "young" or
W = "old" or
W = "large" or
W = "light" or
W = "round" or
W = "high" or
W = "near" or
W = "little" or
W = "small" )
then
KILL := TRUE;
end if;
if
(POFS /= ADJ) and then
(--More Adjectives
W = "more" or
W = "military" or
W = "many" or
W = "suitable" or
W = "hot" or
W = "used" or
W = "joint" or
W = "proper" or
W = "great" or -- great-great uncle
W = "full" or
W = "sexual" or
W = "public" or
W = "white" or
W = "secret" or
W = "hard" or
W = "good" or
W = "fine" or
W = "common"
)
then
KILL := TRUE;
end if;
if
(POFS /= ADV) and then
(
W = "up" or
W = "out" or
--W = "away" or
W = "over" or
W = "down" or
W = "back" or
W = "forth" or
W = "foward" or
W = "about" or
W = "together" or
W = "off" or
--Adverbs (pure)
W = "much" or
W = "throughly" or
W = "closly" or
W = "well" or
W = "very" or
W = "not" or
W = "too" or
W = "also" or
W = "when" or
W = "where" or
W = "then" or
W = "there" or
W = "so" )
then
KILL := TRUE;
end if;
if
(POFS /= PRON) and then
(POFS /= PACK) and then
(
-- Pronouns and indefinites
W = "one" or
W = "ones" or
W = "he" or
W = "any" or
W = "anyone" or
W = "anything" or
W = "each" or
W = "every" or
W = "other" or
W = "you" or
W = "who" or
W = "whatever" or
W = "oneself" or
W = "self" or
W = "all" or
W = "it" or
W = "this" or
W = "she" or
W = "such" or
W = "what" or
W = "which" or
W = "that" or
W = "same" ) then
KILL := TRUE;
end if;
if (
W = "kind" or
W = "manner" or
W = "variety" or
-- Posessives
W = "its" or
W = "own" or
W = "his" or
W = "ones" or
W = "one's" or
W = "pertaining" or
W = "belonging" or
W = "containing" or
W = "consisting" or
W = "relating" or
W = "resembling" or
W = "abounding" or
W = "concerned" or
W = "producing" or
W = "connected" or
W = "made" or
W = "used" or
W = "having"
) then
KILL := TRUE;
end if;
if
(POFS /= V) and then
(-- Verbs
W = "take" or
W = "make" or
W = "go" or -- !!
W = "bring" or
W = "cut" or
W = "put" or
W = "set" or
W = "grow" or
W = "give" or
W = "cause" or
W = "turn" or
W = "fall" or
W = "hold" or
W = "keep" or
W = "construct" or
W = "throw" or
W = "lay" or
W = "remove" or
W = "produce" or
W = "use" or
W = "order" or
W = "provide" or
W = "being" or
W = "making" or
W = "lacking" )
then
KILL := TRUE;
end if;
if
-- Numbers
-- W = "half" or
-- W = "one" or
-- W = "first" or
-- W = "two" or
-- W = "second" or
-- W = "double" or
-- W = "three" or
-- W = "third" or
-- W = "four" or
-- W = "seven" or
-- W = "ten" or
-- W = "times" or
-- Compounding verbs
W = "have" or
W = "has" or
W = "had" or
W = "was" or
W = "be" or
W = "become" or
W = "can" or
W = "do" or
W = "may" or
W = "must" or
W = "let" or
-- Supporting verbs
W = "is" or
W = "been" or
--W = "attempt" or
W = "begin" --or
then
KILL := TRUE;
end if;
-- if
-- -- Abbreviations
-- W = "abb"
-- then
-- KILL := TRUE;
--
-- end if;
--
--
-- - Kill abbreviations
-- if W(W'LAST) = '.' then
-- KILL := TRUE;
-- end if;
--
--
if KILL then
for I in W'RANGE loop
W(I) := '\';
end loop;
end if;
--PUT_LINE("WEEDed " & W & '|' & BOOLEAN'IMAGE(KILL));
end WEED;

115
weed_all.adb Normal file
View File

@@ -0,0 +1,115 @@
with TEXT_IO; use TEXT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
procedure WEED_ALL(W : in out STRING;
POFS : in PART_OF_SPEECH_TYPE) is
-- In contrast to the Latin phase where the prioritization takes is at runtime
-- for the English most of the work is done beforehand
-- both the setting of a priority class for each entry in the scan of DICTLINE
-- and the WEEDing/TRIMming done herein
KILL : BOOLEAN := FALSE;
begin
if W'LENGTH <= 1 then
--if W(1) not in 'A'..'Z' then
KILL := TRUE;
--end if;
else
if -- WORDS words
W = "DECL" or
W = "DAT" or
W = "ACC" or
W = "ABL" or
W = "ADJ" or
W = "AD" or
W = "BC" or
W = "COMP" or
W = "SUPER" or
W = "DEMONST" or
W = "INDEF" or
W = "INF" or
W = "KLUDGE" or
W = "NE" or
W = "NW" or
W = "SE" or
W = "SW" or
W = "NT" or
W = "OT" or
W = "PASS" or
W = "L+S" or
W = "St"
then
KILL := TRUE;
end if;
if
-- Articles
W = "a" or
W = "an" or
W = "the" or
W = "The" or
-- Others
W = "no"
then
KILL := TRUE;
end if;
if -- Fragments
W = "ad" or
W = "de" or
W = "bi" or
W = "di" or
W = "re" or
W = "ex"
then
KILL := TRUE;
end if;
if
W = "abb" or -- Abbreviation
-- Number suffixes
W = "st" or -- 1st
W = "nd" or -- 2nd
W = "rd" or -- 3rd
W = "th" -- 4th
then
KILL := TRUE;
end if;
-- Kill abbreviations
if W(W'LAST) = '.' then
KILL := TRUE;
end if;
-- Kill internal AREA
if W(W'LAST) = ':' then
KILL := TRUE;
end if;
end if;
if KILL then
for I in W'RANGE loop
W(I) := '\';
end loop;
end if;
--PUT_LINE("WEEDed ANY " & W & '|' & BOOLEAN'IMAGE(KILL));
end WEED_ALL;

2224
word_package.adb Normal file
View File

File diff suppressed because it is too large Load Diff

78
word_package.ads Normal file
View File

@@ -0,0 +1,78 @@
with TEXT_IO;
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;
package WORD_PACKAGE is
LINE_NUMBER, WORD_NUMBER : INTEGER := 0;
type STEM_ARRAY_TYPE is array (INTEGER range <>) of STEM_TYPE;
subtype STEM_ARRAY is STEM_ARRAY_TYPE(0..MAX_STEM_SIZE);
NOT_A_STEM : constant STEM_TYPE := (others => 'x');
NOT_A_STEM_ARRAY : STEM_ARRAY := (others => NOT_A_STEM);
SA, SSA : STEM_ARRAY := NOT_A_STEM_ARRAY;
SSA_MAX : INTEGER := 0;
type PRUNED_DICTIONARY_ITEM is
record
DS : DICTIONARY_STEM;
D_K : DICTIONARY_KIND := DEFAULT_DICTIONARY_KIND;
end record;
NULL_PRUNED_DICTIONARY_ITEM : PRUNED_DICTIONARY_ITEM;
type PRUNED_DICTIONARY_LIST is array (1..80) of PRUNED_DICTIONARY_ITEM;
-- Aug 96 QU_PRON max 42, PACK max 54
-- Jan 97 QU_PRON max 42, PACK max 74 -- Might reduce
PDL : PRUNED_DICTIONARY_LIST := (others => NULL_PRUNED_DICTIONARY_ITEM);
PDL_INDEX : INTEGER := 0;
subtype SAL is PARSE_ARRAY(1..250);
type DICT_RESTRICTION is (X, REGULAR, QU_PRON_ONLY, PACK_ONLY);
XXX_MEANING : MEANING_TYPE := NULL_MEANING_TYPE; -- For TRICKS
YYY_MEANING : MEANING_TYPE := NULL_MEANING_TYPE; -- For SYNCOPE
NNN_MEANING : MEANING_TYPE := NULL_MEANING_TYPE; -- For Names
RRR_MEANING : MEANING_TYPE := NULL_MEANING_TYPE; -- For Roman Numerals
PPP_MEANING : MEANING_TYPE := NULL_MEANING_TYPE; -- For COMPOUNDED
SCROLL_LINE_NUMBER : INTEGER := 0;
OUTPUT_SCROLL_COUNT : INTEGER := 0;
procedure PAUSE(OUTPUT : TEXT_IO.FILE_TYPE);
function MIN(A, B : INTEGER) return INTEGER;
function LTU(C, D : CHARACTER) return BOOLEAN;
function EQU(C, D : CHARACTER) return BOOLEAN;
function GTU(C, D : CHARACTER) return BOOLEAN;
function LTU(S, T : STRING) return BOOLEAN;
function GTU(S, T : STRING) return BOOLEAN;
function EQU(S, T : STRING) return BOOLEAN;
procedure RUN_INFLECTIONS(S : in STRING; SL : in out SAL;
RESTRICTION : DICT_RESTRICTION := REGULAR);
procedure SEARCH_DICTIONARIES(SSA : in STEM_ARRAY_TYPE;
PREFIX : PREFIX_ITEM; SUFFIX : SUFFIX_ITEM;
RESTRICTION : DICT_RESTRICTION := REGULAR);
procedure WORD(RAW_WORD : in STRING;
PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER);
procedure CHANGE_LANGUAGE(C : CHARACTER);
procedure INITIALIZE_WORD_PACKAGE;
end WORD_PACKAGE;

477
word_parameters.adb Normal file
View File

@@ -0,0 +1,477 @@
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with CONFIG; use CONFIG;
with PREFACE;
pragma Elaborate(PREFACE);
package body WORD_PARAMETERS is
use TEXT_IO;
type HELP_TYPE is array (NATURAL range <>) of STRING(1..70);
BLANK_HELP_LINE : constant STRING(1..70) := (others => ' ');
NO_HELP : constant HELP_TYPE := (2..1 => BLANK_HELP_LINE);
type REPLY_TYPE is (N, Y);
package REPLY_TYPE_IO is new TEXT_IO.ENUMERATION_IO(REPLY_TYPE);
REPLY : array (BOOLEAN) of REPLY_TYPE := (N, Y);
MODE_OF_REPLY : array (REPLY_TYPE) of BOOLEAN := (FALSE, TRUE);
BLANK_INPUT : exception;
-- The default modes are set in the body so that they can be changed
-- with only this being recompiled, not the rest of the with'ing system
DEFAULT_MODE_ARRAY : constant MODE_ARRAY := (
TRIM_OUTPUT => TRUE,
HAVE_OUTPUT_FILE => FALSE,
WRITE_OUTPUT_TO_FILE => FALSE,
DO_UNKNOWNS_ONLY => FALSE,
WRITE_UNKNOWNS_TO_FILE => FALSE,
IGNORE_UNKNOWN_NAMES => TRUE,
IGNORE_UNKNOWN_CAPS => TRUE,
DO_COMPOUNDS => TRUE,
DO_FIXES => TRUE,
DO_TRICKS => TRUE,
DO_DICTIONARY_FORMS => TRUE,
SHOW_AGE => FALSE,
SHOW_FREQUENCY => FALSE,
DO_EXAMPLES => FALSE,
DO_ONLY_MEANINGS => FALSE,
DO_STEMS_FOR_UNKNOWN => FALSE );
BAD_MODE_FILE : exception;
TRIM_OUTPUT_HELP : constant HELP_TYPE := (
"This option instructs the program to remove from the output list of ",
"possible constructs those which are least likely. There is now a fair",
"amount of trimming, killing LOC and VOC plus removing Uncommon and ",
"non-classical (Archaic/Medieval) when more common results are found ",
"and this action is requested (turn it off in MDV (!) parameters). ",
"When a TRIM has been done, output is usually followed by asterix (*). ",
"The asterix may be missing depending on where the TRIM is done. ",
"There certainly is no absolute assurence that the items removed are ",
"not correct, just that they are statistically less likely. ",
"Note that poets are likely to employ unusual words and inflections for",
"various reasons. These may be trimmed out if this parameter in on. ",
"When in English mode, trim just reduces the output to the top six ",
"results, if there are that many. Asterix means there are more ",
" The default is Y(es) " );
HAVE_OUTPUT_FILE_HELP : constant HELP_TYPE := (
"This option instructs the program to create a file which can hold the ",
"output for later study, otherwise the results are just displayed on ",
"the screen. The output file is named " & OUTPUT_FULL_NAME
& (39+OUTPUT_FULL_NAME'LENGTH..70 => ' '),
"This means that one run will necessarily overwrite a previous run, ",
"unless the previous results are renamed or copied to a file of another",
"name. This is available if the METHOD is INTERACTIVE, no parameters. ",
"The default is N(o), since this prevents the program from overwriting ",
"previous work unintentionally. Y(es) creates the output file. " );
WRITE_OUTPUT_TO_FILE_HELP : constant HELP_TYPE := (
"This option instructs the program, when HAVE_OUTPUT_FILE is on, to ",
"write results to the file " & OUTPUT_FULL_NAME
& (27+OUTPUT_FULL_NAME'LENGTH..70 => ' '),
"This option may be turned on and off during running of the program, ",
"thereby capturing only certain desired results. If the option ",
"HAVE_OUTPUT_FILE is off, the user will not be given a chance to turn ",
"this one on. Only for INTERACTIVE running. Default is N(o). ",
"This works in English mode, but output in somewhat diffeent so far. " );
DO_UNKNOWNS_ONLY_HELP : constant HELP_TYPE := (
"This option instructs the program to only output those words that it ",
"cannot resolve. Of course, it has to do processing on all words, but ",
"those that are found (with prefix/suffix, if that option in on) will ",
"be ignored. The purpose of this option is t allow a quick look to ",
"determine if the dictionary and process is going to do an acceptable ",
"job on the current text. It also allows the user to assemble a list ",
"of unknown words to look up manually, and perhaps augment the system ",
"dictionary. For those purposes, the system is usually run with the ",
"MINIMIZE_OUTPUT option, just producing a list. Another use is to run ",
"without MINIMIZE to an output file. This gives a list of the input ",
"text with the unknown words, by line. This functions as a spelling ",
"checker for Latin texts. The default is N(o). ",
"This does not work in English mode, but may in the future. " );
WRITE_UNKNOWNS_TO_FILE_HELP : constant HELP_TYPE := (
"This option instructs the program to write all unresolved words to a ",
"UNKNOWNS file named " & UNKNOWNS_FULL_NAME
& (21+UNKNOWNS_FULL_NAME'LENGTH..70 => ' '),
"With this option on , the file of unknowns is written, even though ",
"the main output contains both known and unknown (unresolved) words. ",
"One may wish to save the unknowns for later analysis, testing, or to ",
"form the basis for dictionary additions. When this option is turned ",
"on, the UNKNOWNS file is written, destroying any file from a previous ",
"run. However, the write may be turned on and off during a single run ",
"without destroying the information written in that run. ",
"This option is for specialized use, so its default is N(o). ",
"This does not work in English mode, but may in the future. " );
IGNORE_UNKNOWN_NAMES_HELP : constant HELP_TYPE := (
"This option instructs the program to assume that any capitalized word ",
"longer than three letters is a proper name. As no dictionary can be ",
"expected to account for many proper names, many such occur that would ",
"be called UNKNOWN. This contaminates the output in most cases, and ",
"it is often convenient to ignore these sperious UNKNOWN hits. This ",
"option implements that mode, and calls such words proper names. ",
"Any proper names that are in the dictionary are handled in the normal ",
"manner. The default is Y(es). " );
IGNORE_UNKNOWN_CAPS_HELP : constant HELP_TYPE := (
"This option instructs the program to assume that any all caps word ",
"is a proper name or similar designation. This convention is often ",
"used to designate speakers in a discussion or play. No dictionary can",
"claim to be exaustive on proper names, so many such occur that would ",
"be called UNKNOWN. This contaminates the output in most cases, and ",
"it is often convenient to ignore these sperious UNKNOWN hits. This ",
"option implements that mode, and calls such words names. Any similar ",
"designations that are in the dictionary are handled in the normal ",
"manner, as are normal words in all caps. The default is Y(es). " );
DO_COMPOUNDS_HELP : constant HELP_TYPE := (
"This option instructs the program to look ahead for the verb TO_BE (or",
"iri) when it finds a verb participle, with the expectation of finding ",
"a compound perfect tense or periphastic. This option can also be a ",
"trimming of the output, in that VPAR that do not fit (not NOM) will be",
"excluded, possible interpretations are lost. Default choice is Y(es).",
"This processing is turned off with the choice of N(o). " );
DO_FIXES_HELP : constant HELP_TYPE := (
"This option instructs the program, when it is unable to find a proper ",
"match in the dictionary, to attach various prefixes and suffixes and ",
"try again. This effort is successful in about a quarter of the cases ",
"which would otherwise give UNKNOWN results, or so it seems in limited ",
"tests. For those cases in which a result is produced, about half give",
"easily interpreted output; many of the rest are etymologically true, ",
"but not necessarily obvious; about a tenth give entirely spurious ",
"derivations. The user must proceed with caution. ",
"The default choice is Y(es), since the results are generally useful. ",
"This processing can be turned off with the choice of N(o). " );
DO_TRICKS_HELP : constant HELP_TYPE := (
"This option instructs the program, when it is unable to find a proper ",
"match in the dictionary, and after various prefixes and suffixes, to ",
"try every dirty Latin trick it can think of, mainly common letter ",
"replacements like cl -> cul, vul -> vol, ads -> ass, inp -> imp, etc. ",
"Together these tricks are useful, but may give false positives (>10%).",
"They provide for recognized varients in classical spelling. Most of ",
"the texts with which this program will be used have been well edited ",
"and standardized in spelling. Now, moreover, the dictionary is being",
"populated to such a state that the hit rate on tricks has fallen to a ",
"low level. It is very seldom productive, and it is always expensive. ",
"The only excuse for keeping it as default is that now the dictionary ",
"is quite extensive and misses are rare. Default is now Y(es). ") ;
DO_DICTIONARY_FORMS_HELP : constant HELP_TYPE := (
"This option instructs the program to output a line with the forms ",
"normally associated with a dictionary entry (NOM and GEN of a noun, ",
"the four principal parts of a verb, M-F-N NOM of an adjective, ...). ",
"This occurs when there is other output (i.e., not with UNKNOWNS_ONLY).",
"The default choice is N(o), but it can be turned on with a Y(es). " );
SHOW_AGE_HELP : constant HELP_TYPE := (
"This option causes a flag, like '<Late>' to appear for inflection or ",
"form in the output. The AGE indicates when this word/inflection was ",
"in use, at least from indications is dictionary citations. It is ",
"just an indication, not controlling, useful when there are choices. ",
"No indication means that it is common throughout all periods. ",
"The default choice is Y(es), but it can be turned off with a N(o). " );
SHOW_FREQUENCY_HELP : constant HELP_TYPE := (
"This option causes a flag, like '<rare>' to appear for inflection or ",
"form in the output. The FREQ is indicates the relative usage of the ",
"word or inflection, from indications is dictionary citations. It is ",
"just an indication, not controlling, useful when there are choices. ",
"No indication means that it is common throughout all periods. ",
"The default choice is Y(es), but it can be turned off with a N(o). " );
DO_EXAMPLES_HELP : constant HELP_TYPE := (
"This option instructs the program to provide examples of usage of the ",
"cases/tenses/etc. that were constructed. The default choice is N(o). ",
"This produces lengthly output and is turned on with the choice Y(es). " );
DO_ONLY_MEANINGS_HELP : constant HELP_TYPE := (
"This option instructs the program to only output the MEANING for a ",
"word, and omit the inflection details. This is primarily used in ",
"analyzing new dictionary material, comparing with the existing. ",
"However it may be of use for the translator who knows most all of ",
"the words and just needs a little reminder for a few. ",
"The default choice is N(o), but it can be turned on with a Y(es). " );
DO_STEMS_FOR_UNKNOWN_HELP : constant HELP_TYPE := (
"This option instructs the program, when it is unable to find a proper ",
"match in the dictionary, and after various prefixes and suffixes, to ",
"list the dictionary entries around the unknown. This will likely ",
"catch a substantive for which only the ADJ stem appears in dictionary,",
"an ADJ for which there is only a N stem, etc. This option should ",
"probably only be used with individual UNKNOWN words, and off-line ",
"from full translations, therefore the default choice is N(o). ",
"This processing can be turned on with the choice of Y(es). " );
SAVE_PARAMETERS_HELP : constant HELP_TYPE := (
"This option instructs the program, to save the current parameters, as ",
"just established by the user, in a file WORD.MOD. If such a file ",
"exists, the program will load those parameters at the start. If no ",
"such file can be found in the current subdirectory, the program will ",
"start with a default set of parameters. Since this parameter file is ",
"human-readable ASCII, it may also be created with a text editor. If ",
"the file found has been improperly created, is in the wrong format, or",
"otherwise uninterpretable by the program, it will be ignored and the ",
"default parameters used, until a proper parameter file in written by ",
"the program. Since one may want to make temporary changes during a ",
"run, but revert to the usual set, the default is N(o). " );
procedure PUT(HELP : HELP_TYPE) is
begin
NEW_LINE;
for I in HELP'FIRST..HELP'LAST loop
PUT_LINE(HELP(I));
end loop;
NEW_LINE;
end PUT;
procedure PUT_MODES is
use MODE_TYPE_IO;
use REPLY_TYPE_IO;
begin
if IS_OPEN(MODE_FILE) then
CLOSE(MODE_FILE);
end if;
CREATE(MODE_FILE, OUT_FILE, MODE_FULL_NAME);
for I in WORDS_MODE'RANGE loop
PUT(MODE_FILE, I);
SET_COL(MODE_FILE, 35);
PUT(MODE_FILE, REPLY(WORDS_MODE(I)));
NEW_LINE(MODE_FILE);
end loop;
CLOSE(MODE_FILE);
end PUT_MODES;
procedure GET_MODES is --(M : out MODE_ARRAY) is
use MODE_TYPE_IO;
use REPLY_TYPE_IO;
MO : MODE_TYPE;
REP : REPLY_TYPE;
begin
OPEN(MODE_FILE, IN_FILE, MODE_FULL_NAME);
while not END_OF_FILE(MODE_FILE) loop
GET(MODE_FILE, MO);
GET(MODE_FILE, REP);
WORDS_MODE(MO) := MODE_OF_REPLY(REP);
end loop;
CLOSE(MODE_FILE);
exception
when NAME_ERROR =>
raise;
when others =>
raise BAD_MODE_FILE;
end GET_MODES;
procedure INQUIRE(MO : MODE_TYPE; HELP : in HELP_TYPE := NO_HELP) is
use MODE_TYPE_IO;
use REPLY_TYPE_IO;
L1 : STRING(1..100) := (others => ' ');
LL : NATURAL;
R : REPLY_TYPE;
begin
PUT(MO);
PUT(" ? "); SET_COL(45); PUT("(Currently ");
PUT(REPLY(WORDS_MODE(MO))); PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if TRIM(L1(1..LL)) = "" then
PUT_LINE("Blank input, skipping the rest of CHANGE_PARAMETERS");
raise BLANK_INPUT;
elsif L1(1) = '?' then
PUT(HELP);
INQUIRE(MO, HELP);
else
GET(L1(1..LL), R, LL);
WORDS_MODE(MO) := MODE_OF_REPLY(R);
end if;
end if;
NEW_LINE;
end INQUIRE;
procedure CHANGE_PARAMETERS is
L1 : STRING(1..100) := (others => ' ');
LL : NATURAL;
R : REPLY_TYPE;
begin
PUT_LINE("To set/change parameters reply Y/y or N/n. Return accepts current value.");
PUT_LINE("A '?' reply gives infomation/help on that parameter. A space skips the rest.");
NEW_LINE;
-- Interactive mode - lets you do things on unknown words
-- You can say it is a noun and then look at the endings
-- Or look all the endings and guess what part of speech
-- You can look at the dictionary items that are close to the word
-- There may be cases in which the stem is found but is not of right part
-- So maybe the word list is deficient and that root goes also to a ADJ
-- even if it is listed only for a N.
-- One can also look for ADV here with ending 'e', etc.
-- You can look up the word in a paper dictionary (with the help of ending)
-- And then enter the word into DICT.LOC, so it will hit next time
-- All unknowns could be recorded in a file for later reference
-- A '?' gives information (help) about the item in question
-- One can change the symbol that the main program uses for change and file
-- One can save the new parameters or let them revert to previous
-- There should be a basic set of parameters that one can always go to
-- There should be moods of translation, maybe to switch dictionaries
-- Maybe to turn on or off pre/suffix
-- Maybe to allow the user to look at just all the prefixes that match
INQUIRE(TRIM_OUTPUT, TRIM_OUTPUT_HELP);
INQUIRE(HAVE_OUTPUT_FILE, HAVE_OUTPUT_FILE_HELP);
if IS_OPEN(OUTPUT) and then not WORDS_MODE(HAVE_OUTPUT_FILE) then
CLOSE(OUTPUT);
WORDS_MODE(WRITE_OUTPUT_TO_FILE) := FALSE;
end if;
if not IS_OPEN(OUTPUT) and then WORDS_MODE(HAVE_OUTPUT_FILE) then
begin
CREATE(OUTPUT, OUT_FILE, OUTPUT_FULL_NAME);
exception
when others =>
PUT_LINE("Cannot CREATE WORD.OUT - Check if it is in use elsewhere");
end;
end if;
if WORDS_MODE(HAVE_OUTPUT_FILE) then
INQUIRE(WRITE_OUTPUT_TO_FILE, WRITE_OUTPUT_TO_FILE_HELP);
end if;
INQUIRE(DO_UNKNOWNS_ONLY, DO_UNKNOWNS_ONLY_HELP);
INQUIRE(WRITE_UNKNOWNS_TO_FILE, WRITE_UNKNOWNS_TO_FILE_HELP);
-- If there is an open file then OK
-- If not open and you now want to start writing to UNKNOWNS, the CREATE
if not IS_OPEN(UNKNOWNS) and then WORDS_MODE(WRITE_UNKNOWNS_TO_FILE) then
begin
CREATE(UNKNOWNS, OUT_FILE, UNKNOWNS_FULL_NAME);
exception
when others =>
PUT_LINE("Cannot CREATE WORD.UNK - Check if it is in use elsewhere");
end;
end if;
INQUIRE(IGNORE_UNKNOWN_NAMES, IGNORE_UNKNOWN_NAMES_HELP);
INQUIRE(IGNORE_UNKNOWN_CAPS, IGNORE_UNKNOWN_CAPS_HELP);
INQUIRE(DO_COMPOUNDS, DO_COMPOUNDS_HELP);
INQUIRE(DO_FIXES, DO_FIXES_HELP);
INQUIRE(DO_TRICKS, DO_TRICKS_HELP);
INQUIRE(DO_DICTIONARY_FORMS, DO_DICTIONARY_FORMS_HELP);
INQUIRE(SHOW_AGE, SHOW_AGE_HELP);
INQUIRE(SHOW_FREQUENCY, SHOW_FREQUENCY_HELP);
INQUIRE(DO_EXAMPLES, DO_EXAMPLES_HELP);
INQUIRE(DO_ONLY_MEANINGS, DO_ONLY_MEANINGS_HELP);
INQUIRE(DO_STEMS_FOR_UNKNOWN, DO_STEMS_FOR_UNKNOWN_HELP);
PUT("Do you wish to save this set of parameters? Y or N (Default) ");
PUT(" =>");
GET_LINE(L1, LL);
if LL /= 0 then
if L1(1) = '?' then
PUT(SAVE_PARAMETERS_HELP);
PUT("Do you wish to save this set of parameters? Y or N (Default) ");
PUT(" =>");
GET_LINE(L1, LL);
end if;
REPLY_TYPE_IO.GET(L1(1..LL), R, LL);
if MODE_OF_REPLY(R) then
PUT_MODES;
PUT_LINE("MODE_ARRAY saved in file " & MODE_FULL_NAME);
end if;
end if;
NEW_LINE;
exception
when BLANK_INPUT =>
null;
when others =>
PUT_LINE("Bad input - terminating CHANGE_PARAMETERS");
end CHANGE_PARAMETERS;
procedure INITIALIZE_WORD_PARAMETERS is
begin
WORDS_MODE := DEFAULT_MODE_ARRAY;
--TEXT_IO.PUT_LINE("Initializing WORD_PARAMETERS");
DO_MODE_FILE:
begin
-- Read the mode file
GET_MODES; --(WORDS_MODE);
PREFACE.PUT_LINE("MODE_FILE found - Using those modes and parameters");
exception
-- If there is any problem
-- Put that the mode file is corrupted and the options are:
-- to proceed with default parameters
-- to set parameters with a CHANGE (SET) PARAMETERS and save
-- to examine the mode file with a text editor and try to repair it
when NAME_ERROR =>
WORDS_MODE := DEFAULT_MODE_ARRAY;
when BAD_MODE_FILE =>
PUT_LINE("MODE_FILE exists, but empty or corupted - Default modes used");
PUT_LINE("You can set new parameters with CHANGE PARAMETERS and save.");
WORDS_MODE := DEFAULT_MODE_ARRAY;
when others =>
PUT_LINE("MODE_FILE others ERROR");
WORDS_MODE := DEFAULT_MODE_ARRAY;
end DO_MODE_FILE;
if ((METHOD = INTERACTIVE) or (METHOD = COMMAND_LINE_INPUT)) and then
(not TEXT_IO.IS_OPEN(OUTPUT)) and then
(WORDS_MODE(HAVE_OUTPUT_FILE)) then
TEXT_IO.CREATE(OUTPUT, TEXT_IO.OUT_FILE, OUTPUT_FULL_NAME);
--TEXT_IO.PUT_LINE("WORD.OUT Created at Initialization");
PREFACE.PUT_LINE("WORD.OUT Created at Initialization");
end if;
if not TEXT_IO.IS_OPEN(UNKNOWNS) and then WORDS_MODE(WRITE_UNKNOWNS_TO_FILE) then
TEXT_IO.CREATE(UNKNOWNS, TEXT_IO.OUT_FILE, UNKNOWNS_FULL_NAME);
PREFACE.PUT_LINE("WORD.UNK Created at Initialization");
end if;
end INITIALIZE_WORD_PARAMETERS;
end WORD_PARAMETERS;

63
word_parameters.ads Normal file
View File

@@ -0,0 +1,63 @@
with TEXT_IO;
package WORD_PARAMETERS is
-- This package defines a number of parameters that areused in the program
-- The default values are set in the body, so that they may be changed easily
CHANGE_PARAMETERS_CHARACTER : CHARACTER := '#';
CHANGE_LANGUAGE_CHARACTER : CHARACTER := '~';
HELP_CHARACTER : CHARACTER := '?';
-- These files are used by the program if requested, but not necessary
-- They are all text files and human readable
-- MODE_FILE is used by the program to remember MODE values between runs
MODE_FILE : TEXT_IO.FILE_TYPE;
-- OUTPUT is used to write out and save the results of a run
OUTPUT : TEXT_IO.FILE_TYPE;
INPUT : TEXT_IO.FILE_TYPE;
-- UNKNOWNS is used to record the words that the program fails to find
UNKNOWNS : TEXT_IO.FILE_TYPE;
-- This is a flag to tell if there has been trimming for this word
TRIMMED : BOOLEAN := FALSE;
type MODE_TYPE is (
TRIM_OUTPUT,
HAVE_OUTPUT_FILE,
WRITE_OUTPUT_TO_FILE,
DO_UNKNOWNS_ONLY,
WRITE_UNKNOWNS_TO_FILE,
IGNORE_UNKNOWN_NAMES,
IGNORE_UNKNOWN_CAPS,
DO_COMPOUNDS,
DO_FIXES,
DO_TRICKS,
DO_DICTIONARY_FORMS,
SHOW_AGE,
SHOW_FREQUENCY,
DO_EXAMPLES,
DO_ONLY_MEANINGS,
DO_STEMS_FOR_UNKNOWN );
package MODE_TYPE_IO is new TEXT_IO.ENUMERATION_IO(MODE_TYPE);
type MODE_ARRAY is array (MODE_TYPE) of BOOLEAN;
WORDS_MODE : MODE_ARRAY; -- Initialized in body
procedure CHANGE_PARAMETERS;
procedure INITIALIZE_WORD_PARAMETERS;
end WORD_PARAMETERS;

273
word_support_package.adb Normal file
View File

@@ -0,0 +1,273 @@
with LATIN_FILE_NAMES; use LATIN_FILE_NAMES;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with CONFIG;
with PREFACE;
package body WORD_SUPPORT_PACKAGE is
function LEN(S : STRING) return INTEGER is
begin
return TRIM(S)'LENGTH;
end LEN;
function EFF_PART(PART : PART_OF_SPEECH_TYPE) return PART_OF_SPEECH_TYPE is
begin
if PART = VPAR then
return V;
elsif PART = SUPINE then
return V;
else
return PART;
end if;
end EFF_PART;
function ADJ_COMP_FROM_KEY(KEY : STEM_KEY_TYPE) return COMPARISON_TYPE is
begin
case KEY is
when 0 | 1 | 2 => return POS;
when 3 => return COMP;
when 4 => return SUPER;
when others => return X;
end case;
end ADJ_COMP_FROM_KEY;
function ADV_COMP_FROM_KEY(KEY : STEM_KEY_TYPE) return COMPARISON_TYPE is
begin
case KEY is
when 1 => return POS;
when 2 => return COMP;
when 3 => return SUPER;
when others => return X;
end case;
end ADV_COMP_FROM_KEY;
function NUM_SORT_FROM_KEY(KEY : STEM_KEY_TYPE) return NUMERAL_SORT_TYPE is
begin
case KEY is
when 1 => return CARD;
when 2 => return ORD;
when 3 => return DIST;
when 4 => return ADVERB;
when others => return X;
end case;
end NUM_SORT_FROM_KEY;
function FIRST_INDEX(INPUT_WORD : STRING;
D_K : DICTIONARY_FILE_KIND := DEFAULT_DICTIONARY_FILE_KIND)
return STEM_IO.COUNT is
WD : constant STRING := TRIM(INPUT_WORD); -- string may not start at 1
begin
if D_K = LOCAL then
return DDLF(WD(WD'FIRST), 'a', D_K);
elsif WD'LENGTH < 2 then
return 0; -- BDLF(WD(WD'FIRST), ' ', D_K);
else
return DDLF(WD(WD'FIRST), WD(WD'FIRST+1), D_K);
end if;
end FIRST_INDEX;
function LAST_INDEX(INPUT_WORD : STRING;
D_K : DICTIONARY_FILE_KIND := DEFAULT_DICTIONARY_FILE_KIND)
return STEM_IO.COUNT is
WD : constant STRING := TRIM(INPUT_WORD);
begin -- remember the string may not start at 1
if D_K = LOCAL then
return DDLL(WD(WD'FIRST), 'a', D_K);
elsif WD'LENGTH < 2 then
return 0; -- BDLL(WD(WD'FIRST), ' ', D_K);
else
return DDLL(WD(WD'FIRST), WD(WD'FIRST+1), D_K);
end if;
end LAST_INDEX;
--procedure PUT_INDICES(CH : STRING;
-- D_K : DICTIONARY_KIND) is
-- WD : STRING(1..2) := CH(1..2);
-- begin
-- if CH = " " then
-- if BBLL(CH(1), CH(2), D_K) >= BBLF(CH(1), CH(2), D_K) then
-- PUT("CH = ("); PUT(CH); PUT(") index is of range ");
-- PUT(BBLF(CH(1), CH(2), D_K)); PUT(".."); PUT(BBLL(CH(1), CH(2), D_K));
-- PUT(" number ");
-- PUT(BBLL(CH(1), CH(2), D_K) - BBLF(CH(1), CH(2), D_K) + 1);
-- end if;
-- elsif CH(2) = ' ' then
-- if BDLL(CH(1), CH(2), D_K) >= BDLF(CH(1), CH(2), D_K) then
-- PUT("CH = ("); PUT(CH); PUT(") index is of range ");
-- PUT(BDLF(CH(1), CH(2), D_K)); PUT(".."); PUT(BDLL(CH(1), CH(2), D_K));
-- PUT(" number ");
-- PUT(BDLL(CH(1), CH(2), D_K) - BDLF(CH(1), CH(2), D_K) + 1);
-- end if;
-- else
-- if LAST_INDEX(WD, D_K) >= FIRST_INDEX(WD, D_K) then
-- PUT("CH = ("); PUT(WD); PUT(") index is of range ");
-- PUT(FIRST_INDEX(WD, D_K)); PUT(".."); PUT(LAST_INDEX(WD, D_K));
-- PUT(" number ");
-- PUT(LAST_INDEX(WD, D_K) - FIRST_INDEX(WD, D_K) + 1);
-- end if;
-- end if;
-- NEW_LINE;
-- end PUT_INDICES;
procedure LOAD_BDL_FROM_DISK is
use STEM_IO;
DS : DICTIONARY_STEM;
INDEX_FIRST,
INDEX_LAST : STEM_IO.COUNT := 0;
K : INTEGER := 0;
begin
--PUT_LINE("LOADING BDL FROM DISK");
if DICTIONARY_AVAILABLE(GENERAL) then
-- The blanks are on the GENERAL dictionary
LOADING_BDL_FROM_DISK:
declare
D_K : DICTIONARY_KIND := GENERAL;
begin
if not IS_OPEN(STEM_FILE(D_K)) then
--TEXT_IO.PUT_LINE("LOADING_BDL is going to OPEN " &
--ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
--DICTIONARY_KIND'IMAGE(D_K)));
OPEN(STEM_FILE(D_K), STEM_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
--TEXT_IO.PUT_LINE("OPENing was successful");
end if;
--TEXT_IO.PUT_LINE("BDL OPEN");
INDEX_FIRST := BBLF(' ', ' ', DICTIONARY_KIND(D_K));
INDEX_LAST := BBLL(' ', ' ', DICTIONARY_KIND(D_K));
SET_INDEX(STEM_FILE(D_K), STEM_IO.POSITIVE_COUNT(INDEX_FIRST));
for J in INDEX_FIRST..INDEX_LAST loop
READ(STEM_FILE(D_K), DS);
K := K + 1;
BDL(K) := DS;
end loop;
CLOSE(STEM_FILE(D_K));
--TEXT_IO.PUT_LINE("BDL LOADED FROM DISK K = " & INTEGER'IMAGE(K));
exception
when NAME_ERROR =>
TEXT_IO.PUT_LINE("LOADING BDL FROM DISK had NAME_ERROR on " &
ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
TEXT_IO.PUT_LINE("The will be no blank stems loaded");
when USE_ERROR =>
TEXT_IO.PUT_LINE("LOADING BDL FROM DISK had USE_ERROR on " &
ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
TEXT_IO.PUT_LINE("There will be no blank stems loaded");
end LOADING_BDL_FROM_DISK;
end if;
-- Now load the stems of just one letter
for D_K in GENERAL..DICTIONARY_KIND'LAST loop
if DICTIONARY_AVAILABLE(D_K) then
exit when D_K = LOCAL;
--TEXT_IO.PUT_LINE("OPENING BDL STEMFILE " & EXT(D_K));
if not IS_OPEN(STEM_FILE(D_K)) then
--PUT_LINE("LOADING_BDL is going to OPEN " &
--ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
--DICTIONARY_KIND'IMAGE(D_K)));
OPEN(STEM_FILE(D_K), STEM_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(STEM_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
--STEMFILE." & EXT(D_K));
--PUT_LINE("OPENing was successful");
end if;
for I in CHARACTER range 'a'..'z' loop
INDEX_FIRST := BDLF(I, ' ', D_K);
INDEX_LAST := BDLL(I, ' ', D_K);
if INDEX_FIRST > 0 then
SET_INDEX(STEM_FILE(D_K), STEM_IO.POSITIVE_COUNT(INDEX_FIRST));
for J in INDEX_FIRST..INDEX_LAST loop
READ(STEM_FILE(D_K), DS);
K := K + 1;
BDL(K) := DS;
end loop;
end if;
end loop;
--TEXT_IO.PUT_LINE("Single letters LOADED FROM DISK K = " & INTEGER'IMAGE(K));
CLOSE(STEM_FILE(D_K));
end if;
end loop;
BDL_LAST := K;
--TEXT_IO.PUT("FINISHED LOADING BDL FROM DISK BDL_LAST = ");
--TEXT_IO.PUT(INTEGER'IMAGE(BDL_LAST));
--TEXT_IO.NEW_LINE;
end LOAD_BDL_FROM_DISK;
procedure LOAD_INDICES_FROM_INDX_FILE(INDXFILE_NAME : STRING;
D_K : DICTIONARY_KIND) is
use TEXT_IO;
use INFLECTIONS_PACKAGE.INTEGER_IO;
use STEM_IO;
use COUNT_IO;
CH : STRING(1..2);
M, N : STEM_IO.COUNT;
NUMBER_OF_BLANK_STEMS,
NUMBER_OF_NON_BLANK_STEMS : STEM_IO.COUNT := 0;
S : STRING(1..100) := (others => ' ');
LAST, L : INTEGER := 0;
function MAX(A, B : STEM_IO.COUNT) return STEM_IO.COUNT is
begin
if A >= B then return A; end if; return B;
end MAX;
begin
OPEN(INDX_FILE(D_K), TEXT_IO.IN_FILE,
ADD_FILE_NAME_EXTENSION(INDX_FILE_NAME,
DICTIONARY_KIND'IMAGE(D_K)));
--"INDXFILE." & EXT(D_K)); -- $$$$$$$$$$$$
PREFACE.PUT(DICTIONARY_KIND'IMAGE(D_K));
PREFACE.PUT(" Dictionary loading");
if D_K = GENERAL then
GET_LINE(INDX_FILE(D_K), S, LAST);
CH := S(1..2);
GET(S(4..LAST), M, L);
BBLF(CH(1), CH(2), D_K) := M;
GET(S(L+1..LAST), N, L);
BBLL(CH(1), CH(2), D_K) := N;
NUMBER_OF_BLANK_STEMS := MAX(NUMBER_OF_BLANK_STEMS, N);
end if;
while not END_OF_FILE(INDX_FILE(D_K)) loop
GET_LINE(INDX_FILE(D_K), S, LAST);
exit when LAST = 0;
CH := S(1..2);
GET(S(4..LAST), M, L);
if CH(2) = ' ' then
BDLF(CH(1), CH(2), D_K) := M;
else
DDLF(CH(1), CH(2), D_K) := M;
end if;
GET(S(L+1..LAST), N, L);
if CH(2) = ' ' then
BDLL(CH(1), CH(2), D_K) := N;
NUMBER_OF_BLANK_STEMS := MAX(NUMBER_OF_BLANK_STEMS, N);
else
DDLL(CH(1), CH(2), D_K) := N;
NUMBER_OF_NON_BLANK_STEMS := MAX(NUMBER_OF_NON_BLANK_STEMS, N);
end if;
end loop;
CLOSE(INDX_FILE(D_K));
PREFACE.SET_COL(33); PREFACE.PUT("-- ");
if not CONFIG.SUPPRESS_PREFACE then
PUT(STEM_IO.COUNT((NUMBER_OF_NON_BLANK_STEMS)), 6);
end if; -- Kludge for when TEXT_IO.COUNT too small
PREFACE.PUT(" stems");
PREFACE.SET_COL(55); PREFACE.PUT_LINE("-- Loaded correctly");
end LOAD_INDICES_FROM_INDX_FILE;
end WORD_SUPPORT_PACKAGE;

72
word_support_package.ads Normal file
View File

@@ -0,0 +1,72 @@
with TEXT_IO;
with DIRECT_IO;
with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
package WORD_SUPPORT_PACKAGE is
FOLLOWED_BY_PERIOD, FOLLOWS_PERIOD, CAPITALIZED, ALL_CAPS :
BOOLEAN := FALSE;
type DICTIONARY_STEM is
record
STEM : STEM_TYPE := NULL_STEM_TYPE;
PART : PART_ENTRY := NULL_PART_ENTRY;
KEY : STEM_KEY_TYPE := 0;
MNPC : DICT_IO.COUNT := NULL_MNPC;
end record;
package STEM_IO is new DIRECT_IO(DICTIONARY_STEM);
package COUNT_IO is new TEXT_IO.INTEGER_IO(STEM_IO.COUNT);
subtype DICTIONARY_FILE_KIND is DICTIONARY_KIND range GENERAL..LOCAL;
DEFAULT_DICTIONARY_FILE_KIND : DICTIONARY_FILE_KIND := GENERAL;
STEM_FILE : array (DICTIONARY_FILE_KIND) of STEM_IO.FILE_TYPE;
STEM_LIST : array (DICTIONARY_FILE_KIND) of TEXT_IO.FILE_TYPE;
INDX_FILE : array (DICTIONARY_FILE_KIND) of TEXT_IO.FILE_TYPE;
type DICT_ARRAY is array (POSITIVE range <>) of DICTIONARY_STEM;
BDL : DICT_ARRAY(1..100);
BDL_LAST : INTEGER := 0;
--SIZE_OF_DICTIONARY_ARRAY : constant INTEGER := 120; -- ###################
--DDL : DICT_ARRAY(1..SIZE_OF_DICTIONARY_ARRAY);
type DICT_ARRAY_INDEX is array (CHARACTER range <>,
CHARACTER range <>,
DICTIONARY_FILE_KIND range <>) of STEM_IO.COUNT;
BBLF, BBLL : DICT_ARRAY_INDEX(' '..' ', ' '..' ', DICTIONARY_FILE_KIND) :=
(others => (others => (others => 0)));
BDLF, BDLL : DICT_ARRAY_INDEX('a'..'z', ' '..' ', DICTIONARY_FILE_KIND) :=
(others => (others => (others => 0)));
DDLF, DDLL : DICT_ARRAY_INDEX('a'..'z', 'a'..'z', DICTIONARY_FILE_KIND) :=
(others => (others => (others => 0)));
function ADJ_COMP_FROM_KEY(KEY : STEM_KEY_TYPE) return COMPARISON_TYPE;
function ADV_COMP_FROM_KEY(KEY : STEM_KEY_TYPE) return COMPARISON_TYPE;
function NUM_SORT_FROM_KEY(KEY : STEM_KEY_TYPE) return NUMERAL_SORT_TYPE;
function EFF_PART(PART : PART_OF_SPEECH_TYPE) return PART_OF_SPEECH_TYPE;
function LEN(S : STRING) return INTEGER;
function FIRST_INDEX(INPUT_WORD : STRING;
D_K : DICTIONARY_FILE_KIND := DEFAULT_DICTIONARY_FILE_KIND)
return STEM_IO.COUNT;
function LAST_INDEX(INPUT_WORD : STRING;
D_K : DICTIONARY_FILE_KIND := DEFAULT_DICTIONARY_FILE_KIND)
return STEM_IO.COUNT;
procedure LOAD_INDICES_FROM_INDX_FILE(INDXFILE_NAME : STRING;
D_K : DICTIONARY_KIND);
procedure LOAD_BDL_FROM_DISK;
end WORD_SUPPORT_PACKAGE;

145
words.adb Normal file
View File

@@ -0,0 +1,145 @@
with Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with STRINGS_PACKAGE; use STRINGS_PACKAGE;
with CONFIG; use CONFIG;
with WORD_PARAMETERS; use WORD_PARAMETERS;
with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
with WORD_PACKAGE; use WORD_PACKAGE;
with PARSE;
procedure WORDS is
INPUT_LINE : STRING(1..250) := (others => ' ');
ARGUMENTS_START : INTEGER := 1;
begin
-- The language shift in argumants must take place here
-- since later parsing of line ignores non-letter characters
CONFIGURATION := DEVELOPER_VERSION;
--The main mode of usage for WORDS is a simple call, followed by screen interaction.
if Ada.Command_Line.ARGUMENT_COUNT = 0 then -- Simple WORDS
METHOD := INTERACTIVE; -- Interactive
SUPPRESS_PREFACE := FALSE;
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
INITIALIZE_WORD_PARAMETERS;
INITIALIZE_DEVELOPER_PARAMETERS;
INITIALIZE_WORD_PACKAGE;
PARSE;
--But there are other, command line options.
--WORDS may be called with arguments on the same line,
--in a number of different modes.
--
else
SUPPRESS_PREFACE := TRUE;
INITIALIZE_WORD_PARAMETERS;
INITIALIZE_DEVELOPER_PARAMETERS;
INITIALIZE_WORD_PACKAGE;
--Single parameter, either a simple Latin word or an input file.
--WORDS amo
--WORDS infile
if Ada.Command_Line.ARGUMENT_COUNT = 1 then -- Input 1 word in-line
ONE_ARGUMENT:
declare
INPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(1));
begin
OPEN(INPUT, IN_FILE, INPUT_NAME); -- Try file name, not raises NAME_ERROR
METHOD := COMMAND_LINE_FILES;
SET_INPUT(INPUT);
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
PARSE; -- No additional arguments, so just go to PARSE now
exception -- Triggers on INPUT
when NAME_ERROR => -- Raised NAME_ERROR therefore
METHOD := COMMAND_LINE_INPUT; -- Found word in command line
end ONE_ARGUMENT;
--With two arguments the options are: inputfile and outputfile,
--two Latin words, or a language shift to English (Latin being the startup default)
--and an English word (with no part of speech).
--WORDS infile outfile
--WORDS amo amas
--WORDS ^e love
elsif Ada.Command_Line.ARGUMENT_COUNT = 2 then -- INPUT and OUTPUT files
TWO_ARGUMENTS: -- or multiwords in-line
declare
INPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(1));
OUTPUT_NAME : constant STRING := TRIM(Ada.Command_Line.Argument(2));
begin
if INPUT_NAME(1) = CHANGE_LANGUAGE_CHARACTER then
if (INPUT_NAME'LENGTH > 1) then
CHANGE_LANGUAGE(INPUT_NAME(2));
ARGUMENTS_START := 2;
METHOD := COMMAND_LINE_INPUT; -- Parse the one word
end if;
else
OPEN(INPUT, IN_FILE, INPUT_NAME);
CREATE(OUTPUT, OUT_FILE, OUTPUT_NAME);
METHOD := COMMAND_LINE_FILES;
SET_INPUT(INPUT);
SET_OUTPUT(OUTPUT);
SUPPRESS_PREFACE := TRUE;
OUTPUT_SCREEN_SIZE := INTEGER'LAST;
PARSE; -- No additional arguments, so just go to PARSE now
SET_INPUT(Ada.TEXT_IO.STANDARD_INPUT); -- Clean up
SET_OUTPUT(Ada.TEXT_IO.STANDARD_OUTPUT);
CLOSE(OUTPUT);
end if;
exception -- Triggers on either INPUT or OUTPUT !!!
when NAME_ERROR =>
METHOD := COMMAND_LINE_INPUT; -- Found words in command line
end TWO_ARGUMENTS;
--With three arguments there could be three Latin words or a language shift
--and and English word and part of speech.
--WORDS amo amas amat
--WORDS ^e love v
elsif Ada.Command_Line.ARGUMENT_COUNT = 3 then -- INPUT and OUTPUT files
THREE_ARGUMENTS: -- or multiwords in-line
declare
ARG1 : constant STRING := TRIM(Ada.Command_Line.Argument(1));
ARG2 : constant STRING := TRIM(Ada.Command_Line.Argument(2));
ARG3 : constant STRING := TRIM(Ada.Command_Line.Argument(3));
begin
if ARG1(1) = CHANGE_LANGUAGE_CHARACTER then
if (ARG1'LENGTH > 1) then
CHANGE_LANGUAGE(ARG1(2));
ARGUMENTS_START := 2;
METHOD := COMMAND_LINE_INPUT; -- Parse the one word
end if;
else
METHOD := COMMAND_LINE_INPUT;
end if;
end THREE_ARGUMENTS;
--More than three arguments must all be Latin words.
--WORDS amo amas amat amamus amatis amant
else -- More than three arguments
METHOD := COMMAND_LINE_INPUT;
end if;
if METHOD = COMMAND_LINE_INPUT then -- Process words in command line
MORE_ARGUMENTS:
begin
--Ada.TEXT_IO.PUT_LINE("MORE_ARG ARG_START = " & INTEGER'IMAGE(ARGUMENTS_START));
SUPPRESS_PREFACE := TRUE;
for I in ARGUMENTS_START..Ada.Command_Line.Argument_Count loop -- Assemble input words
INPUT_LINE := HEAD(TRIM(INPUT_LINE) & " " & Ada.Command_Line.Argument(I), 250);
end loop;
--Ada.TEXT_IO.PUT_LINE("To PARSE >" & TRIM(INPUT_LINE));
PARSE(TRIM(INPUT_LINE));
end MORE_ARGUMENTS;
end if;
end if;
end WORDS;

4611
wordsdoc.htm Normal file
View File

File diff suppressed because it is too large Load Diff