diff options
Diffstat (limited to 'scm/conjugator.scm')
| -rw-r--r-- | scm/conjugator.scm | 189 |
1 files changed, 118 insertions, 71 deletions
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) |