aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-10 23:04:53 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-11 00:34:20 +0300
commita1a5b7ddd6c3c0532c37551b24fd573a554ac181 (patch)
treef86f3572c77dc986bb2dfb65619ac4bc35c83847
parent2bae7da012e2125762855ce014e63345ecbbbb18 (diff)
downloadellinika-a1a5b7ddd6c3c0532c37551b24fd573a554ac181.tar.gz
ellinika-a1a5b7ddd6c3c0532c37551b24fd573a554ac181.tar.bz2
Fix syllabification.
* configure.ac: Add AC_PROG_YACC * src/ellinika/phoneme.y: New file. * src/ellinika/yyrename: New file. * src/ellinika/syllabificator.c: New file. * src/ellinika/.gitignore: Update. * src/ellinika/elchr.c (char_info_st): Move to header. (el_basic_ctype): (elchr_info): Remove static qualifier. Return a pointer to const. (elchr_letter,elchr_phoneme): New functions. (elchr_diphthong): Remove. * src/ellinika/elmorph.c (elstr)<phoneme,phoneme_count>: New members. (_elstr_syllabize): Rewrite. (invalidate_maps)" New static function. (_elstr_alloc): Initialize new fields, take function name as argument, for diagnostic purposes. (_elstr_print): Rewrite (deftab): Update. (elstr-syllable-prop,elstr-syllable) (_elstr_set_accent,_elstr_set_accent_on_char): Rewrite. (elstr-char-phoneme,elstr->phonetic-map): New functions. * src/ellinika/elmorph.h (CHF_DIPH1,CHF_DIPH2): Remove. (CHF_DIPHTHONG): New flag. (PHON_.*): New constants. (phoneme,syllable): New structures. (char_info_st)<letter,phoneme>: New members. (elchr_info,elchr_letter) (elchr_phoneme,phoneme_map) (syllable_map): New protos. (elchr_diphthong): Remove protos. * src/ellinika/elmorph.scm4: Move public definitions to elmorph-public.scm; include it here. * src/ellinika/xlat.scm (ellinika:sounds-like): Rewrite as a wrapper over elstr->soundslike. Describe Milesian numbers. * style.css (img.ellinika-img): New class. * xml/lingua.conf.in (IMAGE): New tag. * xml/pl/alfabhta.xml: Describe Milesian numbers. Various fixes. * data/dbverb.struct: fix a typo in flection. Use 'sub' theme for pas/sub/aor. * data/irregular-verbs.xml: Add more verbs. * scm/conjugator.scm: Various fixes. * scm/verbop.scm: Accept empty mood and voice declarations.
-rw-r--r--configure.ac1
-rw-r--r--data/dbverb.struct4
-rw-r--r--data/irregular-verbs.xml81
-rw-r--r--scm/conj.scm335
-rw-r--r--scm/conjugator.scm129
-rw-r--r--scm/elmorph.c10
-rw-r--r--scm/elmorph.h39
-rw-r--r--scm/verbop.scm95
-rw-r--r--scm/xlat.scm280
-rw-r--r--src/ellinika/.gitignore2
-rw-r--r--src/ellinika/Makefile.am23
-rw-r--r--src/ellinika/elchr.c273
-rw-r--r--src/ellinika/elmorph-public.scm106
-rw-r--r--src/ellinika/elmorph.c308
-rw-r--r--src/ellinika/elmorph.h82
-rw-r--r--src/ellinika/elmorph.scm425
-rw-r--r--src/ellinika/phoneme.y353
-rw-r--r--src/ellinika/syllabificator.c152
-rw-r--r--src/ellinika/tenses.scm38
-rw-r--r--src/ellinika/xlat.scm113
-rwxr-xr-xsrc/ellinika/yyrename97
-rw-r--r--style.css6
-rw-r--r--xml/lingua.conf.in9
-rw-r--r--xml/pl/alfabhta.xml204
24 files changed, 1588 insertions, 1177 deletions
diff --git a/configure.ac b/configure.ac
index 233ec46..01b27a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -28,6 +28,7 @@ AC_CONFIG_MACRO_DIR([m4])
## * Checks for programs.
AC_PROG_CC
+AC_PROG_YACC
AM_PROG_LIBTOOL
M4='`cd $(top_srcdir); pwd`/scripts/missing --run m4'
diff --git a/data/dbverb.struct b/data/dbverb.struct
index 06745c8..d51633b 100644
--- a/data/dbverb.struct
+++ b/data/dbverb.struct
@@ -65,7 +65,7 @@ INSERT INTO verbflect VALUES
(8, NULL, "ε", NULL, NULL, "ετε", NULL),
(9, NULL, "ε", NULL, NULL, "τε", NULL),
(11, "ομαι", "εσαι", "εται", "όμαστε", "εστε", "ονται"),
-(12, "όμουν", "όσουν", "όταν", "όμαστε", "όμαστε", "ονταν"),
+(12, "όμουν", "όσουν", "όταν", "όμαστε", "όσαστε", "ονταν"),
(15, "ώ", "είς", "εί", "ούμε", "είτε", "ούν(ε)"),
(17, NULL, "ου", NULL, NULL, NULL, NULL),
(18, NULL, NULL, NULL, NULL, "είτε", NULL),
@@ -123,7 +123,7 @@ INSERT INTO conjugation VALUES
("A", "pas", "ind", "Μέλλοντας στιγμιαίος", 'aor', NULL, 15, "111111", "θα", NULL, NULL),
-- Υποτακτική
("A", "pas", "sub", "Ενεστώτας", 'pres', NULL, 11, "333333", "να", NULL, NULL),
-("A", "pas", "sub", "Αόριστος", 'aor', NULL, 15, "111221", "να", NULL, NULL),
+("A", "pas", "sub", "Αόριστος", 'sub', NULL, 15, "111221", "να", NULL, NULL),
("A", "pas", "sub", "Παρακείμενος", 'synt', NULL, 0, NULL, "να", "έχω", "Παρατατικός"),
-- Προστακτική
("A", "pas", "imp", "Ενεστώτας", 'pres', NULL, 11, "-3--3-", "να", NULL, NULL),
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml
index ca2c7d1..d056f7d 100644
--- a/data/irregular-verbs.xml
+++ b/data/irregular-verbs.xml
@@ -56,28 +56,7 @@
</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>
+ <pas/>
</v>
<v>
@@ -109,28 +88,8 @@
<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>
+
+ <pas/>
</v>
<v>
@@ -337,6 +296,31 @@
</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>
+
<!-- FIXME
έρχομαι
κάθομαι
@@ -414,15 +398,6 @@
</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>
diff --git a/scm/conj.scm b/scm/conj.scm
deleted file mode 100644
index 3c2e96a..0000000
--- a/scm/conj.scm
+++ /dev/null
@@ -1,335 +0,0 @@
-(use-modules (xlat))
-
-(define (active-aorist-root present-root)
- (let ((last-syllable (car present-root)))
- (case (car last-syllable)
- ((#\@)
- (set-car! last-syllable #\s))
- ((#\z)
- (set-car! last-syllable #\s)) ;; FIXME: not always
- ((#\k)
- (cond
- ((and (not (null? (cdr last-syllable)))
- (char=? (cadr last-syllable) #\s))
- (set! last-syllable (cons #\x (cddr last-syllable))))
- (else
- (set-car! last-syllable #\x))))
- ((#\n)
- (cond
- ((and (not (null? (cdr last-syllable)))
- (char=? (cadr last-syllable) #\h))
- (set! last-syllable (cons #\x (cddr last-syllable))))
- (else
- (set-car! last-syllable #\s))))
- ((#\g #\h)
- (set-car! last-syllable #\x))
- ((#\p #\b #\f)
- (set-car! last-syllable #\*))
- ((#\y)
- (cond
- ((and (not (null? (cdr last-syllable)))
- (or (char=? (cadr last-syllable) #\a)
- (char=? (cadr last-syllable) #\e)))
- (set! last-syllable (cons #\* (cdr last-syllable))))))
- (else
- (throw 'grammar "Dont't know how to handle " present-root)))
- (cons last-syllable (cdr present-root))))
-
-
-(define (aor str)
- (active-aorist-root (cdr (greek-normalize str))))
-
-
-(define (add-flection word flect)
- (let* ((syl-list (append (cdr flect) (cdr word)))
- (acc-pos (or (car flect)
- (and (car word)
- (+ (car word) (length (cdr flect)))))))
- (cons
- (if (and acc-pos (> acc-pos 3))
- 3
- acc-pos)
- syl-list)))
-
-; FIXME: Should return real augment!
-(define (get-augment root)
- #\e)
-
-; FIXME: Does not handle verbs with internal augment
-(define (create-paratatikos-A root flect)
- (let ((word (add-flection root flect)))
- (cons 3
- (if (< (length (cdr word)) 3)
- (append (cdr word) (list (list (get-augment root))))
- (cdr word)))))
-
-(define (create-paratatikos-B root flect)
- (add-flection root (add-flection (greek->xlat "ούσ")
- (cons
- #f
- (cdr flect)))))
-
-(define (create-prostaktiki-enestota root flect)
- (let ((w (add-flection root flect)))
- (cond
- ((car flect)
- (cons (car flect) (cdr w)))
- ((>= (length (cdr w)) 3)
- (cons 3 (cdr w)))
- ((not (car w))
- (cons (length (cdr w)) (cdr w)))
- (else
- w))))
-
-;; Verbal form Accessors
-(define (vtab-root tab)
- (car tab))
-
-(define (vtab-analizer tab)
- (list-ref tab 2))
-
-(define (vtab-composer tab)
- (or (list-ref tab 1)
- add-flection))
-
-(define (vtab-flection tab person)
- (list-ref tab (+ person 2)))
-
-;;
-(define (flect-list root composer analizer . p)
- (append
- (list root composer analizer)
- (map
- (lambda (pers)
- (map
- greek->xlat
- pers))
- p)))
-
-;;
-(define verbal-flect-table
- (list
- (cons "Α"
- (list
- (cons "ενεργητηκή"
- (list
- (cons "οριστική"
- (list
- (cons "ενεστώτας"
- (flect-list
- #:present-root
- #f
- #f
- (list "ω")
- (list "εις")
- (list "ει")
- (list "ουμε")
- (list "ετε")
- (list "ουν" "ουνε")))
- (cons "παρατατικός"
- (flect-list
- #:present-root
- create-paratatikos-A
- #f
- (list "α")
- (list "ες")
- (list "ε")
- (list "αμε")
- (list "ατε")
- (list "αν" "ανε")))
- (cons "μέλλοντας διαρκείας"
- (flect-list
- #:present-root
- #f ;; FIXME: "θα"
- #f
- (list "ω")
- (list "εις")
- (list "ει")
- (list "ουμε")
- (list "ετε")
- (list "ουν" "ουνε")))))
-
- (cons "προστακτική"
- (list
- (cons "ενεστώτας"
- (flect-list
- #:present-root
- create-prostaktiki-enestota
- #f
- '()
- (list "ε")
- '()
- '()
- (list "ετε")
- '())))) ))))
- (cons "Β1"
- (list
- (cons "ενεργητηκή"
- (list
- (cons "οριστική"
- (list
- (cons "ενεστώτας"
- (flect-list
- #:present-root
- #f
- #f
- (list "άω")
- (list "άς")
- (list "ά" "άει")
- (list "άμε")
- (list "άτε")
- (list "ούν" "ούνε")))
- (cons "παρατατικός"
- (flect-list
- #:present-root
- create-paratatikos-B
- #f
- (list "α")
- (list "ες")
- (list "ε")
- (list "αμε")
- (list "ατε")
- (list "αν" "ανε")))
- (cons "μέλλοντας διαρκείας"
- (flect-list
- #:present-root
- #f ;; FIXME: "θα"
- #f
- (list "άω")
- (list "άς")
- (list "ά" "άει")
- (list "άμε")
- (list "άτε")
- (list "ούν" "ούνε"))) ))
-
- (cons "προστακτική"
- (list
- (cons "ενεστώτας"
- (flect-list
- #:present-root
- create-prostaktiki-enestota
- #f
- '()
- (list "α")
- '()
- '()
- (list "άτε")
- '())))) ))))
- (cons "Β2"
- (list
- (cons "ενεργητηκή"
- (list
- (cons "οριστική"
- (list
- (cons "ενεστώτας"
- (flect-list
- #:present-root
- #f
- #f
- (list "ώ")
- (list "είς")
- (list "εί")
- (list "ούμε")
- (list "είτε")
- (list "ούν" "ούνε")))
- (cons "παρατατικός"
- (flect-list
- #:present-root
- create-paratatikos-B
- #f
- (list "α")
- (list "ες")
- (list "ε")
- (list "αμε")
- (list "ατε")
- (list "αν" "ανε")))
- (cons "μέλλοντας διαρκείας"
- (flect-list
- #:present-root
- #f ;; FIXME: "θα"
- #f
- (list "ώ")
- (list "είς")
- (list "εί")
- (list "ούμε")
- (list "είτε")
- (list "ούν" "ούνε"))) ))))))))
-
-(define (verbal-flect-table-lookup table form-list)
- (if (null? form-list)
- table
- (let ((entry (assoc (car form-list) table)))
- (if entry
- (verbal-flect-table-lookup (cdr entry) (cdr form-list))
- #f))))
-
-(define (find-verbal-form . rest)
- (verbal-flect-table-lookup verbal-flect-table rest))
-
-
-(define (conjugate root pers forms)
- (let ((tab (verbal-flect-table-lookup verbal-flect-table forms)))
- (if (not tab)
- (throw 'grammar "Verbal form not found " forms))
- (let ((func (vtab-composer tab))
- (root-selector (vtab-root tab)))
-
- (map
- (lambda (x)
- (func root x))
- (vtab-flection tab pers)))))
-
-(define (conjugate-v root pers . forms)
- (conjugate root pers forms))
-
-;; Test
-
-(define (conj-all root . rest)
- (map (lambda (x)
- (display x)(display "/"))
- rest)
- (newline)
- (do ((i 1 (1+ i)))
- ((> i 6) #f)
- (map
- (lambda (x)
- (display (xlat->greek x))(display ","))
- (conjugate (greek->xlat root) i rest))
- (newline)))
-
-
-;(conj-all "βεβαίων" "Α" "ενεργητηκή" "οριστική" "ενεστώτας")
-;(newline)
-
-;(conj-all "βεβαίων" "Α" "ενεργητηκή" "οριστική" "παρατατικός")
-;(newline)
-
-;(conj-all "ντυν" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας")
-;(newline)
-;(conj-all "βεβαίων" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας")
-;(newline)
-;(conj-all "διαβάζ" "Α" "ενεργητηκή" "προστακτική" "ενεστώτας")
-;(newline)
-
-;(conj-all "λύν" "Α" "ενεργητηκή" "οριστική" "παρατατικός")
-;(newline)
-
-;(conj-all "νικ" "Β1" "ενεργητηκή" "οριστική" "ενεστώτας")
-;(newline)
-
-;(conj-all "νικ" "Β1" "ενεργητηκή" "οριστική" "παρατατικός")
-;(newline)
-
-;(conj-all "νικ" "Β1" "ενεργητηκή" "προστακτική" "ενεστώτας")
-;(newline)
-
-;(conj-all "θεωρ" "Β2" "ενεργητηκή" "οριστική" "ενεστώτας")
-;(newline)
-
-;(conj-all "θεωρ" "Β2" "ενεργητηκή" "οριστική" "παρατατικός")
-;(newline)
-
-;(display (xlat->greek (cons #f (active-aorist-root (cdr (greek->xlat "ιατρευ"))))))
-;(newline)
-
-
diff --git a/scm/conjugator.scm b/scm/conjugator.scm
index 7b2a4a6..c2c2171 100644
--- a/scm/conjugator.scm
+++ b/scm/conjugator.scm
@@ -64,6 +64,7 @@
"ησ"
#f
#f))
+ ;; FIXME: deponentia?
(else
(list "A"
#f
@@ -136,6 +137,15 @@ WHERE verb='" (force-string verb) "'"
"SELECT root FROM irregular_root \
WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
+(define (verb-A-root verb)
+ (cond
+ ((elstr-suffix? verb "ω")
+ (elstr-trim verb -1))
+ ((elstr-suffix? verb "ομαι")
+ (elstr-trim verb -4))
+ (else
+ (error "cannot handle ~A~%" verb))))
+
(define (complement-verb-info vinfo verb voice thema)
; (format #t "COMPLEMENT ~S~%" thema)
(let ((elverb (string->elstr verb))
@@ -149,7 +159,7 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(verb-info-set! #:attested vinfo 'root)
(caar result))
((string=? (verb-info #:conj vinfo) "A")
- (let ((root (elstr-trim elverb -1)))
+ (let ((root (verb-A-root elverb)))
(cond
((string=? thema "pres")
(verb-info-set! #:attested vinfo 'root)
@@ -284,9 +294,6 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
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)))
@@ -311,28 +318,19 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(let* ((rs (force-elstr root))
(suf (elstr-deaccent (elstr-append suffix flect)))
(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)))))
+ (nsyl (elstr-number-of-syllables result))
+ (acc-syl (+ (- nsyl
+ (let ((n (accented-syllable-0 rs)))
+ (if (= 0 n)
+ (accented-syllable-0 verb)
+ n))) 1)))
+ (cond
+ ((= nsyl 1)
+ (elstr-deaccent result))
+ ((> acc-syl 3)
+ (elstr-set-accent result 3)) ; FIXME
+ (else
+ (elstr-set-accent result acc-syl)))))
((char=? acc #\f)
(elstr-append
(elstr-deaccent (elstr-append root suffix))
@@ -397,17 +395,22 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(let* ((verb-conj (conjugate verb "act" "sub" "Αόριστος" #:nopart))
(form (list-ref verb-conj 2))
(part (conj-info #:particle conj)))
- (append
- (map
- (lambda (aux)
- (elstr->string
- (if part
- (elstr-append part " " aux " " form)
- (elstr-append aux " " form))))
- (conjugation:table (conjugate (conj-info #:aux conj) "act" "ind"
- (conj-info #:auxtense conj))))
- (list (verb-info #:conj vinfo)
- (conjugation:attested verb-conj)))))
+ (cond
+ (form
+; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME
+ (append
+ (map
+ (lambda (aux)
+ (elstr->string
+ (if part
+ (elstr-append part " " aux " " form)
+ (elstr-append aux " " form))))
+ (conjugation:table (conjugate (conj-info #:aux conj) "act" "ind"
+ (conj-info #:auxtense conj))))
+ (list (verb-info #:conj vinfo)
+ (conjugation:attested verb-conj))))
+ (else
+ #f))))
(else
; (format #t "CONJ ~S~%" conj)
(complement-verb-info vinfo verb voice (conj-info #:thema conj))
@@ -416,21 +419,34 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(verb-info #:attested vinfo)))))))))
(define (conjugation:table conj)
- (list-head conj 6))
+ (cond
+ ((not conj)
+ #f)
+ (else
+ (list-head conj 6))))
(define (conjugation:class conj)
- (list-ref conj 6))
+ (cond
+ ((not conj)
+ #f)
+ (else
+ (list-ref conj 6))))
(define (conjugation:attested conj)
- (list-ref conj 7))
+ (cond
+ ((not conj)
+ #f)
+ (else (list-ref conj 7))))
(define (empty-conjugation? conj)
- (call-with-current-continuation
- (lambda (return)
- (for-each
- (lambda (x)
- (if x
- (return #f)))
- conj)
- (return #t))))
+ (or
+ (not conj)
+ (call-with-current-continuation
+ (lambda (return)
+ (for-each
+ (lambda (x)
+ (if x
+ (return #f)))
+ conj)
+ (return #t)))))
;;
;(display (verb-info "βρίσκω"))
@@ -525,8 +541,17 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
;; (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" "Αόριστος")
+;; (test-conjugation "πηγαίνω" "act" "ind" "Μέλλοντας στιγμιαίος")
+;; (test-conjugation "πίνω" "act" "ind" "Αόριστος")
+;; (test-conjugation "πίνω" "act" "sub" "Αόριστος")
+;; (test-conjugation "πίνω" "act" "imp" "Αόριστος")
+
+(test-conjugation "έρχομαι" "pas" "ind" "Παρατατικός")
+(test-conjugation "έρχομαι" "pas" "ind" "Αόριστος")
+(test-conjugation "έρχομαι" "pas" "sub" "Αόριστος")
+;; (test-conjugation "έρχομαι" "pas" "ind" "Συντελεσμένος Μέλλοντας")
+;; (test-conjugation "έρχομαι" "act" "sub" "Αόριστος" )
+;; (test-conjugation "έρχομαι" "pas" "sub" "Αόριστος" )
+;; (test-conjugation "έρχομαι" "pas" "ind" "Ενεστώτας");FIXME!
+;; (test-conjugation "έρχομαι" "pas" "ind" "Υπερσυντέλικος")
(newline)
diff --git a/scm/elmorph.c b/scm/elmorph.c
deleted file mode 100644
index 87598d9..0000000
--- a/scm/elmorph.c
+++ /dev/null
@@ -1,10 +0,0 @@
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-#include <errno.h>
-#include <stdlib.h>
-#include <libguile.h>
-#include "utf8.h"
-#include "elchr.h"
-
-
diff --git a/scm/elmorph.h b/scm/elmorph.h
deleted file mode 100644
index 6bc19ca..0000000
--- a/scm/elmorph.h
+++ /dev/null
@@ -1,39 +0,0 @@
-#define CHF_OXEIA 1
-#define CHF_PERISPWMENH 2
-#define CHF_BAREIA 3
-
-#define CHF_ACCENT_MASK 0x000f
-
-#define CHF_TREMA 0x0010
-
-#define CHF_VOWEL 0x0020
-#define CHF_CONSONANT 0x0040
-#define CHF_SEMIVOWEL 0x0080
-#define CHF_PUNCT 0x0100
-#define CHF_SYMBOL 0x0200
-#define CHF_MODIFIER 0x0400
-#define CHF_ARCHAIC 0x0800
-#define CHF_LOWER 0x1000
-#define CHF_UPPER 0x2000
-#define CHF_NUMERIC 0x4000
-
-int elchr_flags(unsigned ch);
-int elchr_isupper(unsigned ch);
-int elchr_islower(unsigned ch);
-int elchr_getaccent(unsigned ch);
-int elchr_istrema(unsigned ch);
-int elchr_isvowel(unsigned ch);
-int elchr_isconsonant(unsigned ch);
-int elchr_issemivowel(unsigned ch);
-int elchr_ispunct(unsigned ch);
-int elchr_issymbol(unsigned ch);
-int elchr_ismodifier(unsigned ch);
-int elchr_isarchaic(unsigned ch);
-int elchr_isnumeric(unsigned ch);
-unsigned elchr_numeric_value(unsigned ch);
-unsigned elchr_toupper(unsigned ch);
-unsigned elchr_tolower(unsigned ch);
-unsigned elchr_base(unsigned ch);
-unsigned elchr_deaccent(unsigned ch);
-unsigned elchr_accent(unsigned ch, int acc);
-
diff --git a/scm/verbop.scm b/scm/verbop.scm
index bb54126..f3ecc33 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -2,7 +2,7 @@
(xmltools xmltrans)
(ellinika elmorph)
(gamma sql)
- (ellinika xlat)
+ (ellinika tenses)
(ice-9 getopt-long))
(define cleanup-option #f)
@@ -51,12 +51,12 @@
(debug 100 rest)
(let ((q (apply format (cons #f rest))))
(if verbose-option
- (format #t "QUERY: ~S\n" q))
+ (format #t "QUERY: ~A\n" q))
(cond
(connection
(let ((res (sql-query connection q)))
(if verbose-option
- (format #t "RESULT: ~S\n" res))
+ (format #t "RESULT: ~A\n" res))
res))
(else
#f))))
@@ -197,6 +197,15 @@
conj)
(return #t))))
+(define (insert-individual-verb voice mood tense ident)
+ (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \
+VALUES (~A,~A,~A,~A,~A);~%"
+ (verb-get-sql #:verb)
+ (sql-val voice)
+ (sql-val mood)
+ (sql-val tense)
+ (number->string ident)))
+
(define (flush-mood mood vstr)
(if (eq? (car mood) #:root)
(let ((val (cdr mood)))
@@ -207,45 +216,51 @@ VALUES (~A,~A,~A,~A);~%"
(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)))))
+ (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))))))
(define (flush-voice vstr conj-list)
- (if conj-list
- (for-each
- (lambda (mood)
- (flush-mood mood vstr))
- conj-list)))
+ (cond
+ ((null? conj-list)
+ (for-each
+ (lambda (vp)
+ (let ((mood (car vp)))
+ (for-each
+ (lambda (tense)
+ (insert-individual-verb vstr mood tense 0))
+ (cdr vp))))
+ ellinika-tense-list))
+ (conj-list
+ (for-each
+ (lambda (mood)
+ (flush-mood mood vstr))
+ conj-list))))
;;; Fush verb definition to the database
(define (verb-flush)
diff --git a/scm/xlat.scm b/scm/xlat.scm
deleted file mode 100644
index 37028b3..0000000
--- a/scm/xlat.scm
+++ /dev/null
@@ -1,280 +0,0 @@
-(define-module (xlat))
-
-(define xlist-latin
- (list
- (list #\a "α" "Α" "ά" "Ά")
- (list #\b "β" "Β")
- (list #\g "γ" "Γ")
- (list #\d "δ" "Δ")
- (list #\e "ε" "Ε" "έ" "Έ")
- (list #\z "ζ" "Ζ")
- (list #\% "η" "Η" "ή" "Ή")
- (list #\@ "θ" "Θ")
- (list #\i "ι" "Ι" "ί" "Ί")
- (list #\k "κ" "Κ")
- (list #\l "λ" "Λ")
- (list #\m "μ" "Μ")
- (list #\n "ν" "Ν")
- (list #\x "ξ" "Ξ")
- (list #\o "ο" "Ο" "ό" "Ό")
- (list #\p "π" "Π")
- (list #\r "ρ" "Ρ")
- (list #\s "σ" "Σ" "ς") ; FIXME: Special case.
- (list #\c "ς" "Σ")
- (list #\t "τ" "Τ")
- (list #\y "υ" "Υ" "ύ" "Ύ")
- (list #\f "φ" "Φ")
- (list #\h "χ" "Χ")
- (list #\* "ψ" "Ψ")
- (list #\w "ω" "Ω" "ώ" "Ώ")
- (list #\I "ϊ" "Ϊ" "ΐ" "ΐ")
- (list #\Y "ϋ" "Ϋ" "ΰ" "ΰ")))
-
-
-(define xlist-greek
- (list
- (cons "α" #\a )
- (cons "Α" #\a )
- (cons "Ά" (cons #\a #t))
- (cons "ά" (cons #\a #t))
- (cons "β" #\b )
- (cons "Β" #\b )
- (cons "γ" #\g )