aboutsummaryrefslogtreecommitdiff
path: root/scm/conjugator.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scm/conjugator.scm')
-rw-r--r--scm/conjugator.scm141
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)

Return to:

Send suggestions and report system problems to the System administrator.