summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-07 19:15:26 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-07 19:19:26 (GMT)
commit2bae7da012e2125762855ce014e63345ecbbbb18 (patch) (side-by-side diff)
tree61faec7672937f8fc420310da0ff531ce9c6a6bb
parent79447034e393dc5c7f01f3ec0ca1de7ded4f15e6 (diff)
downloadellinika-2bae7da012e2125762855ce014e63345ecbbbb18.tar.gz
ellinika-2bae7da012e2125762855ce014e63345ecbbbb18.tar.bz2
Improve conjugator
* data/dbverb.struct: Remove individual verb definitions. * data/irregular-verbs.xml: New file. * scm/verbop.scm: New file. * scm/Makefile.am: Add rules for verbop. * scm/conjugator.scm: Various fixes. * src/ellinika/elmorph.c (elstr-accent-position): Fix handling of string arguments. (_elstr_set_accent): Fix error message. (elstr-set-accent-character) (elstr-set-accent-character!): New functions.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--data/dbverb.struct101
-rw-r--r--data/irregular-verbs.xml641
-rw-r--r--scm/.gitignore2
-rw-r--r--scm/Makefile.am7
-rw-r--r--scm/conjugator.scm189
-rw-r--r--scm/verbop.scm676
-rw-r--r--src/ellinika/elmorph.c66
7 files changed, 1516 insertions, 166 deletions
diff --git a/data/dbverb.struct b/data/dbverb.struct
index af9d236..06745c8 100644
--- a/data/dbverb.struct
+++ b/data/dbverb.struct
@@ -32,7 +32,7 @@ DROP TABLE IF EXISTS conjugation;
CREATE TABLE conjugation(
conj char(2), -- REL 9
voice enum('act','pas'), -- Ενεργητηκή/Μεσοπαθητική
- mode enum('ind','sub','imp'),
+ mood enum('ind','sub','imp'),
tense varchar(128),
thema enum('pres','aor','sub','synt'), -- Ενεστώτα, Αόριστου, υποτακτικής, syntethic
suffix char(32),
@@ -43,7 +43,7 @@ CREATE TABLE conjugation(
auxtense char(32),
KEY (conj),
KEY (voice),
- KEY (mode)
+ KEY (mood)
);
DROP TABLE IF EXISTS participle;
@@ -243,98 +243,21 @@ CREATE TABLE verb(
INDEX(verb)
);
-DROP TABLE IF EXISTS irregular_root;
-CREATE TABLE irregular_root(
- verb varchar(128),
- voice enum('act','pas'), -- Ενεργητηκή/Μεσοπαθητική
- thema enum('pres','aor','sub'), -- Αόριστος/Υποτακτική
- root varchar(128)
-);
-
-INSERT INTO verb VALUES
-('βρίσκω', 'A', NULL, '000000', NULL),
-('θέλω','A','η',NULL, NULL),
-('έχω','A',NULL,'000000', NULL),
-('ξέρω','A','η',NULL, NULL),
-('κρεμάω','B1',NULL,NULL,"ασ"),
-('κρεμώ','B1',NULL,NULL,"ασ"),
-('κιτάω','B1',NULL,NULL,"αξ"),
-('κιτώ','B1',NULL,NULL,"αξ"),
-('τραβάω','B1',NULL,NULL,"ηξ"),
-('τραβώ','B1',NULL,NULL,"ηξ"),
-('νικώ','B1',NULL,NULL,NULL)
-;
-
-INSERT INTO irregular_root VALUES
-('βρίσκω','act','aor','βρήκ'),
-('βρίσκω','act','sub','βρ'),
-('βρίσκω','pas','aor','βρέθ'),
-('βρίσκω','pas','sub','βρέθ'),
-('θέλω','act','aor','θέλησ')
-;
-
DROP TABLE IF EXISTS individual_verb;
CREATE TABLE individual_verb(
verb varchar(128),
- voice enum('act','pas'), -- Ενεργητηκή/Μεσοπαθητική
- mode enum('ind','sub','imp'),
+ voice enum('act','pas'),
+ mood enum('ind','sub','imp'),
tense varchar(128),
ident int(32),
- INDEX(verb,voice,mode,tense)
+ INDEX(verb,voice,mood,tense)
);
-INSERT INTO individual_verb VALUES
-("είμαι", "act", "ind", "Ενεστώτας", 100),
-("είμαι", "act", "ind", "Παρατατικός", 101),
-("είμαι", "act", "ind", "Μέλλοντας διαρκείας", 102),
-("είμαι", "act", "ind", "Αόριστος", 0),
-("είμαι", "act", "ind", "Παρακείμενος", 0),
-("είμαι", "act", "ind", "Υπερσυντέλικος", 0),
-("είμαι", "act", "ind", "Συντελεσμένος μέλλοντας", 0),
-("είμαι", "act", "ind", "Μέλλοντας στιγμιαίος", 0),
-("είμαι", "act", "sub", "Ενεστώτας", 103),
-("είμαι", "act", "sub", "Αόριστος", 0),
-("είμαι", "act", "sub", "Παρακείμενος", 0),
-("είμαι", "act", "imp", "Ενεστώτας", 104),
-("είμαι", "act", "imp", "Αόριστος", 0),
-("είμαι", "act", "imp", "Παρακείμενος", 0),
-("είμαι", "pas", "ind", "Ενεστώτας", 0),
-("είμαι", "pas", "ind", "Παρατατικός", 0),
-("είμαι", "pas", "ind", "Μέλλοντας διαρκείας", 0),
-("είμαι", "pas", "ind", "Αόριστος", 0),
-("είμαι", "pas", "ind", "Παρακείμενος", 0),
-("είμαι", "pas", "ind", "Υπερσυντέλικος", 0),
-("είμαι", "pas", "ind", "Συντελεσμένος μέλλοντας", 0),
-("είμαι", "pas", "ind", "Μέλλοντας στιγμιαίος", 0),
-("είμαι", "pas", "sub", "Ενεστώτας", 0),
-("είμαι", "pas", "sub", "Αόριστος", 0),
-("είμαι", "pas", "sub", "Παρακείμενος", 0),
-("είμαι", "pas", "imp", "Ενεστώτας", 0),
-("είμαι", "pas", "imp", "Αόριστος", 0),
-("είμαι", "pas", "imp", "Παρακείμενος", 0),
+DROP TABLE IF EXISTS irregular_root;
+CREATE TABLE irregular_root(
+ verb varchar(128),
+ voice enum('act','pas'), -- Ενεργητηκή/Μεσοπαθητική
+ thema enum('pres','aor','sub'), -- Αόριστος/Υποτακτική
+ root varchar(128)
+);
-("έχω", "act", "ind", "Παρατατικός", 105),
-("έχω", "act", "ind", "Αόριστος", 0),
-("έχω", "act", "ind", "Παρακείμενος", 0),
-("έχω", "act", "ind", "Υπερσυντέλικος", 0),
-("έχω", "act", "ind", "Συντελεσμένος μέλλοντας", 0),
-("έχω", "act", "ind", "Μέλλοντας στιγμιαίος", 0),
-("έχω", "act", "sub", "Αόριστος", 0),
-("έχω", "act", "sub", "Παρακείμενος", 0),
-("έχω", "act", "imp", "Αόριστος", 0),
-("έχω", "act", "imp", "Παρακείμενος", 0),
-("έχω", "pas", "ind", "Παρατατικός", 0),
-("έχω", "pas", "ind", "Μέλλοντας διαρκείας", 0),
-("έχω", "pas", "ind", "Αόριστος", 0),
-("έχω", "pas", "ind", "Παρακείμενος", 0),
-("έχω", "pas", "ind", "Υπερσυντέλικος", 0),
-("έχω", "pas", "ind", "Συντελεσμένος μέλλοντας", 0),
-("έχω", "pas", "ind", "Μέλλοντας στιγμιαίος", 0),
-("έχω", "pas", "sub", "Ενεστώτας", 0),
-("έχω", "pas", "sub", "Αόριστος", 0),
-("έχω", "pas", "sub", "Παρακείμενος", 0),
-("έχω", "pas", "imp", "Ενεστώτας", 0),
-("έχω", "pas", "imp", "Αόριστος", 0),
-("έχω", "pas", "imp", "Παρακείμενος", 0),
-("βρίσκω", "act", "imp", "Αόριστος", 106)
-;
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml
new file mode 100644
index 0000000..ca2c7d1
--- a/dev/null
+++ b/data/irregular-verbs.xml
@@ -0,0 +1,641 @@
+<i>
+ <v>
+ <a>είμαι</a>
+ <c>I</c>
+ <act>
+ <ind>
+ <t name="Ενεστώτας">
+ <p n="s" p="1">είμαι</p>
+ <p n="s" p="2">είσαι</p>
+ <p n="s" p="3">είναι</p>
+ <p n="p" p="1">είμαστε</p>
+ <p n="p" p="2">είστε,είσαστε</p>
+ <p n="p" p="3">είναι</p>
+ </t>
+ <t name="Παρατατικός">
+ <p n="s" p="1">ήμουν(α)</p>
+ <p n="s" p="2">ήσουν(α)</p>
+ <p n="s" p="3">ήταν(ε)</p>
+ <p n="p" p="1">ήμαστε,ήμασταν</p>
+ <p n="p" p="2">ήσαστε,ήσασταν</p>
+ <p n="p" p="3">ήταν(ε)</p>
+ </t>
+ <t name="Μέλλοντας διαρκείας">
+ <p n="s" p="1">θα είμαι</p>
+ <p n="s" p="2">θα είσαι</p>
+ <p n="s" p="3">θα είναι</p>
+ <p n="p" p="1">θα είμαστε</p>
+ <p n="p" p="2">θα είστε,θα είσαστε</p>
+ <p n="p" p="3">θα είναι</p>
+ </t>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ <t name="Υπερσυντέλικος"/>
+ <t name="Συντελεσμένος μέλλοντας"/>
+ <t name="Μέλλοντας στιγμιαίος"/>
+ </ind>
+ <sub>
+ <t name="Ενεστώτας">
+ <p n="s" p="1">να είμαι</p>
+ <p n="s" p="2">να είσαι</p>
+ <p n="s" p="3">να είναι</p>
+ <p n="p" p="1">να είμαστε</p>
+ <p n="p" p="2">να είστε,θα είσαστε</p>
+ <p n="p" p="3">να είναι</p>
+ </t>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </sub>
+ <imp>
+ <t name="Ενεστώτας">
+ <p n="s" p="2">να είσαι</p>
+ <p n="p" p="2">να είστε</p>
+ </t>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </imp>
+ </act>
+
+ <pas>
+ <ind>
+ <t name="Ενεστώτας"/>
+ <t name="Παρατατικός"/>
+ <t name="Μέλλοντας διαρκείας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ <t name="Υπερσυντέλικος"/>
+ <t name="Συντελεσμένος μέλλοντας"/>
+ <t name="Μέλλοντας στιγμιαίος"/>
+ </ind>
+ <sub>
+ <t name="Ενεστώτας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </sub>
+ <imp>
+ <t name="Ενεστώτας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </imp>
+ </pas>
+ </v>
+
+ <v>
+ <a>έχω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <ind>
+ <t name="Παρατατικός">
+ <p n="s" p="1">είχα</p>
+ <p n="s" p="2">είχες</p>
+ <p n="s" p="3">είχα</p>
+ <p n="p" p="1">είχαμε</p>
+ <p n="p" p="2">είχατε</p>
+ <p n="p" p="3">είχαν</p>
+ </t>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ <t name="Υπερσυντέλικος"/>
+ <t name="Συντελεσμένος μέλλοντας"/>
+ <t name="Μέλλοντας στιγμιαίος"/>
+ </ind>
+ <sub>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </sub>
+ <imp>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </imp>
+ </act>
+ <pas>
+ <ind>
+ <t name="Ενεστώτας"/>
+ <t name="Παρατατικός"/>
+ <t name="Μέλλοντας διαρκείας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ <t name="Υπερσυντέλικος"/>
+ <t name="Συντελεσμένος μέλλοντας"/>
+ <t name="Μέλλοντας στιγμιαίος"/>
+ </ind>
+ <sub>
+ <t name="Ενεστώτας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </sub>
+ <imp>
+ <t name="Ενεστώτας"/>
+ <t name="Αόριστος" />
+ <t name="Παρακείμενος"/>
+ </imp>
+ </pas>
+ </v>
+
+ <v>
+ <a>κρεμώ</a>
+ <c>B1</c>
+ <suffix>ασ</suffix>
+ </v>
+
+ <v>
+ <a>κιτώ</a>
+ <c>B1</c>
+ <suffix>αξ</suffix>
+ </v>
+
+ <v>
+ <a>τραβώ</a>
+ <c>B1</c>
+ <suffix>ηξ</suffix>
+ </v>
+
+ <v>
+ <a>νικώ</a>
+ <c>B1</c>
+ </v>
+
+ <v>
+ <a>θέλω</a>
+ <c>A</c>
+ <act>
+ <aor>θέλησ</aor>
+ </act>
+ </v>
+
+ <v>
+ <a>αγγέλω</a>
+ <c>A</c>
+ <act>
+ <aor>αγγείλ</aor>
+ </act>
+ </v>
+
+ <v>
+ <a>άγω</a>
+ <c>A</c>
+ <act>
+ <aor>ήγαγ</aor>
+ <root theme="sub">αγάγ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>ανεβαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">ανέβηκ</root>
+ <root theme="sub">ανέβ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>απονέμω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">απένειμ</root>
+ <root theme="sub">απονείμ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>αρέσω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">αρεσ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>βάλλω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">βαλ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>βαραίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">βαρυν</root>
+ </act>
+ </v>
+
+ <v>
+ <a>βαστώ</a>
+ <c>B2</c>
+ <suffix>ηξ</suffix> <!-- also αξ -->
+ </v>
+
+ <v>
+ <a>βγάζω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">βγαλ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>βγαίνω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">βγήκ</root>
+ <root theme="sub">βγ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>βλέπω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">είδ</root>
+ <root theme="sub">δ</root>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">δες</p>
+ <p n="p" p="2">δείτε,δέστε</p>
+ </t>
+ </imp>
+ </act>
+ </v>
+
+ <v>
+ <a>βρίσκω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">βρήκ</root>
+ <root theme="sub">βρ</root>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">βρες</p>
+ <p n="p" p="2">βρείτε,βρέστε</p>
+ </t>
+ </imp>
+ </act>
+ <pas>
+ <aor>βρέθ</aor>
+ </pas>
+ </v>
+
+ <v>
+ <a>γελώ</a>
+ <c>B2</c>
+ <suffix>ασ</suffix>
+ </v>
+
+ <v>
+ <a>γέρνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">γειρ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>γίνομαι</a> <!-- FIXME: deponentium -->
+ <c>A</c>
+ <act>
+ <root theme="aor">γίν</root>
+ </act>
+ </v>
+
+ <v>
+ <a>διαβαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">διάβηκ</root>
+ <sub>
+ <t name="Αόριστος">
+ <p n="s" p="1">διαβώ</p>
+ <p n="s" p="2">διαβείς</p>
+ <p n="s" p="3">διαβεί</p>
+ <p n="p" p="1">διαβούμε</p>
+ <p n="p" p="2">διαβέτε</p>
+ <p n="p" p="3">διαβούν</p>
+ </t>
+ </sub>
+ </act>
+ </v>
+
+ <v>
+ <a>διδάσκω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">διδαξ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>δίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">δωσ</root>
+ </act>
+ </v>
+
+<!-- FIXME
+ έρχομαι
+ κάθομαι
+-->
+
+ <v>
+ <a>καίω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">καψ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>κάν</a>
+ <c>A</c>
+ </v>
+
+ <v>
+ <a>κλαίω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">κλαψ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>λαβαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">λαβ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>λέω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">είπ</root>
+ <root theme="sub">π</root>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">πες</p>
+ <p n="p" p="2">πείτε,πέστε</p>
+ </t>
+ </imp>
+ </act>
+ </v>
+
+<!-- FIXME: λέγω -> λέω -->
+
+ <v>
+ <a>μαθαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">μαθ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>μπαίνω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">μπηκ</root>
+ <root theme="sub">μπ</root>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">μπες</p>
+ <p n="p" p="2">μπείτε</p>
+ </t>
+ </imp>
+ </act>
+ </v>
+
+ <v>
+ <a></a>
+ <c>A</c>
+ <act>
+ <root theme="aor"></root>
+ <root theme="sub"></root>
+ </act>
+ </v>
+
+ <v>
+ <a>ξέρω</a>
+ <c>A</c>
+ <augment>η</augment>
+ </v>
+
+ <v>
+ <a>παθαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">παθ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>περνώ</a>
+ <c>B1</c>
+ <suffix>ασ</suffix>
+ </v>
+
+ <v>
+ <a>πέφτω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">πεσ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>πηγαίνω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">πήγ</root>
+ <ind>
+ <t name="Μέλλοντας στιγμιαίος">
+ <p n="s" p="1">θα πάω</p>
+ <p n="s" p="2">θα πας</p>
+ <p n="s" p="3">θα πάει</p>
+ <p n="p" p="1">θα πάμε</p>
+ <p n="p" p="2">θα πάτε</p>
+ <p n="p" p="3">θα πάνε</p>
+ </t>
+ </ind>
+ <sub>
+ <t name="Αόριστος">
+ <p n="s" p="1">να πάω</p>
+ <p n="s" p="2">να πας</p>
+ <p n="s" p="3">να πάει</p>
+ <p n="p" p="1">να πάμε</p>
+ <p n="p" p="2">να πάτε</p>
+ <p n="p" p="3">να πάνε</p>
+ </t>
+ </sub>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">πήγαινε</p>
+ <p n="p" p="2">πηγαίνετε</p>
+ </t>
+ </imp>
+ </act>
+ </v>
+
+ <v>
+ <a>πίνω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">ήπι</root> <!-- FIXME:Syllabizer -->
+ <root theme="sub">πι</root>
+ <imp>
+ <t name="Αόριστος">
+ <p n="s" p="2">πιες</p>
+ <p n="p" p="2">πιείτε,πιέστε</p>
+ </t>
+ </imp>
+ </act>
+ </v>
+
+ <v>
+ <a>πλέω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">πλευσ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>πονώ</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">πονεσ</root>
+ </act>
+ </v>
+
+<!-- FIXME σέβομαι -->
+
+ <v>
+ <a>σέρνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">συρ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>σπέρνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">σπειρ</root>
+ </act>
+ </v>
+
+<!-- FIXME: στέκομαι,στέκο -->
+
+ <v>
+ <a>στέλνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">στείλ</root>
+ </act>
+ </v>
+
+<!-- FIXME: συμβαίνει -->
+
+ <v>
+ <a>τείνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">τειν</root>
+ </act>
+ </v>
+
+ <v>
+ <a>τραβώ</a>
+ <c>B1</c>
+ <suffix>ηξ</suffix>
+ </v>
+
+ <v>
+ <a>τρέφω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">θρεψ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>τρώω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">φαγ</root>
+ <root theme="sub">φα</root>
+ </act>
+ </v>
+
+ <v>
+ <a>τυχαίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">τυχ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>υπάρχω</a>
+ <c>A</c>
+ <accmap>000000</accmap>
+ <act>
+ <root theme="aor">υπήρξ</root>
+ <root theme="sub">υπάρξ</root>
+ </act>
+ </v>
+
+<!-- FIXME: υπόσχομαι, φαίνομαι -->
+
+ <v>
+ <a>φέυγω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">φυγ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>φορώ</a>
+ <c>B1</c>
+ <suffix>εσ</suffix>
+ </v>
+
+ <v>
+ <a>φταίω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">φταιξ</root>
+ </act>
+ </v>
+
+<!-- FIXME χαίρομαι -->
+
+ <v>
+ <a>χορταίνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">χορτασ</root>
+ </act>
+ </v>
+
+ <v>
+ <a>ψέλνω</a>
+ <c>A</c>
+ <act>
+ <root theme="aor">ψαλ</root>
+ </act>
+ </v>
+
+</i>
diff --git a/scm/.gitignore b/scm/.gitignore
index d033647..0e10ba2 100644
--- a/scm/.gitignore
+++ b/scm/.gitignore
@@ -1,4 +1,4 @@
dictrans
dictrans.sed
neatrans
-
+verbop
diff --git a/scm/Makefile.am b/scm/Makefile.am
index f2669f4..481676f 100644
--- a/scm/Makefile.am
+++ b/scm/Makefile.am
@@ -15,8 +15,8 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
pkgmoddir=@GUILE_SITE@
-bin_SCRIPTS=dictrans neatrans
-CLEANFILES=dictrans.sed dictrans
+bin_SCRIPTS=dictrans neatrans verbop
+CLEANFILES=dictrans.sed dictrans neatrans verbop
EXTRA_DIST=dictrans.scm
dictrans.sed: Makefile
@@ -34,3 +34,6 @@ neatrans: $(srcdir)/neatrans.scm dictrans.sed
sed -f dictrans.sed $(srcdir)/neatrans.scm > $@
chmod +x $@
+verbop: $(srcdir)/verbop.scm dictrans.sed
+ sed -f dictrans.sed $(srcdir)/verbop.scm > $@
+ chmod +x $@
diff --git a/scm/conjugator.scm b/scm/conjugator.scm
index ceda52a..7b2a4a6 100644
--- a/scm/conjugator.scm
+++ b/scm/conjugator.scm
@@ -128,15 +128,21 @@ WHERE verb='" (force-string verb) "'"
(elstr-append root "θ"))
(else
#f)))
-
+
+(define (lookup-verb-info verb voice thema)
+ (my-sql-query
+ (dict-connect)
+ (string-append
+ "SELECT root FROM irregular_root \
+WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
+
(define (complement-verb-info vinfo verb voice thema)
; (format #t "COMPLEMENT ~S~%" thema)
(let ((elverb (string->elstr verb))
- (result (my-sql-query
- (dict-connect)
- (string-append
- "SELECT root FROM irregular_root \
-WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))))
+ (result (let ((tmpres (lookup-verb-info verb voice thema)))
+ (if (and (null? tmpres) (string=? thema "sub"))
+ (lookup-verb-info verb voice "aor")
+ tmpres))))
(verb-info-set! #:root vinfo
(cond
((not (null? result))
@@ -247,7 +253,7 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))))
((conj-info-set! #:particle v val)
(list-set! v 3 val))))
-(define (get-conj-info conj voice mode tense)
+(define (get-conj-info conj voice mood tense)
(let ((conn (dict-connect)))
(let ((answer (my-sql-query
conn
@@ -255,7 +261,7 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))))
"SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,\
f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
FROM conjugation c, verbflect f \
-WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode
+WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
"' AND c.tense='" tense "' AND c.flect = f.ident"))))
(if (null? answer)
#f
@@ -271,7 +277,17 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode
(string->elstr str)
str))
-(define (apply-flect conj vinfo)
+(define (accented-syllable-0 str)
+ (let ((syl (elstr-accented-syllable str))
+ (len (elstr-number-of-syllables str)))
+ (if (= syl 0)
+ syl
+ (+ (- len syl) 1))))
+
+(define (set-accented-syllable-0! str nsyl)
+ (elstr-set-accent! str (+ (- (elstr-number-of-syllables str) nsyl) 1)))
+
+(define (apply-flect conj vinfo verb)
(let ((root (verb-info #:root vinfo))
(suffix (let ((s (conj-info #:suffix conj)))
(if s
@@ -294,20 +310,29 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode
((char=? acc #\0)
(let* ((rs (force-elstr root))
(suf (elstr-deaccent (elstr-append suffix flect)))
- (result (elstr-append rs suf)))
- (cond
- ((or (= (elstr-accented-syllable rs) 0)
- (> (elstr-number-of-syllables suf) 2))
- (let ((nsyl (elstr-number-of-syllables suf)))
- (cond
- ((= nsyl 1)
- result)
- ((= nsyl 3)
- (elstr-set-accent result 3))
- (else
- (elstr-set-accent result 2)))))
- (else
- result))))
+ (result (elstr-append rs suf))
+ (acc-syl (let ((n (accented-syllable-0 rs)))
+ (if (= 0 n)
+ (accented-syllable-0 verb)
+ n))))
+ (if (> (elstr-number-of-syllables result) 1)
+ (set-accented-syllable-0! result acc-syl))
+ (let ((acc-syl (elstr-accented-syllable result)))
+ (cond
+ ((and (= acc-syl 1)
+ (= (elstr-number-of-syllables result) 1))
+ (elstr-deaccent result))
+ ((> acc-syl 3)
+ (let ((nsyl (elstr-number-of-syllables suf)))
+ (cond
+ ((= nsyl 1)
+ result)
+ ((= nsyl 3)
+ (elstr-set-accent result 3))
+ (else
+ (elstr-set-accent result 2)))))
+ (else
+ result)))))
((char=? acc #\f)
(elstr-append
(elstr-deaccent (elstr-append root suffix))
@@ -340,13 +365,13 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode
forms)
(map force-string forms)))))
-(define (individual-verb verb voice mode tense)
+(define (individual-verb verb voice mood tense)
(let ((res (my-sql-query
(dict-connect)
(string-append
"SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
FROM individual_verb i,verbflect f \
-WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mode='" mode
+WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
"' AND i.tense = '" tense "' AND i.ident=f.ident"))))
(if (not (null? res))
(append (car res)
@@ -354,17 +379,17 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mode='" mode
'(class root)))
#f)))
-(define (conjugate verb voice mode tense . rest)
+(define (conjugate verb voice mood tense . rest)
(cond
- ((individual-verb verb voice mode tense) =>
+ ((individual-verb verb voice mood tense) =>
(lambda (res)
res))
(else
(let* ((vinfo (get-verb-info verb))
- (conj (get-conj-info (verb-info #:conj vinfo) voice mode tense)))
+ (conj (get-conj-info (verb-info #:conj vinfo) voice mood tense)))
(if (not conj)
(error "cannot obtain conjugation information for "
- (verb-info #:conj vinfo) voice mode tense))
+ (verb-info #:conj vinfo) voice mood tense))
(if (member #:nopart rest)
(conj-info-set! #:particle conj #f))
(cond
@@ -386,7 +411,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mode='" mode
(else
; (format #t "CONJ ~S~%" conj)
(complement-verb-info vinfo verb voice (conj-info #:thema conj))
- (append (apply-flect conj vinfo)
+ (append (apply-flect conj vinfo verb)
(list (verb-info #:conj vinfo)
(verb-info #:attested vinfo)))))))))
@@ -423,9 +448,9 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mode='" mode
(define (term x)
(or (assoc-ref transtab x) x))
-(define (test-conjugation verb voice mode tense)
- (format #t "~A ~A/~A/~A: " verb (term voice) (term mode) tense)
- (let* ((result (conjugate verb voice mode tense))
+(define (test-conjugation verb voice mood tense)
+ (format #t "~A ~A/~A/~A: " verb (term voice) (term mood) tense)
+ (let* ((result (conjugate verb voice mood tense))
(conj (conjugation:table result)))
(cond
((empty-conjugation? conj)
@@ -444,42 +469,64 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mode='" mode
(newline)
(gc))
-(test-conjugation "είμαι" "act" "ind" "Ενεστώτας")
-(test-conjugation "είμαι" "act" "ind" "Παρατατίκος")
-(test-conjugation "είμαι" "act" "ind" "Μέλλοντας διαρκείας")
-(test-conjugation "είμαι" "act" "sub" "Ενεστώτας")
-(test-conjugation "είμαι" "act" "imp" "Ενεστώτας")
-(test-conjugation "είμαι" "act" "ind" "Αόριστος")
-
-(test-conjugation "έχω" "act" "ind" "Ενεστώτας")
-(test-conjugation "έχω" "act" "ind" "Παρατατίκος")
-(test-conjugation "έχω" "act" "ind" "Μέλλοντας διαρκείας")
-(test-conjugation "έχω" "act" "sub" "Ενεστώτας")
-(test-conjugation "έχω" "act" "imp" "Ενεστώτας")
-(test-conjugation "έχω" "act" "imp" "Αόριστος")
-
-(test-conjugation "ανοίγω" "act" "ind" "Ενεστώτας")
-(test-conjugation "ανοίγω" "act" "ind" "Αόριστος")
-(test-conjugation "ανοίγω" "pas" "ind" "Αόριστος")
-(test-conjugation "δένω" "act" "ind" "Αόριστος")
-(test-conjugation "θέλω" "act" "ind" "Αόριστος")
-(test-conjugation "θέλω" "act" "ind" "Παρατατικός")
-(test-conjugation "βρίσκω" "act" "ind" "Ενεστώτας")
-(test-conjugation "βρίσκω" "act" "ind" "Αόριστος")
-(test-conjugation "βρίσκω" "act" "ind" "Μέλλοντας στιγμιαίος")
-(test-conjugation "βρίσκω" "pas" "ind" "Αόριστος")
-(test-conjugation "βρίσκω" "act" "sub" "Ενεστώτας")
-(test-conjugation "βρίσκω" "act" "sub" "Αόριστος")
-(test-conjugation "βρίσκω" "act" "ind" "Παρακείμενος")
-(test-conjugation "βρίσκω" "act" "sub" "Παρακείμενος")
-(test-conjugation "βρίσκω" "act" "imp" "Αόριστος")
-
-(test-conjugation "νικάω" "act" "ind" "Ενεστώτας")
-(test-conjugation "νικάω" "act" "ind" "Αόριστος")
-(test-conjugation "νικώ" "act" "ind" "Ενεστώτας")
-(test-conjugation "νικώ" "act" "ind" "Αόριστος")
-(test-conjugation "νικώ" "pas" "ind" "Αόριστος")
-(test-conjugation "κρεμάω" "act" "ind" "Αόριστος")
-(test-conjugation "κιτάω" "act" "ind" "Αόριστος")
-(test-conjugation "τραβάω" "act" "ind" "Αόριστος")
+;; (test-conjugation "είμαι" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "είμαι" "act" "ind" "Παρατατίκος")
+;; (test-conjugation "είμαι" "act" "ind" "Μέλλοντας διαρκείας")
+;; (test-conjugation "είμαι" "act" "sub" "Ενεστώτας")
+;; (test-conjugation "είμαι" "act" "imp" "Ενεστώτας")
+;; (test-conjugation "είμαι" "act" "ind" "Αόριστος")
+
+;; (test-conjugation "έχω" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "έχω" "act" "ind" "Παρατατίκος")
+;; (test-conjugation "έχω" "act" "ind" "Μέλλοντας διαρκείας")
+;; (test-conjugation "έχω" "act" "sub" "Ενεστώτας")
+;; (test-conjugation "έχω" "act" "imp" "Ενεστώτας")
+;; (test-conjugation "έχω" "act" "imp" "Αόριστος")
+
+;; (test-conjugation "ανοίγω" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "ανοίγω" "act" "ind" "Αόριστος")
+;; (test-conjugation "ανοίγω" "pas" "ind" "Αόριστος")
+;; (test-conjugation "δένω" "act" "ind" "Αόριστος")
+;; (test-conjugation "θέλω" "act" "ind" "Αόριστος")
+;; (test-conjugation "θέλω" "act" "ind" "Παρατατικός")
+;; (test-conjugation "βρίσκω" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "βρίσκω" "act" "ind" "Αόριστος")
+;; (test-conjugation "βρίσκω" "act" "ind" "Μέλλοντας στιγμιαίος")
+;; (test-conjugation "βρίσκω" "pas" "ind" "Αόριστος")
+;; (test-conjugation "βρίσκω" "act" "sub" "Ενεστώτας")
+;; (test-conjugation "βρίσκω" "act" "sub" "Αόριστος")
+;; (test-conjugation "βρίσκω" "act" "ind" "Παρακείμενος")
+;; (test-conjugation "βρίσκω" "act" "sub" "Παρακείμενος")
+;; (test-conjugation "βρίσκω" "act" "imp" "Αόριστος")
+
+;; (test-conjugation "νικάω" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "νικάω" "act" "ind" "Αόριστος")
+;; (test-conjugation "νικώ" "act" "ind" "Ενεστώτας")
+;; (test-conjugation "νικώ" "act" "ind" "Αόριστος")
+;; (test-conjugation "νικώ" "pas" "ind" "Αόριστος")
+;; (test-conjugation "κρεμάω" "act" "ind" "Αόριστος")
+;; (test-conjugation "κιτάω" "act" "ind" "Αόριστος")
+;; (test-conjugation "τραβάω" "act" "ind" "Αόριστος")
+
+;; (test-conjugation "αγγέλω" "act" "ind" "Αόριστος")
+;; (test-conjugation "αγγέλω" "act" "sub" "Αόριστος")
+;; (test-conjugation "άγω" "act" "ind" "Αόριστος")
+;; (test-conjugation "άγω" "act" "sub" "Αόριστος")
+;; (test-conjugation "ανεβαίνω" "act" "ind" "Αόριστος")
+;; (test-conjugation "ανεβαίνω" "act" "sub" "Αόριστος")
+;; (test-conjugation "απονέμω" "act" "ind" "Αόριστος")
+;; (test-conjugation "απονέμω" "act" "sub" "Αόριστος")
+;; (test-conjugation "αρέσω" "act" "ind" "Αόριστος")
+;; (test-conjugation "αρέσω" "act" "sub" "Αόριστος")
+;; (test-conjugation "βάλλω" "act" "ind" "Αόριστος")
+;; (test-conjugation "βάλλω" "act" "sub" "Αόριστος")
+;; (test-conjugation "βγαίνω" "act" "ind" "Αόριστος")
+;; (test-conjugation "βγαίνω" "act" "sub" "Αόριστος")
+;; (test-conjugation "βλέπω" "act" "ind" "Αόριστος")
+;; (test-conjugation "βλέπω" "act" "sub" "Αόριστος")
+;; (test-conjugation "βλέπω" "act" "imp" "Αόριστος")
+(test-conjugation "πηγαίνω" "act" "ind" "Μέλλοντας στιγμιαίος")
+(test-conjugation "πίνω" "act" "ind" "Αόριστος")
+(test-conjugation "πίνω" "act" "sub" "Αόριστος")
+(test-conjugation "πίνω" "act" "imp" "Αόριστος")
(newline)
diff --git a/scm/verbop.scm b/scm/verbop.scm
new file mode 100644
index 0000000..bb54126
--- a/dev/null
+++ b/scm/verbop.scm
@@ -0,0 +1,676 @@
+(use-modules (srfi srfi-1)
+ (xmltools xmltrans)
+ (ellinika elmorph)
+ (gamma sql)
+ (ellinika xlat)
+ (ice-9 getopt-long))
+
+(define cleanup-option #f)
+(define force-option #f)
+(define verbose-option #f)
+(define dry-run-option #f)
+(define debug-level 0)
+(define input-files '())
+(define flect-ident 0)
+
+(define (next-flect-ident)
+ (set! flect-ident (1+ flect-ident))
+ flect-ident)
+
+(define connection #f) ; SQL connection
+
+(define sysconf-dir "=SYSCONFDIR=")
+(define config-file-name "ellinika.conf")
+
+(define ellinika-sql-connection '())
+
+(define (add-conn-param key val)
+ (set! ellinika-sql-connection (cons (cons key val) ellinika-sql-connection)))
+
+;;; Load the site defaults
+(let ((rc-file (string-append sysconf-dir "/" config-file-name)))
+ (if (file-exists? rc-file)
+ (load rc-file)))
+
+(define (debug level . rest)
+ (if (>= debug-level level)
+ (begin
+ (for-each
+ (lambda (x)
+ (display x))
+ rest)
+ (newline))))
+
+(define (sql-val val)
+ ;; FIXME: quote
+ (if (not val)
+ "NULL"
+ (string-append "\"" val "\"")))
+
+(define (run-query . rest)
+ (debug 100 rest)
+ (let ((q (apply format (cons #f rest))))
+ (if verbose-option
+ (format #t "QUERY: ~S\n" q))
+ (cond
+ (connection
+ (let ((res (sql-query connection q)))
+ (if verbose-option
+ (format #t "RESULT: ~S\n" res))
+ res))
+ (else
+ #f))))
+
+(define (query-number q)
+ (let ((res (run-query q)))
+ (if (null? res)
+ #f
+ (string->number (caar res)))))
+
+(define (check-parent elt . rest)
+ (call-with-current-continuation
+ (lambda (return)
+ (for-each
+ (lambda (parent)
+ (if (xmltrans:parent? parent)
+ (return #t)))
+ rest)
+ (xmltrans:parse-error #f elt " not a child of " rest)
+ (mark-invalid)
+ (return #f))))
+
+;;;; Internal structures
+
+;;; Tense is a list of 6 elements or #f
+(define tense #f)
+
+(define (tense-init)
+ (set! tense (make-list 6 #f)))
+
+(define (tense-set n val)
+ (if (not tense) (tense-init))
+ (list-set! tense n val))
+
+(define (get-tense)
+ (let ((ret tense))
+ (set! tense #f)
+ ret))
+
+;;; Mood is an associative list. Possible keys are:
+;;; Tense
+(define mood '())
+
+(define (get-mood)
+ (let ((ret mood))
+ (set! mood '())
+ ret))
+
+(define (mood-set key val)
+ (set! mood (append mood (list (cons key val)))))
+
+;;; Conjugation is an associative list of moods
+
+(define conjugation '())
+
+(define (get-conjugation)
+ (let ((ret conjugation))
+ (set! conjugation '())
+ ret))
+
+(define (conjugation-set key val)
+ (set! conjugation (append conjugation (list (cons key val)))))
+
+;;; Verb structure:
+(define verbdef '())
+
+(define (verbdef:index c)
+ (case c
+ ((#:verb) 0)
+ ((#:class) 1)
+ ((#:action) 2)
+ ((#:augment) 3)
+ ((#:suffix) 4)
+ ((#:accmap) 5)
+ ((#:act) 6)
+ ((#:pas) 7)
+ ((#:validity) 8)
+ (else
+ (error "Unknown index " c))))
+
+(define (verb-get what)
+ (if (null? verbdef)
+ #f
+ (list-ref verbdef (verbdef:index what))))
+
+(define (verb-get-sql what)
+ (sql-val (verb-get what)))
+
+(define (verb-set what val)
+ (if (null? verbdef)
+ (verb-init))
+ (list-set! verbdef (verbdef:index what) val))
+
+(define (verb-init)
+ (set! verbdef (make-list 9 #f))
+ (verb-set #:validity #t)
+ (verb-set #:action 'insert))
+
+(define (mark-invalid)
+ (verb-set #:validity #f))
+
+(define (verbdef-validate)
+ (call-with-current-continuation
+ (lambda (return)
+ (if (verb-get #:validity)
+ (let ((dict-form (verb-get #:verb)))
+ (cond ((not dict-form)
+ (xmltrans:parse-error #f "Dictionary form missing")
+ (verb-set #:validity #f)
+ (return #f)))
+ (if (not (verb-get #:class))
+ (cond
+ ((elstr-suffix? dict-form "άω")
+ (verb-set #:class "B1"))
+ ((elstr-suffix? dict-form "ώ")
+ (xmltrans:parse-warning #f "Class not set, assuming B2")
+ (verb-set #:class "B2"))
+ (else
+ (xmltrans:parse-warning #f "Class not set, assuming A")
+ (verb-set #:class "A"))))))
+ (return (verb-get #:validity)))))
+
+(define (mood-key->string key)
+ (case key
+ ((#:ind) "ind")
+ ((#:sub) "sub")
+ ((#:imp) "imp")
+ (else
+ (error "Unknown mood key" key))))
+
+(define (empty-conjugation? conj)
+ (call-with-current-continuation
+ (lambda (return)
+ (for-each
+ (lambda (x)
+ (if x
+ (return #f)))
+ conj)
+ (return #t))))
+
+(define (flush-mood mood vstr)
+ (if (eq? (car mood) #:root)
+ (let ((val (cdr mood)))
+ (run-query "INSERT INTO irregular_root (verb,voice,thema,root) \
+VALUES (~A,~A,~A,~A);~%"
+ (verb-get-sql #:verb)
+ (sql-val vstr)
+ (sql-val (car val))
+ (sql-val (cdr val))))
+ (let ((mood-str (mood-key->string (car mood))))
+ (for-each
+ (lambda (p)
+ (let ((key (car p)))
+ (debug 1 "flush-mood: " p)
+ (cond
+ ((empty-conjugation? (cdr p))
+ (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \
+VALUES (~A,~A,~A,~A,~A);~%"
+ (verb-get-sql #:verb)
+ (sql-val vstr)
+ (sql-val mood-str)
+ (sql-val key)
+ "0"))
+ (else
+ (let ((num (next-flect-ident))
+ (l (cdr p)))
+ (run-query "INSERT INTO verbflect VALUES (~A,~A,~A,~A,~A,~A,~A);~%"
+ num
+ (sql-val (list-ref l 0))
+ (sql-val (list-ref l 1))
+ (sql-val (list-ref l 2))
+ (sql-val (list-ref l 3))
+ (sql-val (list-ref l 4))
+ (sql-val (list-ref l 5)))
+ (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \
+VALUES (~A,~A,~A,~A,~A);~%"
+ (verb-get-sql #:verb)
+ (sql-val vstr)
+ (sql-val mood-str)
+ (sql-val key)
+ num) )))))
+ (cdr mood)))))
+
+(define (flush-voice vstr conj-list)
+ (if conj-list
+ (for-each
+ (lambda (mood)
+ (flush-mood mood vstr))
+ conj-list)))
+
+;;; Fush verb definition to the database
+(define (verb-flush)
+ ;;
+ (case (verb-get #:action)
+ ((insert)
+ (run-query "INSERT INTO verb (verb,conj,augment,accmap,suffix_aor_path) \
+VALUES (~A,~A,~A,~A,~A);~%"
+ (verb-get-sql #:verb)
+ (verb-get-sql #:class)
+ (verb-get-sql #:augment)
+ (verb-get-sql #:accmap)
+ (verb-get-sql #:suffix))
+ (flush-voice "act" (verb-get #:act))
+ (flush-voice "pas" (verb-get #:pas)))
+ ((delete update)
+ (xmltrans:parse-error #f
+ "Sorry update and delete are not yet supported"))))
+
+;;;; XML definitions
+
+;;; Set the default handler
+(define tag-list '())
+
+(define (lingua:default-start tag attr)
+ (xmltrans:set-attr #f "__START__" 1)
+ #f)
+
+(xmltrans:set-default-start-handler lingua:default-start)
+
+(define (lingua:default-end tag attr text)
+ (if (xmltrans:attr attr "__START__")
+ (xmltrans:parse-error #f "Unhandled element " tag))
+ (set! tag-list
+ (cons
+ (xmltrans:make-tag tag attr text)
+ tag-list))
+ #f)
+
+(xmltrans:set-default-end-handler lingua:default-end)
+
+;; <i>
+(xmltrans:end-tag
+ "i"
+ (tag attr text)
+ #f)
+
+
+;; <v>...</v> - Verb definition
+(xmltrans:end-tag
+ "v"
+ (tag attr text)
+ (check-parent tag "i")
+ (if (verbdef-validate)
+ (verb-flush))
+ (verb-init)
+ #f)
+
+;; <a>verb</a> - Verb in dictionary form
+(xmltrans:end-tag
+ "a"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond ((verb-get #:verb)
+ (xmltrans:parse-error #f "Verb was already defined")
+ (mark-invalid)))
+ (verb-set #:verb text)
+ #f)
+
+;;; <c>class</c> - Set conjugation class
+(xmltrans:end-tag
+ "c"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:class)
+ (xmltrans:parse-error #f "Verb class was already defined")
+ (mark-invalid))
+ ((not (or (string=? text "A")
+ (string=? text "B1")
+ (string=? text "B2")
+ (string=? text "I")))
+ (xmltrans:parse-warning #f "Unknown or misspelled verb class")))
+ (verb-set #:class text)
+ #f)
+
+;;; <action>insert|delete|update</action> - Define action
+(xmltrans:end-tag
+ "action"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:action)
+ (xmltrans:parse-error #f "Action was already defined")
+ (mark-invalid)))
+ (let ((act (string->symbol text)))
+ (case act
+ ((insert delete update)
+ (verb-set #:action act))
+ (else
+ (xmltrans:parse-error #f "Unknown action ~A~%" text))))
+ #f)
+
+;;; <augment>C</augment> - Define augment
+(xmltrans:end-tag
+ "augment"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:augment)
+ (xmltrans:parse-error #f "Augment was already defined")
+ (mark-invalid))
+ ((not (or (string= text "η")
+ (string= text "ε")))
+ (xmltrans:parse-warning #f "Suspicious augment")))
+ (verb-set #:augment text)
+ #f)
+
+;;; <suffix>S</suffix> - Define aorist suffix for B verbs
+(xmltrans:end-tag
+ "suffix"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:suffix)
+ (xmltrans:parse-error #f "Suffix was already defined")
+ (mark-invalid)))
+ (verb-set #:suffix text)
+ #f)
+
+;;;
+(define accmap-char-set
+ (char-set-adjoin (char-set-copy char-set:digit) #\s #\f #\-))
+
+(define (valid-accent-map? accmap)
+ (let* ((acclist (string->list accmap))
+ (len (length acclist)))
+ (and
+ (or (= len 6) (= len 7))
+ (fold
+ (lambda (ch prev)
+ (char-set-contains? accmap-char-set ch))
+ #t
+ (list-head acclist 6))
+ (or (= len 6) (char=? (list-ref acclist 6) #\+)))))
+
+;;; <accmap>MAP</suffix> - Define accent map
+(xmltrans:end-tag
+ "accmap"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:accmap)
+ (xmltrans:parse-error #f "Accmap was already defined")
+ (mark-invalid))
+ ((not (valid-accent-map? text))
+ (xmltrans:parse-error #f "Invalid accent map")
+ (mark-invalid))
+ (else
+ (verb-set #:accmap text)))
+ #f)
+
+;;; <act>...</act> - Define conjugation in active voice
+(xmltrans:end-tag
+ "act"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:act)
+ (xmltrans:parse-error #f "Active voice was already defined")
+ (mark-invalid)))
+ (verb-set #:act (get-conjugation))
+ #f)
+
+;;; <pas>...</pas> - Define conjugation in passive voice
+(xmltrans:end-tag
+ "pas"
+ (tag attr text)
+ (check-parent tag "v")
+ (cond
+ ((verb-get #:pas)
+ (xmltrans:parse-error #f "Passive voice was already defined")
+ (mark-invalid)))
+ (verb-set #:pas (get-conjugation))
+ #f)
+
+;;; <ind>...</ind> - Indicative
+(xmltrans:end-tag
+ "ind"
+ (tag attr text)
+ (check-parent tag "act" "pas")
+ (conjugation-set #:ind (get-mood))
+ #f)
+
+;;; <sub>...</sub> - Subjunctive
+(xmltrans:end-tag
+ "sub"
+ (tag attr text)
+ (check-parent tag "act" "pas")
+ (conjugation-set #:sub (get-mood))
+ #f)
+
+;;; <imp>...</imp> - Imperative
+(xmltrans:end-tag
+ "imp"
+ (tag attr text)
+ (check-parent tag "act" "pas")
+ (conjugation-set #:imp (get-mood))
+ #f)
+
+;;; <aor>root</aor> - Define aorist root
+(xmltrans:end-tag
+ "aor"
+ (tag attr text)
+ (check-parent tag "act" "pas")
+ (conjugation-set #:root (cons "aor" text))
+ #f)
+
+;;; <root theme="aor|sub|pres">root</root> - Define aorist root
+(xmltrans:end-tag
+ "root"
+ (tag attr text)
+ (check-parent tag "act" "pas")
+ (let ((theme (xmltrans:attr attr "theme")))
+ (cond
+ ((not theme)
+ (xmltrans:parse-error #f "Required attribute `theme' not specified")
+ (mark-invalid))
+ ((or (string=? theme "aor")
+ (string=? theme "sub")
+ (string=? theme "pres"))
+ (conjugation-set #:root (cons theme text)))
+ (else
+ (xmltrans:parse-error #f "Unknown verb theme")
+ (mark-invalid))))
+ #f)
+
+
+;;; <t name="S">...</t> - Define a tense
+(xmltrans:start-tag
+ "t"
+ (tag attr)
+ (check-parent tag "ind" "sub" "imp")
+ (tense-init)
+ #f)
+
+(xmltrans:end-tag
+ "t"
+ (tag attr text)
+ (let ((name (xmltrans:attr attr "name")))
+ (if (not name)
+ (begin
+ (xmltrans:parse-error #f "Required attribute `name' not specified")
+ (mark-invalid)))
+ (mood-set name (get-tense)))
+ #f)
+
+;;; <p n="[sp]" n="[123]">...</p> - Define a person
+(xmltrans:end-tag
+ "p"
+ (tag attr text)
+ (check-parent tag "t")
+ (call-with-current-continuation
+ (lambda (return)
+ (let ((number (xmltrans:attr attr "n"))
+ (person (xmltrans:attr attr "p"))
+ (elt #f))
+ (cond
+ ((not number)
+ (xmltrans:parse-error #f "Required attribute `n' not specified")
+ (return))
+ ((not person)
+ (xmltrans:parse-error #f "Required attribute `p' not specified")
+ (return))
+ ((string=? person "1")
+ (set! elt 0))
+ ((string=? person "2")
+ (set! elt 1))
+ ((string=? person "3")
+ (set! elt 2))
+ (else
+ (xmltrans:parse-error #f "Invalid value for `p'")
+ (return)))
+ (cond
+ ((string=? number "s") 0)
+ ((string=? number "p")
+ (set! elt (+ 3 elt)))
+ (else
+ (xmltrans:parse-error #f "Invalid value for `n'")
+ (return)))
+ (tense-set elt text))))
+ #f)
+
+
+
+;;; DB functions
+(define (escape-string str)
+ (let loop ((lst '())
+ (str str))
+ (cond
+ ((string-index str #\") =>
+ (lambda (pos)
+ (loop (append lst (list (substring str 0 pos)
+ "\\\""))
+ (substring str (1+ pos)))))
+ (else
+ (apply string-append (append lst (list str)))))))
+
+
+;;;; Main
+(define grammar
+ `((check (single-char #\c))
+ (cleanup)
+ (database (single-char #\d) (value #t))
+ (host (single-char #\h) (value #t))
+ (port (single-char #\P) (value #t))
+ (password (single-char #\p) (value #t))
+ (user (single-char #\u) (value #t))
+ (dry-run (single-char #\n))
+ (interface (value #t))
+ (verbose (single-char #\v))
+ (debug (value #t))
+ (help)))
+
+(define (usage)
+ (display "usage: verbop OPTIONS FILES
+
+General options:
+
+ --check Only check input syntax and consistency. Do not
+ update the database. This means that the program will
+ not access the database at all, so some errors
+ (mistyped parts of speech and the like) may slip in
+ unnoticed.
+ --verbose Verbosely display SQL queries and their results.
+ --debug NUMBER Set debugging level (0 < NUMBER <= 100)
+ --dry-run Do nothing, display what would have been done.
+
+SQL related options:
+
+ --interface STRING Select SQL interface to use. STRING may be
+ either \"mysql\" (the default) or \"postgres\".
+ --host HOST-OR-PATH Set name or IP address of the host running SQL
+ database, or path to the database I/O socket.
+ --database NAME Set name of the database to use.
+ --port NUMBER Set the SQL port number
+ --user USER-NAME Set SQL user name.
+ --password STRING Set the SQL password
+
+ --cleanup Clean up the database (delete all entries from all the
+ tables) before proceeding. Use this option with care.
+
+Informational options:
+
+ --help Output this help info
+\n"))
+
+(define (cons? p)
+ (and (pair? p) (not (list? p))))
+
+(for-each
+ (lambda (x)
+ (cond
+ ((cons? x)
+ (case (car x)
+ ((cleanup)
+ (set! cleanup-option #t))
+ ((database)
+ (add-conn-param #:db (cdr x)))
+ ((host)
+ (add-conn-param #:host (cdr x)))
+ ((port)
+ (add-conn-param #:port (string->number (cdr x))))
+ ((password)
+ (add-conn-param #:pass (cdr x)))
+ ((user)
+ (add-conn-param #:user (cdr x)))
+ ((interface)
+ (add-conn-param #:iface (cdr x)))
+ ((verbose)
+ (set! verbose-option #t))
+ ((preserve)
+ (set! preserve-option #t))
+ ((debug)
+ (set! debug-level (string->number (cdr x))))
+ ((dry-run)
+ (set! verbose-option #t)
+ (set! dry-run-option #t))
+ ((help)
+ (usage)
+ (exit 0))))
+ (else
+ (set! input-files (cdr x)))))
+ (getopt-long (command-line) grammar))
+
+(if (null? input-files)
+ (begin
+ (display "Input files not specified\n" (current-error-port))
+ (exit 1)))
+
+(cond
+ ((not dry-run-option)
+ (set! connection (sql-open-connection ellinika-sql-connection))
+ (if (not connection)
+ (begin
+ (display "Cannot connect to the database\n" (current-error-port))
+ (exit 1)))
+ (run-query "SET NAMES utf8")
+ (set! flect-ident (query-number "SELECT MAX(ident) FROM verbflect"))))
+
+(cond
+ (cleanup-option
+ (run-query "DELETE FROM verbflect where ident > 99")
+ (run-query "DELETE FROM verb")
+ (run-query "DELETE FROM irregular_root")
+ (run-query "DELETE FROM individual_verb")))
+
+(for-each
+ (lambda (x)
+ (if (not (xmltrans:parse-file x))
+ (exit 1)))
+ input-files)
+
+(if connection
+ (sql-close-connection connection))
+
+
+
diff --git a/src/ellinika/elmorph.c b/src/ellinika/elmorph.c
index f55e010..1831610 100644
--- a/src/ellinika/elmorph.c
+++ b/src/ellinika/elmorph.c
@@ -352,7 +352,7 @@ SCM_DEFINE_PUBLIC(scm_elstr_accent_position, "elstr-accent-position", 1, 0, 0,
#define FUNC_NAME s_scm_elstr_accent_position
{
struct elstr *elstr;
- force_elstr(&elstr, el, 0, SCM_ARG1, FUNC_NAME);
+ force_elstr(&elstr, el, 1, SCM_ARG1, FUNC_NAME);
return scm_from_uint(elstr->acc_pos);
}
#undef FUNC_NAME
@@ -559,7 +559,7 @@ _elstr_set_accent(SCM el, SCM n, int destructive, const char *func_name)
if (num > elstr->nsyl)
scm_misc_error(func_name,
"cannot set accent on syllable #~S: not enough syllables: ~S",
- scm_list_2(el, n));
+ scm_list_2(n, el));
acc_num = elstr->nsyl - num;
if (acc_num == 0)
start = 0;
@@ -613,7 +613,67 @@ SCM_DEFINE_PUBLIC(scm_elstr_set_accent_x, "elstr-set-accent!",
{
return _elstr_set_accent(el, n, 1, s_scm_elstr_set_accent_x);
}
-#undef FUNC_NAME
+
+static SCM
+_elstr_set_accent_on_char(SCM el, SCM n, int destructive, const char *func_name)
+{
+ struct elstr *elstr;
+ unsigned i;
+ unsigned acc_num, num, len, start;
+ SCM scm;
+ int dstate;
+
+ if (destructive) {
+ SCM_ASSERT(scm_is_elstr(el), el, SCM_ARG1, func_name);
+ elstr = (struct elstr*) SCM_CDR(el);
+ } else
+ scm = force_elstr(&elstr, el, 0, SCM_ARG1, func_name);
+
+ SCM_ASSERT(scm_is_integer(n), n, SCM_ARG2, func_name);
+ num = scm_to_uint(n);
+ if (num > elstr->len)
+ scm_misc_error(func_name,
+ "cannot set accent on character #~S: not enough characters: ~S",
+ scm_list_2(el, n));
+ if (!elchr_isvowel(elstr->str[num]))
+ scm_misc_error(func_name,
+ "cannot set accent on character #~S: not a vowel: ~S",
+ scm_list_2(el, n));
+
+ if (destructive)
+ scm = SCM_UNSPECIFIED;
+ else if (scm == el) {
+ scm = _elstr_dup(elstr);
+ elstr = (struct elstr*) SCM_CDR(scm);
+ }
+
+ /* Clear all accents */
+ for (i = 0; i < elstr->len; i++)
+ elstr->str[i] = elchr_deaccent(elstr->str[i]);
+
+ elstr->str[num] = elchr_accent(elstr->str[num], CHF_OXEIA);
+ _elstr_syllabize(elstr);
+ return scm;
+}
+
+SCM_DEFINE_PUBLIC(scm_elstr_set_accent_character, "elstr-set-accent-character",
+ 2, 0, 0,
+ (SCM el, SCM n),
+"Set accent on Nth character of EL\n")
+{
+ return _elstr_set_accent_on_char(el, n, 0,
+ s_scm_elstr_set_accent_character);
+}
+
+SCM_DEFINE_PUBLIC(scm_elstr_set_accent_character_x,
+ "elstr-set-accent-character!",
+ 2, 0, 0,
+ (SCM el, SCM n),
+"Set accent on Nth character of EL (destructive)\n")
+{
+ return _elstr_set_accent_on_char(el, n, 1,
+ s_scm_elstr_set_accent_character_x);
+}
SCM_DEFINE_PUBLIC(scm_elstr_char_prop_bitmask, "elstr-char-prop-bitmask",
2, 0, 0,

Return to:

Send suggestions and report system problems to the System administrator.