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