aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 02:21:00 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-14 02:26:46 +0300
commitbee3becef44e298f59d72cee3c8e552bccb10d65 (patch)
treed62e1cc162c52f89b2c7a7fb8aa7a3f0e2df115f
parentd7b0bf03404d26c7c972b3040725eda339f57122 (diff)
downloadellinika-bee3becef44e298f59d72cee3c8e552bccb10d65.tar.gz
ellinika-bee3becef44e298f59d72cee3c8e552bccb10d65.tar.bz2
Improve verb database structure for better handling of individual verbs.
* data/dbverb.struct (verbflect): Split alternative flections into separate groups. (conjugation): Set fold values for imp. Add missing accmaps (verb): Drop table. (verbclass,verbtense): New tables. * data/irregular-verbs.xml: Update. * scm/verbop.scm: Rewrite for the new database structure. * src/ellinika/conjugator.scm: Likewise. * src/ellinika/tests/conj/ntynv.scm: Fix typo. * src/ellinika/tests/conj/bastv.scm: New file. * src/ellinika/tests/conj/kauomai.scm: New file.
-rw-r--r--data/dbverb.struct63
-rw-r--r--data/irregular-verbs.xml63
-rw-r--r--scm/verbop.scm332
-rw-r--r--src/ellinika/conjugator.scm427
-rw-r--r--src/ellinika/tests/conj/bastv.scm3
-rw-r--r--src/ellinika/tests/conj/kauomai.scm4
-rw-r--r--src/ellinika/tests/conj/ntynv.scm2
7 files changed, 563 insertions, 331 deletions
diff --git a/data/dbverb.struct b/data/dbverb.struct
index d12704a..c3ce606 100644
--- a/data/dbverb.struct
+++ b/data/dbverb.struct
@@ -34,7 +34,7 @@ CREATE TABLE conjugation(
voice enum('act','pas'), -- Ενεργητηκή/Μεσοπαθητική
mood enum('ind','sub','imp'),
tense varchar(128),
- thema char(32), -- enum('pres','aor','sub','synt'), -- Ενεστώτα, Αόριστου, υποτακτικής, syntethic
+ thema char(32), -- enum('pres','aor','sub','synt'), -- Ενεστώτα, Αόριστου, υποτακτικής, synthetic
suffix char(32),
flect int(32), -- REL 8
accmap char(7), -- accent map
@@ -71,7 +71,8 @@ INSERT INTO verbflect VALUES
(17, NULL, "ου", NULL, NULL, NULL, NULL),
(18, NULL, NULL, NULL, NULL, "είτε", NULL),
-- Συζυγία Β΄ - α΄ τάξη
-(20, "ώ,άω", "άς", "ά,άει","άμε,ούμε","άτε","ούν(ε)"),
+(20, "ώ", "άς", "ά","άμε","άτε","ούν(ε)"),
+(21, "άω", "άς", "άει","ούμε","άτε","ούν(ε)"),
(25, NULL, "α", NULL, NULL, "άτε", NULL),
(28, "ιέμαι", "ιέσαι", "ιέται", "ιόμαστε", "ιέστε", "ιούνται"),
(29, "ιόμουν", "ιόσουν", "ιόταν", "ιόμαστε", "ιόσαστε", "ιόνταν"),
@@ -82,14 +83,7 @@ INSERT INTO verbflect VALUES
(33, NULL, "είς", NULL, NULL, "είτε", NULL),
(34, "ούμαι", "είσαι", "είται", "ούμαστε", "είστε", "ούνται"),
(35, "ούμουν", "ούσουν", "ούvταν", "ούμαστε", "ούσαστε", "ούνταν"),
-(36, NULL, "είσαι", NULL, NULL, "είστε", NULL),
-(100, "είμαι", "είσαι", "είναι", "είμαστε", "είστε,είσαστε", "είναι"),
-(101, "ήμουν(α)", "ήσουν(α)", "ήταν(ε)", "ήμαστε,ήμασταν", "ήσαστε,ήσασταν", "ήταν(ε)"),
-(102, "θα είμαι", "θα είσαι", "θα είναι", "θα είμαστε", "θα είστε,θα είσαστε", "θα είναι"),
-(103, "να είμαι", "να είσαι", "να είναι", "να είμαστε", "να είστε,να είσαστε", "να είναι"),
-(104, NULL, "να είσαι", NULL, NULL, "να είστε", NULL),
-(105, "είχα", "είχες", "είχα", "είχαμε", "είχατε", "είχαν"),
-(106, NULL, "βρες", NULL, NULL, "βρείτε,βρεστε", NULL)
+(36, NULL, "είσαι", NULL, NULL, "είστε", NULL)
;
INSERT INTO conjugation VALUES
@@ -111,7 +105,7 @@ INSERT INTO conjugation VALUES
-- Προστακτική
("A", "act", "imp", "Ενεστώτας", 'pres', NULL, 8, "-3--3-", NULL, NULL, NULL, NULL),
("A", "act", "imp", "Αόριστος", 'sub', NULL, 9, "-3--0-", NULL, NULL, NULL, NULL),
-("A", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
+("A", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL),
-- Μεσοπαθητική φωνή
-- Οριστική
("A", "pas", "ind", "Ενεστώτας", 'pres', NULL, 11, "000300", NULL, NULL, NULL, NULL),
@@ -135,9 +129,11 @@ INSERT INTO conjugation VALUES
-- Ενεργητηκή φωνή
-- Οριστική
("B1", "act", "ind", "Ενεστώτας", 'pres', NULL, 20, "ffffff", NULL, NULL, NULL, NULL),
+("B1", "act", "ind", "Ενεστώτας", 'pres', NULL, 21, "ffffff", NULL, NULL, NULL, NULL),
("B1", "act", "ind", "Παρατατικός", 'pres', "ούσ", 2, "ssssss", NULL, NULL, NULL, NULL),
("B1", "act", "ind", "Παρατατικός", 'pres', "αγ", 2, "333333", NULL, NULL, NULL, NULL),
("B1", "act", "ind", "Μέλλοντας διαρκείας", 'pres', NULL, 20, "ffffff", "θα", NULL, NULL, NULL),
+("B1", "act", "ind", "Μέλλοντας διαρκείας", 'pres', NULL, 21, "ffffff", "θα", NULL, NULL, NULL),
("B1", "act", "ind", "Αόριστος", 'aor', "ησ", 2, "333333", NULL, NULL, NULL, NULL),
("B1", "act", "ind", "Παρακείμενος", 'synt', NULL, 0, NULL, NULL, "έχω", "Ενεστώτας", NULL),
("B1", "act", "ind", "Υπερσυντέλικος", 'synt', NULL, 0, NULL, NULL, "έχω", "Παρατατικός", NULL),
@@ -145,12 +141,13 @@ INSERT INTO conjugation VALUES
("B1", "act", "ind", "Μέλλοντας στιγμιαίος", 'aor', "ήσ", 1, "ssssss", "θα", NULL, NULL, NULL),
-- Υποτακτική
("B1", "act", "sub", "Ενεστώτας", 'pres', NULL, 20, "ffffff", "να", NULL, NULL, NULL),
+("B1", "act", "sub", "Ενεστώτας", 'pres', NULL, 21, "ffffff", "να", NULL, NULL, NULL),
("B1", "act", "sub", "Αόριστος", 'aor', "ήσ", 1, "ssssss", "να", NULL, NULL, NULL),
("B1", "act", "sub", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
-- Προστακτική
("B1", "act", "imp", "Ενεστώτας", 'pres', NULL, 25, "-0--2-", NULL, NULL, NULL, NULL),
-("B1", "act", "imp", "Αόριστος", 'aor', "ησ", 9, "-3--3-", NULL, NULL, NULL, NULL),
-("B1", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
+("B1", "act", "imp", "Αόριστος", 'aor', "ησ", 9, "-3--2-", NULL, NULL, NULL, NULL),
+("B1", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL),
-- Μεσοπαθητική φωνή
-- Οριστική
("B1", "pas", "ind", "Ενεστώτας", 'pres', NULL, 28, "ffffff", NULL, NULL, NULL, NULL),
@@ -168,10 +165,10 @@ INSERT INTO conjugation VALUES
-- Προστακτική
("B1", "pas", "imp", "Ενεστώτας", 'pres', NULL, 30, "-f--f-", "να", NULL, NULL, NULL),
-("B1", "pas", "imp", "Αόριστος", 'aor', NULL, 31, "-2----", NULL, NULL, NULL, NULL),
-("B1", "pas", "imp", "Αόριστος", 'aor', NULL, 32, "----2-", NULL, NULL, NULL, NULL),
+("B1", "pas", "imp", "Αόριστος", 'aor:act', "ησ", 31, "-s----", NULL, NULL, NULL, "imp-aor"),
+("B1", "pas", "imp", "Αόριστος", 'aor', NULL, 32, "----2-", NULL, NULL, NULL, "imp-aor"),
-("B1", "pas", "imp", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
+("B1", "pas", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL),
-- Συζυγία Β΄ - β΄ τάξη
-- Ενεργητηκή φωνή
-- Οριστική
@@ -188,11 +185,11 @@ INSERT INTO conjugation VALUES
("B2", "act", "sub", "Αόριστος", 'aor', "ήσ", 1, "ssssss", "να", NULL, NULL, NULL),
("B2", "act", "sub", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
-- Προστακτική
-("B2", "act", "imp", "Ενεστώτας", 'pres', NULL, 15, "-f----", "να", NULL, NULL, NULL),
-("B2", "act", "imp", "Ενεστώτας", 'pres', NULL, 15, "----f-", NULL, NULL, NULL, NULL),
+("B2", "act", "imp", "Ενεστώτας", 'pres', NULL, 15, "-f----", "να", NULL, NULL, "imp-enes"),
+("B2", "act", "imp", "Ενεστώτας", 'pres', NULL, 15, "----f-", NULL, NULL, NULL, "imp-enes"),
("B2", "act", "imp", "Αόριστος", 'aor', "ησ", 9, "-3--3-", NULL, NULL, NULL, NULL),
-("B2", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
+("B2", "act", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL),
-- Μεσοπαθητική φωνή
-- Οριστική
("B2", "pas", "ind", "Ενεστώτας", 'pres', NULL, 34, "ffffff", NULL, NULL, NULL, NULL),
@@ -210,10 +207,10 @@ INSERT INTO conjugation VALUES
-- Προστακτική
("B2", "pas", "imp", "Ενεστώτας", 'pres', NULL, 36, "-f--f-", "να", NULL, NULL, NULL),
-("B2", "pas", "imp", "Αόριστος", 'aor', NULL, 31, "-2----", NULL, NULL, NULL, NULL),
-("B2", "pas", "imp", "Αόριστος", 'aor', NULL, 32, "----2-", NULL, NULL, NULL, NULL),
+("B2", "pas", "imp", "Αόριστος", 'aor:act', NULL, 31, "-2----", NULL, NULL, NULL, "imp-aor"),
+("B2", "pas", "imp", "Αόριστος", 'aor', NULL, 32, "----2-", NULL, NULL, NULL, "imp-aor"),
-("B2", "pas", "imp", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
+("B2", "pas", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL),
-- Αποθετικά ρήματα
("A-depon", "act", "sub", "Αόριστος", 'sub', NULL, 1, "000000", "να", NULL, NULL, NULL),
-- Μεσοπαθητική φωνή
@@ -232,8 +229,8 @@ INSERT INTO conjugation VALUES
("A-depon", "pas", "sub", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Ενεστώτας", NULL),
-- Προστακτική -- FIXME
("A-depon", "pas", "imp", "Ενεστώτας", 'pres', NULL, 11, "-3--3-", "να", NULL, NULL, NULL),
-("A-depon", "pas", "imp", "Αόριστος", 'aor', NULL, 17, "-0----", NULL, NULL, NULL, NULL),
-("A-depon", "pas", "imp", "Αόριστος", 'aor', NULL, 18, "----2-", NULL, NULL, NULL, NULL),
+("A-depon", "pas", "imp", "Αόριστος", 'aor', NULL, 17, "-0----", NULL, NULL, NULL, "imp-aor"),
+("A-depon", "pas", "imp", "Αόριστος", 'aor', NULL, 18, "----2-", NULL, NULL, NULL, "imp-aor"),
("A-depon", "pas", "imp", "Παρακείμενος", 'synt', NULL, 0, "-0--0-", "να", "έχω", "Ενεστώτας", NULL)
;
@@ -257,17 +254,25 @@ INSERT INTO participle VALUES
-- Μεσοπαθητική φωνή
("B1", "pass", "Παρακείμενος", 'pres', "η", "μένος", NULL);
-DROP TABLE IF EXISTS verb;
-CREATE TABLE verb(
+DROP TABLE IF EXISTS verbclass;
+CREATE TABLE verbclass(
verb varchar(128), -- REL 10
conj char(32), -- REL 9
- augment char(1),
- accmap char(7),
- suffix varchar(2),
INDEX(verb),
INDEX(conj)
);
+DROP TABLE IF EXISTS verbtense;
+CREATE TABLE verbtense(
+ verb varchar(128), -- REL 10
+ voice enum('act','pas'),
+ mood enum('ind','sub','imp'),
+ tense varchar(128),
+ property char(32),
+ value varchar(128),
+ INDEX(verb,voice,mood,tense)
+);
+
DROP TABLE IF EXISTS individual_verb;
CREATE TABLE individual_verb(
verb varchar(128),
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml
index 8951bda..e53e9fd 100644
--- a/data/irregular-verbs.xml
+++ b/data/irregular-verbs.xml
@@ -138,6 +138,9 @@
<aor>ήγαγ</aor>
<root theme="sub">αγάγ</root>
</act>
+ <pas>
+ <root theme="aor">αχθ</root>
+ </pas>
</v>
<v>
@@ -184,7 +187,7 @@
<v>
<a>βαστώ</a>
- <c>B2</c>
+ <c>B1</c>
<suffix>ηξ</suffix> <!-- also αξ -->
</v>
@@ -295,33 +298,7 @@
<root theme="aor">δωσ</root>
</act>
</v>
-<!--
- <v>
- <a>έρχομαι</a>
- <c>A</c>
- <suffix></suffix>
- <accmap>000000</accmap>
- <act>
- <root theme="sub">ερθ</root>
- <ind/>
- <sub>
- <t name="Ενεστώτας"/>
- <t name="Παρατατικός"/>
- <t name="Μέλλοντας διαρκείας"/>
- <t name="Παρακείμενος"/>
- <t name="Υπερσυντέλικος"/>
- <t name="Συντελεσμένος μέλλοντας"/>
- <t name="Μέλλοντας στιγμιαίος"/>
- </sub>
- <imp/>
- </act>
- <pas>
- <root theme="aor">ήρθ</root>
- <root theme="sub">ερθ</root>
- </pas>
- </v>
--->
-
+
<v>
<a>έρχομαι</a>
<c>A-depon</c>
@@ -342,12 +319,32 @@
</imp>
</pas>
</v>
-
-<!-- FIXME
- έρχομαι
- κάθομαι
--->
+ <v>
+ <a>κάθομαι</a>
+ <c>A-depon</c>
+ <act>
+ <root theme="aor">κάτσ</root>
+ </act>
+ <pas>
+ <root theme="aor">κάτσ</root>
+ <ind>
+ <t name="Αόριστος">
+ <augment>ε</augment>
+ <accmap>333333+</accmap>
+ </t>
+ </ind>
+ <imp>
+ <t name="Ενεστώτας">
+ <p n="p" p="2">κάθεστε</p>
+ </t>
+ <t name="Αόριστος">
+ <p n="s" p="2">κάθισε</p>
+ <p n="p" p="2">κάθιστε</p>
+ </t>
+ </imp>
+ </pas>
+ </v>
<v>
<a>καίω</a>
diff --git a/scm/verbop.scm b/scm/verbop.scm
index 621ea6c..ff30892 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -1,3 +1,22 @@
+#! =GUILE_BINDIR=/guile -s
+=AUTOGENERATED=
+!#
+;;;; This file is part of Ellinika
+;;;; Copyright (C) 2011 Sergey Poznyakoff
+;;;;
+;;;; Ellinika is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; Ellinika is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;;
(use-modules (srfi srfi-1)
(xmltools xmltrans)
(ellinika elmorph)
@@ -17,6 +36,8 @@
(set! flect-ident (1+ flect-ident))
flect-ident)
+(define class-list '()) ; List of defined verb classes.
+
(define connection #f) ; SQL connection
(define sysconf-dir "=SYSCONFDIR=")
@@ -83,17 +104,23 @@
;;; Tense is a list of 6 elements or #f
(define tense #f)
+(define tense-prop '())
(define (tense-init)
- (set! tense (make-list 6 #f)))
+ (set! tense (make-list 6 #f))
+ (set! tense-prop '()))
(define (tense-set n val)
(if (not tense) (tense-init))
(list-set! tense n val))
(define (get-tense)
- (let ((ret tense))
- (set! tense #f)
+ (let ((ret (append tense
+ (if (and (empty-conjugation? tense)
+ (not (null? tense-prop)))
+ (cons (cons "default" #t) tense-prop)
+ tense-prop))))
+ (tense-init)
ret))
;;; Mood is an associative list. Possible keys are:
@@ -110,15 +137,19 @@
;;; Conjugation is an associative list of moods
-(define conjugation '())
+(define conjugation #f)
(define (get-conjugation)
(let ((ret conjugation))
- (set! conjugation '())
+ (set! conjugation #f)
ret))
(define (conjugation-set key val)
- (set! conjugation (append conjugation (list (cons key val)))))
+ (set! conjugation
+ (if conjugation
+ (append conjugation (list (cons key val)))
+ (list (cons key val)))))
+
;;; Verb structure:
(define verbdef '())
@@ -138,9 +169,15 @@
(error "Unknown index " c))))
(define (verb-get what)
- (if (null? verbdef)
- #f
- (list-ref verbdef (verbdef:index what))))
+ (cond
+ ((null? verbdef)
+ #f)
+ ((eq? what #:override)
+ (if (verb-get #:suffix)
+ "suffix"
+ #f))
+ (else
+ (list-ref verbdef (verbdef:index what)))))
(define (verb-get-sql what)
(sql-val (verb-get what)))
@@ -152,6 +189,8 @@
(define (verb-init)
(set! verbdef (make-list 9 #f))
+ (verb-set #:act '())
+ (verb-set #:pas '())
(verb-set #:validity #t)
(verb-set #:action 'insert))
@@ -179,14 +218,6 @@
(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)
@@ -194,7 +225,7 @@
(lambda (x)
(if x
(return #f)))
- conj)
+ (list-head conj 6))
(return #t))))
(define (insert-individual-verb voice mood tense ident)
@@ -210,44 +241,66 @@ VALUES (~A,~A,~A,~A,~A);~%"
(if (eq? (car mood) #:root)
(let ((val (cdr mood)))
(run-query "INSERT INTO irregular_root (verb,voice,thema,root) \
-VALUES (~A,~A,~A,~A);~%"
+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))))
+ (let ((mood-str (car mood)))
(let ((lst (cdr mood)))
- (if (null? lst)
- (for-each
- (lambda (tense)
- (insert-individual-verb vstr mood-str tense 0))
- (assoc-ref ellinika-tense-list mood-str))
-
- (for-each
- (lambda (p)
- (let ((key (car p)))
- (debug 1 "flush-mood: " p)
- (cond
- ((empty-conjugation? (cdr p))
- (insert-individual-verb vstr mood-str 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)))
- (insert-individual-verb vstr mood-str key num) )))))
- lst))))))
+ (cond
+ ((null? lst)
+ (for-each
+ (lambda (tense)
+ (insert-individual-verb vstr mood-str tense 0))
+ (assoc-ref ellinika-tense-list mood-str)))
+
+ (else
+; (format #t "LST ~A~%" lst)
+ (for-each
+ (lambda (p)
+ (let ((tense (car p)))
+ (debug 1 "flush-mood: " p)
+ (cond
+ ((assoc-ref (list-tail p 7) "default") #t)
+ ((empty-conjugation? (cdr p))
+ (insert-individual-verb vstr mood-str tense 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)))
+ (insert-individual-verb vstr mood-str tense num) )))
+
+ (for-each
+ (lambda (prop)
+; (format #t "PROP ~A~%" prop)
+ (let ((key (car prop)))
+ (cond
+ ((string=? key "default"))
+ (else
+ (run-query
+ "INSERT INTO verbtense VALUES (~A,~A,~A,~A,~A,~A)"
+ (verb-get-sql #:verb)
+ (sql-val vstr)
+ (sql-val mood-str)
+ (sql-val tense)
+ (sql-val (car prop))
+ (sql-val (cdr prop)))))))
+ (list-tail p 7))))
+ lst)))))))
(define (flush-voice vstr conj-list)
+; (format #t "VOICE ~A~%" conj-list)
(cond
- ((null? conj-list)
+ ((not conj-list)
(for-each
(lambda (vp)
(let ((mood (car vp)))
@@ -262,20 +315,91 @@ VALUES (~A,~A,~A,~A);~%"
(flush-mood mood vstr))
conj-list))))
+;;;
+(define (preprocess-voice voice attrlist)
+; (format #t "VOICE ~A~%" voice)
+ (if voice
+ (for-each
+ (lambda (arg)
+ (let* ((key (car arg))
+ (mtlist (cdr arg))
+ (value (verb-get key)))
+; (format #t "KEY ~A / VALUE ~A; MTLIST ~A~%" key value mtlist)
+ (if value
+ (let ((attr (symbol->string (keyword->symbol key))))
+ (for-each
+ (lambda (mood-tenses)
+ (let* ((mood-name (car mood-tenses))
+ (mood-ref (or (assoc mood-name voice)
+ (begin
+ (set! voice
+ (cons (cons mood-name '())
+ voice))
+ (car voice)))))
+; (format #t "MOOD ~A~%" mood-ref)
+ (for-each
+ (lambda (tense-name)
+ (let* ((tense (or (assoc tense-name (cdr mood-ref))
+ (begin
+ (append!
+ mood-ref
+ (list
+ (cons tense-name
+ (append
+ (make-list 6 #f)
+ (list
+ (cons "default" #t))))))
+; (format #t "NM ~A~%" mood-ref)
+ (assoc tense-name
+ (cdr mood-ref)))))
+ (prop (begin
+; (format #t "TENSE ~A~%" tense)
+ (list-tail tense 7))))
+; (format #t "PROP ~A ~A~%" tense prop)
+ (if (not (assoc attr prop))
+ (append! tense
+ (list
+ (cons attr value))))))
+ (cdr mood-tenses))))
+ mtlist)))))
+ attrlist))
+; (format #t "BVOICE ~A~%" voice)
+ voice)
+
;;; Fush verb definition to the database
(define (verb-flush)
;;
(case (verb-get #:action)
((insert)
- (run-query "INSERT INTO verb (verb,conj,augment,accmap,suffix) \
-VALUES (~A,~A,~A,~A,~A);~%"
+ (run-query "INSERT INTO verbclass (verb,conj) VALUES (~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)))
+ (verb-get-sql #:class))
+ (flush-voice "act"
+ (preprocess-voice
+ (verb-get #:act)
+ (list
+ (cons #:suffix
+ '(("ind" . ("Αόριστος"
+ "Παρακείμενος"
+ "Υπερσυντέλικος"
+ "Συντελεσμένος μέλλοντας"
+ "Μέλλοντας στιγμιαίος"))
+ ("sub" . ("Αόριστος"))
+ ("imp" . ("Αόριστος"))))
+ (cons #:accmap ellinika-tense-list)
+ (cons #:augment
+ '(("ind" . ("Αόριστος"
+ "Παρακείμενος")))))))
+
+ (flush-voice "pas"
+ (preprocess-voice
+ (verb-get #:pas)
+ (list
+ (cons #:suffix
+ '(("imp" . ("Αόριστος"))))
+ (cons #:override
+ '(("imp" . ("Αόριστος"))))
+ (cons #:accmap ellinika-tense-list)))))
((delete update)
(xmltrans:parse-error #f
"Sorry update and delete are not yet supported"))))
@@ -339,10 +463,7 @@ VALUES (~A,~A,~A,~A,~A);~%"
((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")))
+ ((not (member text class-list))
(xmltrans:parse-warning #f "Unknown or misspelled verb class")))
(verb-set #:class text)
#f)
@@ -368,27 +489,40 @@ VALUES (~A,~A,~A,~A,~A);~%"
(xmltrans:end-tag
"augment"
(tag attr text)
- (check-parent tag "v")
+
+ (if (not (or (string= text "η")
+ (string= text "ε")))
+ (xmltrans:parse-warning #f "Suspicious augment"))
+
(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)
+ ((xmltrans:parent? "v")
+ (cond
+ ((verb-get #:augment)
+ (xmltrans:parse-error #f "Augment was already defined")
+ (mark-invalid))
+ (verb-set #:augment text)))
+ ((xmltrans:parent? "t")
+ (set! tense-prop (cons (cons "augment" text) tense-prop)))
+ (else
+ (xmltrans:parse-error #f elt " not a child of v or t")))
#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)
+ ((xmltrans:parent? "v")
+ (cond
+ ((verb-get #:suffix)
+ (xmltrans:parse-error #f "Suffix was already defined")
+ (mark-invalid))
+ (else
+ (verb-set #:suffix text))))
+ ((xmltrans:parent? "t")
+ (set! tense-prop (cons (cons "suffix" text) tense-prop)))
+ (else
+ (xmltrans:parse-error #f elt " not a child of v or t")))
#f)
;;;
@@ -411,16 +545,24 @@ VALUES (~A,~A,~A,~A,~A);~%"
(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))
+ ((xmltrans:parent? "v")
+ (cond
+ ((> (string-length text) 6)
+ (xmltrans:parse-error #f "Use of augment not allowed in global accent map")
+ (mark-invalid))
+ ((verb-get #:accmap)
+ (xmltrans:parse-error #f "Accmap was already defined")
+ (mark-invalid))
+ (else
+ (verb-set #:accmap text))))
+ ((xmltrans:parent? "t")
+ (set! tense-prop (cons (cons "accmap" text) tense-prop)))
(else
- (verb-set #:accmap text)))
+ (xmltrans:parse-error #f elt " not a child of v or t")))
#f)
;;; <act>...</act> - Define conjugation in active voice
@@ -429,10 +571,12 @@ VALUES (~A,~A,~A,~A,~A);~%"
(tag attr text)
(check-parent tag "v")
(cond
- ((verb-get #:act)
+ ((null? (verb-get #:act))
+ (verb-set #:act (get-conjugation)))
+ (else
(xmltrans:parse-error #f "Active voice was already defined")
(mark-invalid)))
- (verb-set #:act (get-conjugation))
+
#f)
;;; <pas>...</pas> - Define conjugation in passive voice
@@ -441,10 +585,11 @@ VALUES (~A,~A,~A,~A,~A);~%"
(tag attr text)
(check-parent tag "v")
(cond
- ((verb-get #:pas)
+ ((null? (verb-get #:pas))
+ (verb-set #:pas (get-conjugation)))
+ (else
(xmltrans:parse-error #f "Passive voice was already defined")
(mark-invalid)))
- (verb-set #:pas (get-conjugation))
#f)
;;; <ind>...</ind> - Indicative
@@ -452,7 +597,7 @@ VALUES (~A,~A,~A,~A,~A);~%"
"ind"
(tag attr text)
(check-parent tag "act" "pas")
- (conjugation-set #:ind (get-mood))
+ (conjugation-set "ind" (get-mood))
#f)
;;; <sub>...</sub> - Subjunctive
@@ -460,7 +605,7 @@ VALUES (~A,~A,~A,~A,~A);~%"
"sub"
(tag attr text)
(check-parent tag "act" "pas")
- (conjugation-set #:sub (get-mood))
+ (conjugation-set "sub" (get-mood))
#f)
;;; <imp>...</imp> - Imperative
@@ -468,7 +613,7 @@ VALUES (~A,~A,~A,~A,~A);~%"
"imp"
(tag attr text)
(check-parent tag "act" "pas")
- (conjugation-set #:imp (get-mood))
+ (conjugation-set "imp" (get-mood))
#f)
;;; <aor>root</aor> - Define aorist root
@@ -518,7 +663,7 @@ VALUES (~A,~A,~A,~A,~A);~%"
(mood-set name (get-tense)))
#f)
-;;; <p n="[sp]" n="[123]">...</p> - Define a person
+;;; <p n="[sp]" n="[123]">...</p> - Define a (grammatical) person
(xmltrans:end-tag
"p"
(tag attr text)
@@ -674,10 +819,21 @@ Informational options:
(cond
(cleanup-option
(run-query "DELETE FROM verbflect where ident > 99")
- (run-query "DELETE FROM verb")
+ (run-query "DELETE FROM verbclass")
+ (run-query "DELETE FROM verbtense")
(run-query "DELETE FROM irregular_root")
(run-query "DELETE FROM individual_verb")))
-
+
+(set! class-list
+ (cons "I"
+ (if dry-run-option
+ (list "A" "B1" "B2")
+ (map
+ car
+ (run-query
+ "SELECT DISTINCT conj FROM conjugation ORDER BY 1")))))
+
+
(for-each
(lambda (x)
(if (not (xmltrans:parse-file x))
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index c8fd012..25ae255 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -30,68 +30,102 @@
(let ((res (sql-query conn query)))
; (format #t "R: ~A~%" res)
res))
+
+;; Verb info
+;; #:verb - Verb in dictionary form
+;; #:conj - Conjugation class
+;;
+;; Verb structure:
+;; (class verb flag assoc)
+;; class - Verb class
+;; verb - the verb itself
+;; properties - associative list of properties
+;; attested
-(define verb-info-template
- (list
- (list "A"
- #f
- "ε"
- #f
- #f
- #f)
- (list "B1"
- #f
- #f
- #f
- #f
- #f)
- (list "B2"
- #f
- #f
- #f
- #f
- #f)))
-
-(define (guess-verb-info verb)
+(define (verb-set! verb key value)
+; (format #t "VERB ~A KEY ~A VALUE ~A~%" verb key value)
+ (case key
+ ((#:conj)
+ (list-set! verb 0 value))
+ ((#:verb)
+ (list-set! verb 1 value))
+ ((#:attested)
+ (list-set! verb 3 (append (list-ref verb 3) (list value))))
+ (else
+ (let ((container (assoc key (list-ref verb 2))))
+ (if container
+ (set-cdr! container value)
+ (list-set! verb 2 (append (list-ref verb 2)
+ (list
+ (cons key value)))))))))
+
+
+(define (verb-get verb key)
+ (case key
+ ((#:conj)
+ (list-ref verb 0))
+ ((#:verb)
+ (list-ref verb 1))
+ ((#:attested)
+ (list-ref verb 3))
+ (else
+ (assoc-ref (list-ref verb 2) key))))
+
+
+(define (guess-verb-class verb)
(cond
;; FIXME
- ((elstr-suffix? verb "άω")
- (assoc "B1" verb-info-template))
- ((elstr-suffix? verb "ώ")
- (assoc "B2" verb-info-template))
+ ((elstr-suffix? verb "άω") "B1")
+ ((elstr-suffix? verb "ώ") "B2")
;; FIXME: deponentia?
- (else
- (assoc "A" verb-info-template))))
+ (else "A")))
-(define (get-verb-info conn verb . rest)
+(define (create-basic-verb-info conn verb proplist . rest)
+; (format #t "PROPLIST ~A~%" proplist)
(let ((class (if (null? rest)
""
(string-append " AND conj='" (car rest) "'"))))
(let ((vdb (my-sql-query
conn
(string-append
- "SELECT conj,accmap,augment,suffix FROM verb \
-WHERE verb='" (force-string verb) "'"
- class))))
+ "SELECT conj FROM verbclass WHERE verb='" (force-string verb) "'"
+ class))))
(cond
- ((and vdb (not (null? vdb)))
- (let ((x (car vdb)))
- (list
- (list-ref x 0)
- (list-ref x 1)
- (or (list-ref x 2) "ε")
- (list-ref x 3)
- #f
- '(class))))
+ ((and vdb (not (null? vdb)));FIXME
+ (list (caar vdb) verb proplist '(class)))
((elstr-suffix? verb "άω")
- (get-verb-info conn (elstr-append
- (elstr-trim verb -2) "ώ") "B1"))
+ (create-basic-verb-info conn (elstr-append
+ (elstr-trim verb -2) "ώ") "B1"))
((null? rest)
- (guess-verb-info verb))
+ (list (guess-verb-class verb) verb proplist '()))
(else
- (assoc (car rest) verb-info-template))))))
+ (list (car rest) verb '() '()))))))
+
+(define (load-verb-info conn verb voice mood tense)
+; (format #t "LOAD ~A~%" verb)
+ (let ((verbprop (my-sql-query
+ conn
+ (string-append
+ "SELECT property,value FROM verbtense WHERE "
+ "verb=\"" verb "\" AND voice=\"" voice
+ "\" AND mood=\"" mood "\" AND tense=\"" tense "\""))))
+ (create-basic-verb-info conn verb
+ (if (null? verbprop)
+ '()
+ (map
+ (lambda (elt)
+ (let ((name (car elt))
+ (value (cadr elt)))
+ (if (string=? name "override")
+ (cons #:override
+ (string-split value #\,))
+ (cons (symbol->keyword
+ (string->symbol name))
+ value))))
+ verbprop)))))
+
-(define (thema-aoristoy-mesapathitikis root)
+(define (thema-aoristoy-mesapathitikis-A root)
(cond
((elstr-suffix? root "αίν")
(elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ
@@ -121,6 +155,24 @@ WHERE verb='" (force-string verb) "'"
(else
#f)))
+(define (thema-aoristoy-mesapathitikis-B root conj-aor)
+ (let ((root-aor (elstr-trim (list-ref conj-aor 0) -1)))
+ (cond
+ ((elstr-suffix? root-aor "σ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "θ"))
+ ((elstr-suffix? root-aor "ξ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "χτ"))
+ ((elstr-suffix? root-aor "ψ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "φτ"))
+ (else
+ (elstr-append root "ηθ")))))
+
(define (lookup-verb-info conn verb voice thema)
(my-sql-query
conn
@@ -144,50 +196,54 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(if (and (null? tmpres) (string=? thema "sub"))
(lookup-verb-info conn verb voice "aor")
tmpres))))
- (verb-info-set! #:root vinfo
+ (verb-set! vinfo #:root
(cond
((not (null? result))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
(caar result))
- ((string=? (verb-info #:conj vinfo) "A")
+ ((string=? (verb-get vinfo #:conj) "A")
(let ((root (verb-A-root elverb)))
(cond
((string=? thema "pres")
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
(if (string=? voice "act")
(elstr-thema-aoristoy root)
- (thema-aoristoy-mesapathitikis root)))
+ (thema-aoristoy-mesapathitikis-A root)))
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "A-depon")
+ ((string=? (verb-get vinfo #:conj) "A-depon")
(let ((root (verb-A-root elverb)))
(cond
((string=? thema "pres")
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
#f) ; FIXME
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "B1")
+ ((string=? (verb-get vinfo #:conj) "B1")
(let ((root (if (elstr-suffix? elverb "άω")
(elstr-trim elverb -2)
(elstr-trim elverb -1))))
(cond
((or (string=? voice "act") (string=? thema "pres"))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
- (elstr-append root "ηθ")) ;; FIXME: guesswork
+ (thema-aoristoy-mesapathitikis-B
+ root
+ (list-ref
+ (conjugate conn verb "act" "ind" "Αόριστος")
+ 0)))
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "B2")
+ ((string=? (verb-get vinfo #:conj) "B2")
(let ((root (elstr-trim elverb -1)))
(cond
((or (string=? voice "act") (string=? thema "pres"))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
(elstr-append root "ηθ")) ;; FIXME: guesswork
@@ -196,40 +252,6 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(else
#f)))))
-(define-syntax verb-info
- (syntax-rules ()
- ((verb-info #:conj v)
- (list-ref v 0))
- ((verb-info #:accmap v)
- (list-ref v 1))
- ((verb-info #:augment v)
- (list-ref v 2))
- ((verb-info #:suffix v)
- (list-ref v 3))
- ((verb-info #:root v)
- (list-ref v 4))
- ((verb-info #:attested v)
- (list-ref v 5))))
-
-(define-syntax verb-info-set!
- (syntax-rules ()
- ((verb-info-set! #:root v val)
- (list-set! v 4 val))
- ((verb-info-set! #:attested v val)
- (list-set! v 5
- (if (not val)
- val
- (let ((oldval (list-ref v 5)))
- (cond
- ((not oldval)
- (list val))
- ((boolean? oldval)
- (list val))
- ((member val oldval)
- oldval)
- (else
- (cons val oldval)))))))))
-
(define-syntax conj-info
(syntax-rules ()
((conj-info #:thema v)
@@ -264,7 +286,11 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(define-syntax conj-info-set!
(syntax-rules ()
((conj-info-set! #:particle v val)
- (list-set! v 3 val))))
+ (list-set! v 3 val))
+ ((conj-info-set! #:suffix v)
+ (list-set! v 1 val))
+ ((conj-info-set! #:accmap v)
+ (list-set! v 2 val)) ))
(define (get-conj-info conn conj voice mood tense)
(let ((answer (my-sql-query
@@ -296,22 +322,61 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
syl
(+ (- len syl) 1))))
+;; (define (get-property conj vinfo key default)
+;; (if ((override (verb-get vinfo
+;; (symbol->keyword
+;; (string->symbol
+;; (string-append
+;; (symbol->string (keyword->symbol key))
+;; "-override"))))))
+;; (if override
+;; (let ((t (conj-info key conj)))
+;; (if t
+;; (or (verb-get vinfo key)
+;; t)
+;; (or (verb-get vinfo key)
+;; (conj-info key conj)
+;; default))))))
+
+
+(define (get-suffix conj vinfo)
+ (let ((override (verb-get vinfo #:override)))
+ (if (and override
+ (member "suffix" override))
+ (let ((t (conj-info #:suffix conj)))
+ (if t
+ (or (verb-get vinfo #:suffix)
+ t)
+ ""))
+ (or (verb-get vinfo #:suffix)
+ (conj-info #:suffix conj)
+ ""))))
+
+
+(define (get-accmap conj vinfo)
+ (let ((override (verb-get vinfo #:override)))
+ (if (and override
+ (member "accmap" override))
+ (let ((t (conj-info #:accmap conj)))
+ (if t
+ (or (verb-get vinfo #:accmap)
+ t)))
+ (or (verb-get vinfo #:accmap)
+ (conj-info #:accmap conj)
+ "000000"))))
+
(define (apply-flect conj vinfo verb)
; (format #t "VINFO ~A~%" vinfo)
- (let ((root (verb-info #:root vinfo))
- (suffix (let ((s (conj-info #:suffix conj)))
- (if s
- (or (verb-info #:suffix vinfo) s)
- "")))
- (accmap (string->list (or (verb-info #:accmap vinfo)
- (conj-info #:accmap conj)
- "000000")))
+ (let ((root (verb-get vinfo #:root))
+ (suffix (get-suffix conj vinfo))
+ (accmap (string->list (get-accmap conj vinfo)))
(augment ""))
-; (format #t "ROOT ~S, ACCMAP ~S, SUFFIX: ~S~%" root accmap suffix)
+; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix)
(cond
((> (length accmap) 6)
(set! accmap (list-head accmap 6))
- (set! augment (verb-info #:augment vinfo))))
+ (set! augment (or (verb-get vinfo #:augment) "ε"))))
+; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment))
(let ((forms
(map
(lambda (flect acc)
@@ -339,10 +404,12 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(elstr-deaccent (elstr-append root suffix))
flect))
((char=? acc #\s)
- (elstr-append
- (elstr-deaccent root)
- suffix
- (elstr-deaccent flect)))
+ (let ((nsyl (elstr-number-of-syllables flect)))
+ (elstr-set-accent
+ (elstr-append root suffix flect)
+ (if (< nsyl 2)
+ (+ nsyl 1)
+ 3))))
((char=? acc #\-)
#f)
((char-numeric? acc)
@@ -367,7 +434,8 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(lambda (w)
(if w
(string-append
- (conj-info #:particle conj) " " (force-string w))))
+ (conj-info #:particle conj) " " (force-string w))
+ #f))
forms)
(map force-string forms)))))
@@ -390,86 +458,85 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(lambda (a b)
(or a b))
lista listb))
-
+
(define (conjugate conn verb voice mood tense . rest)
(cond
((individual-verb conn verb voice mood tense) =>
(lambda (res)
(list res)))
(else
- (map car
- (let* ((vinfo (get-verb-info conn verb))
- (conj-list (get-conj-info conn
- (verb-info #:conj vinfo)
- voice mood tense)))
- (if (not conj-list)
- (error "cannot obtain conjugation information for "
- (verb-info #:conj vinfo) voice mood tense))
- (fold-right
- (lambda (elt prev)
-; (format #t "ELT ~A~%" elt)
- (if (null? prev)
- (list elt)
- (let ((top (car prev)))
- (if (let ((a (cdr elt))
- (b (cdr top)))
- (and (string? a) (string? b) (string=? a b)))
- (cons (cons
- (merge-conjugated-forms (car top) (car elt))
- (cdr top))
- (cdr prev))
- (cons elt prev)))))
- '()
- (map
- (lambda (conj)
-; (format #t "CONJ ~S~%" conj)
- (if (member #:nopart rest)
- (conj-info-set! #:particle conj #f))
- (cons
- (cond
- ((string=? (conj-info #:thema conj) "synt")
- (let* ((verb-conj
- (car (conjugate conn verb voice "sub" "Αόριστος"
- #:nopart)))
- (form (list-ref verb-conj 2))
- (part (conj-info #:particle conj)))
+ (let* ((vinfo (load-verb-info conn verb voice mood tense))
+ (conj-list (get-conj-info conn
+ (verb-get vinfo #:conj)
+ voice mood tense)))
+ (if (not conj-list)
+ (list (list #f #f #f #f #f #f) #f #f)
+ (map car
+ (fold-right
+ (lambda (elt prev)
+; (format #t "ELT ~A~%" elt)
+ (if (null? prev)
+ (list elt)
+ (let ((top (car prev)))
+ (if (let ((a (cdr elt))
+ (b (cdr top)))
+ (and (string? a) (string? b) (string=? a b)))
+ (cons (cons
+ (merge-conjugated-forms (car top) (car elt))
+ (cdr top))
+ (cdr prev))
+ (cons elt prev)))))
+ '()
+ (map
+ (lambda (conj)
+; (format #t "CONJ ~S~%" conj)
+ (if (member #:nopart rest)
+ (conj-info-set! #:particle conj #f))
+ (cons
(cond
- (form
-; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME
- (append
- (map
- (lambda (aux flag)
- (if (char=? flag #\-)
- #f
- (elstr->string
- (if part
- (elstr-append part " " aux " " form)
- (elstr-append aux " " form)))))
- (conjugation:table
- (car (conjugate conn
- (conj-info #:aux conj) "act" "ind"
- (conj-info #:auxtense conj))))
- (string->list (or (verb-info #:accmap vinfo)
- (conj-info #:accmap conj)
- "000000")))
- (list (verb-info #:conj vinfo)
- (conjugation:attested verb-conj))))
+ ((string=? (conj-info #:thema conj) "synt")
+ (let* ((verb-conj
+ (car (conjugate conn verb voice "sub" "Αόριστος"
+ #:nopart)))
+ (form (list-ref verb-conj 2))
+ (part (conj-info #:particle conj)))
+ (cond
+ (form
+; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME
+ (append
+ (map
+ (lambda (aux flag)
+ (if (char=? flag #\-)
+ #f
+ (elstr->string
+ (if part
+ (elstr-append part " " aux " " form)
+ (elstr-append aux " " form)))))
+ (conjugation:table
+ (car (conjugate conn
+ (conj-info #:aux conj) "act" "ind"
+ (conj-info #:auxtense conj))))
+ (string->list (or (verb-get vinfo #:accmap)
+ (conj-info #:accmap conj)
+ "000000")))
+ (list (verb-get vinfo #:conj)
+ (conjugation:attested verb-conj))))
+ (else
+ #f))))
(else
- #f))))
- (else
- (let ((thema (string-split (conj-info #:thema conj) #\:)))
-; (format #t "THEMA ~A~%" thema)
- (complement-verb-info conn vinfo verb
- (if (null? (cdr thema))
- voice
- (car (cdr thema)))
- (car thema))
-; (format #t "VINFO ~A~%" vinfo)
- (append (apply-flect conj vinfo verb)
- (list (verb-info #:conj vinfo)
- (verb-info #:attested vinfo))))))
- (conj-info #:fold conj)))
- conj-list)))))))
+ (let ((thema (string-split (conj-info #:thema conj) #\:)))
+; (format #t "THEMA ~A~%" thema)
+ (complement-verb-info conn vinfo verb
+ (if (null? (cdr thema))
+ voice
+ (car (cdr thema)))
+ (car thema))
+; (format #t "VINFO ~A~%" vinfo)
+ (append (apply-flect conj vinfo verb)
+ (list (verb-get vinfo #:conj)
+ (verb-get vinfo #:attested))))))
+ (conj-info #:fold conj)))
+ conj-list))))))))
(define-public (conjugator conn verb voice mood tense)
(conjugate conn verb voice mood tense))
diff --git a/src/ellinika/tests/conj/bastv.scm b/src/ellinika/tests/conj/bastv.scm
new file mode 100644
index 0000000..f8a173f
--- /dev/null
+++ b/src/ellinika/tests/conj/bastv.scm
@@ -0,0 +1,3 @@
+(use-modules ((ellinika test-conjugation)))
+
+(test-conjugation:verb "βαστώ")
diff --git a/src/ellinika/tests/conj/kauomai.scm b/src/ellinika/tests/conj/kauomai.scm
new file mode 100644
index 0000000..000b19c
--- /dev/null
+++ b/src/ellinika/tests/conj/kauomai.scm
@@ -0,0 +1,4 @@
+(use-modules ((ellinika test-conjugation)))
+
+(test-conjugation:verb "κάθομαι")
+;(test-conjugation:tense "κάθομαι" "pas" "ind" "Αόριστος")
diff --git a/src/ellinika/tests/conj/ntynv.scm b/src/ellinika/tests/conj/ntynv.scm
index 160832d..1fd1545 100644
--- a/src/ellinika/tests/conj/ntynv.scm
+++ b/src/ellinika/tests/conj/ntynv.scm
@@ -1,3 +1,3 @@
-(use-modules ((ellinika test-conjugation)))
+(use-modules (ellinika test-conjugation))
(test-conjugation:verb "ντύνω")

Return to:

Send suggestions and report system problems to the System administrator.