diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-10 23:04:53 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-11 00:34:20 +0300 |
commit | a1a5b7ddd6c3c0532c37551b24fd573a554ac181 (patch) | |
tree | f86f3572c77dc986bb2dfb65619ac4bc35c83847 | |
parent | 2bae7da012e2125762855ce014e63345ecbbbb18 (diff) | |
download | ellinika-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.ac | 1 | ||||
-rw-r--r-- | data/dbverb.struct | 4 | ||||
-rw-r--r-- | data/irregular-verbs.xml | 81 | ||||
-rw-r--r-- | scm/conj.scm | 335 | ||||
-rw-r--r-- | scm/conjugator.scm | 129 | ||||
-rw-r--r-- | scm/elmorph.c | 10 | ||||
-rw-r--r-- | scm/elmorph.h | 39 | ||||
-rw-r--r-- | scm/verbop.scm | 95 | ||||
-rw-r--r-- | scm/xlat.scm | 280 | ||||
-rw-r--r-- | src/ellinika/.gitignore | 2 | ||||
-rw-r--r-- | src/ellinika/Makefile.am | 23 | ||||
-rw-r--r-- | src/ellinika/elchr.c | 273 | ||||
-rw-r--r-- | src/ellinika/elmorph-public.scm | 106 | ||||
-rw-r--r-- | src/ellinika/elmorph.c | 308 | ||||
-rw-r--r-- | src/ellinika/elmorph.h | 82 | ||||
-rw-r--r-- | src/ellinika/elmorph.scm4 | 25 | ||||
-rw-r--r-- | src/ellinika/phoneme.y | 353 | ||||
-rw-r--r-- | src/ellinika/syllabificator.c | 152 | ||||
-rw-r--r-- | src/ellinika/tenses.scm | 38 | ||||
-rw-r--r-- | src/ellinika/xlat.scm | 113 | ||||
-rwxr-xr-x | src/ellinika/yyrename | 97 | ||||
-rw-r--r-- | style.css | 6 | ||||
-rw-r--r-- | xml/lingua.conf.in | 9 | ||||
-rw-r--r-- | xml/pl/alfabhta.xml | 204 |
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 ) |