diff options
Diffstat (limited to 'scm/conjugator.scm')
-rw-r--r-- | scm/conjugator.scm | 141 |
1 files changed, 79 insertions, 62 deletions
diff --git a/scm/conjugator.scm b/scm/conjugator.scm index 19642b3..3015b13 100644 --- a/scm/conjugator.scm +++ b/scm/conjugator.scm @@ -52,39 +52,55 @@ (else (let ((root (elstr-trim elverb -1))) (list "A" + #f "ε" - (list - (cons "pres" root) - (cons "aor" (elstr-thema-aoristoy root)) - (cons "pass" root)))))))) + #f)))))) (define (get-verb-info verb) (let ((conn (dict-connect))) (let ((vdb (my-sql-query conn (string-append - "SELECT conj,augment,present,aorist,pass FROM verb WHERE word='" - verb - "'")))) + "SELECT conj,accmap,augment FROM verb \ +WHERE verb='" verb "'")))) (if (null? vdb) (guess-verb-info verb) (let ((x (car vdb))) (list - (car x) - (or (list-ref x 1) "ε") - (list - (cons "pres" (list-ref x 2)) - (cons "aor" (list-ref x 3)) - (cons "pass" (list-ref x 4))))))))) + (list-ref x 0) + (list-ref x 1) + (or (list-ref x 2) "ε") + #f)))))) + +(define (complement-verb-info vinfo verb voice thema) +; (format #t "COMPLEMENT ~S~%" thema) + (let ((result (my-sql-query + (dict-connect) + (string-append + "SELECT root FROM irregular_root \ +WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))) + (list-set! vinfo 3 + (if (not (null? result)) + (caar result) + (let ((root (elstr-trim (string->elstr verb) -1))) + (cond + ((string=? thema "pres") + root) + ((or (string=? thema "aor") (string=? thema "sub")) + (elstr-thema-aoristoy root)) + (else + #f))))))) (define-syntax verb-info (syntax-rules () ((verb-info #:conj v) (list-ref v 0)) - ((verb-info #:augment v) + ((verb-info #:accmap v) (list-ref v 1)) + ((verb-info #:augment v) + (list-ref v 2)) ((verb-info #:root v) - (list-ref v 2)))) + (list-ref v 3)))) (define-syntax conj-info (syntax-rules () @@ -139,20 +155,14 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode (string->elstr str) str)) -(define (force-accent str) - (if (and str (= (elstr-accented-syllable str) 0)) - (let ((nsyl (elstr-number-of-syllables str))) - (cond - ((= nsyl 1) - str) - (else - (elstr-set-accent str 2)))) - str)) - -(define (apply-flect root conj vinfo) - (let ((suffix (or (conj-info #:suffix conj) "")) - (accmap (string->list (or (conj-info #:accmap conj) "000000"))) +(define (apply-flect conj vinfo) + (let ((root (verb-info #:root vinfo)) + (suffix (or (conj-info #:suffix conj) "")) + (accmap (string->list (or (verb-info #:accmap vinfo) + (conj-info #:accmap conj) + "000000"))) (augment "")) +; (format #t "ROOT ~S, ACCMAP ~S~%" root accmap) (cond ((> (length accmap) 6) (set! accmap (list-head accmap 6)) @@ -162,10 +172,22 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode (lambda (flect acc) (cond ((char=? acc #\0) - (force-accent - (elstr-append - root - (elstr-deaccent (elstr-append suffix flect))))) + (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)))) ((char=? acc #\f) (elstr-append (elstr-deaccent (elstr-append root suffix)) @@ -209,7 +231,7 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode (cond ((string=? (conj-info #:thema conj) "synt") (let ((form (list-ref - (conjugate verb "act" "sub" "Ενεστώτας" #:nopart) 2)) + (conjugate verb "act" "sub" "Αόριστος" #:nopart) 2)) (part (conj-info #:particle conj))) (map (lambda (aux) @@ -220,21 +242,9 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mode='" mode (conjugate (conj-info #:aux conj) "act" "ind" (conj-info #:auxtense conj))) )) (else - (let ((root #f) - (exception (my-sql-query - (dict-connect) - (string-append - "SELECT root,accmap FROM irregular_verb \ -WHERE word='" verb "' AND voice='" voice "' AND tense='" tense "'")))) - (if (not (null? exception)) - (let ((x (car exception))) - (set! root (list-ref x 0)) - (let ((accmap (list-ref x 1))) - (if accmap - (list-set! conj 2 accmap)))) - (set! root (assoc-ref (verb-info #:root vinfo) - (conj-info #:thema conj)))) - (apply-flect root conj vinfo)))))) +; (format #t "CONJ ~S~%" conj) + (complement-verb-info vinfo verb voice (conj-info #:thema conj)) + (apply-flect conj vinfo))))) ;; ;(display (verb-info "βρίσκω")) @@ -242,18 +252,25 @@ WHERE word='" verb "' AND voice='" voice "' AND tense='" tense "'")))) ;(display (verb-info "ανοίγω")) ;(newline) -;(display (conjugate "έχω" "act" "ind" "Ενεστώτας")) -;(display (conjugate "ανοίγω" "act" "ind" "Ενεστώτας")) -;(display (conjugate "ανοίγω" "act" "ind" "Αόριστος")) -;(display (conjugate "δένω" "act" "ind" "Αόριστος")) -;(display (conjugate "βρίσκω" "act" "ind" "Ενεστώτας")) -;(display (conjugate "βρίσκω" "act" "ind" "Αόριστος")) -;(display (conjugate "βρίσκω" "act" "ind" "Μέλλοντας στιγμιαίος")) -;(display (conjugate "βρίσκω" "pas" "ind" "Αόριστος")) -;(display (conjugate "θέλω" "act" "ind" "Αόριστος")) -;(display (conjugate "θέλω" "act" "ind" "Παρατατικός")) -;(display (conjugate "βρίσκω" "act" "ind" "Παρακείμενος")) -;(display (conjugate "βρίσκω" "act" "sub" "Παρακείμενος")) -;(display (conjugate "βρίσκω" "act" "sub" "Ενεστώτας")) -(display (conjugate "βρίσκω" "act" "sub" "Αόριστος")) +(define (test-conjugation verb voice mode tense) + (format #t "~A ~A ~A ~A: " verb voice mode tense) + (display (map force-string (conjugate verb voice mode tense))) + (newline) + (gc)) + +(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" "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" "Παρακείμενος") + (newline) |