diff options
Diffstat (limited to 'src/ellinika')
-rw-r--r-- | src/ellinika/conjugator.scm | 147 |
1 files changed, 86 insertions, 61 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index 536b48e..bffc6be 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm @@ -48,2 +48,4 @@ (list-set! verb 3 (append (list-ref verb 3) (list value)))) + ((#:proplist) + (list-set! verb 2 value)) (else @@ -80,4 +82,3 @@ -(define (create-basic-verb-info verb proplist . rest) -; (format #t "PROPLIST ~A~%" proplist) +(define (create-basic-verb-info verb . rest) (let ((vdb (if (null? rest) @@ -91,8 +92,8 @@ ((and vdb (not (null? vdb))) - (list (caar vdb) verb proplist '(class))) + (list (caar vdb) verb '() '(class))) ((elstr-suffix? verb "άω") (create-basic-verb-info (elstr-append - (elstr-trim verb -2) "ώ") proplist "B1")) + (elstr-trim verb -2) "ώ") "B1")) ((null? rest) - (list (guess-verb-class verb) verb proplist '())) + (list (guess-verb-class verb) verb '() '())) (else @@ -100,4 +101,3 @@ -(define (load-verb-info verb voice mood tense) -; (format #t "LOAD ~A~%" verb) +(define (load-proplist vinfo voice mood tense) (let ((verbprop (ellinika:sql-query @@ -105,5 +105,5 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" - verb voice mood tense))) - (create-basic-verb-info - verb + (verb-get vinfo #:verb) voice mood tense))) + (verb-set! + vinfo #:proplist (let loop ((inlist (if (null? verbprop) @@ -122,2 +122,3 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" (stemlist '()) + (suflist '()) (outlist '())) @@ -126,9 +127,22 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" ((null? inlist) - (if (null? stemlist) - outlist - (cons (cons #:stem stemlist) outlist))) + (append + (if (not (null? stemlist)) + (list (cons #:stem stemlist)) + '()) + (if (not (null? suflist)) + (list (cons #:suffix suflist)) + '()) + outlist)) ((eq? (caar inlist) #:stem) - (loop (cdr inlist) (cons (cdar inlist) stemlist) outlist)) + (loop (cdr inlist) (cons (cdar inlist) stemlist) suflist outlist)) + ((eq? (caar inlist) #:suffix) + (loop (cdr inlist) stemlist (cons (cdar inlist) suflist) outlist)) (else - (loop (cdr inlist) stemlist (cons (car inlist) outlist)))))))) + (loop (cdr inlist) stemlist suflist (cons (car inlist) outlist)))))))) + +(define (load-verb-info verb voice mood tense) +; (format #t "LOAD ~A~%" verb) + (let ((vinfo (create-basic-verb-info verb))) + (load-proplist vinfo voice mood tense) + vinfo)) @@ -241,7 +255,6 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" ((or (string=? thema "aor") (string=? thema "sub")) - (thema-aoristoy-mesapathitikis-B - stem - (list-ref - (conjugate verb "act" "ind" "Αόριστος") - 0))) + (map + (lambda (aor) + (thema-aoristoy-mesapathitikis-B stem aor)) + (conjugate verb "act" "ind" "Αόριστος"))) (else @@ -349,13 +362,14 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (define (get-suffix conj vinfo) - (let ((override (verb-get vinfo #:override))) - (if (and override - (member "suffix" override)) - (let ((t (conj-info #:suffix conj))) - (if t - (or (verb-get vinfo #:suffix) - t) - "")) - (or (verb-get vinfo #:suffix) - (conj-info #:suffix conj) - "")))) + (let ((ret (let ((override (verb-get vinfo #:override))) + (if (and override + (member "suffix" override)) + (let ((t (conj-info #:suffix conj))) + (if t + (or (verb-get vinfo #:suffix) + t) + "")) + (or (verb-get vinfo #:suffix) + (conj-info #:suffix conj) + ""))))) + (if (list? ret) ret (list ret)))) @@ -374,6 +388,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" -(define (apply-flect conj vinfo verb stem) +(define (apply-flect conj vinfo verb stem suffix) ; (format #t "VINFO ~A~%" vinfo) - (let ((suffix (get-suffix conj vinfo)) - (accmap (string->list (get-accmap conj vinfo))) + (let ((accmap (string->list (get-accmap conj vinfo))) (augment "")) @@ -390,3 +403,4 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" ((verb-get vinfo (symbol->keyword - (string->symbol (number->string person)))) => + (string->symbol + (number->string person)))) => (lambda (personal-form) @@ -416,8 +430,10 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" ((char=? acc #\s) - (let ((nsyl (elstr-number-of-syllables flect))) + (let ((nsyl (elstr-number-of-syllables flect)) + (result (elstr-append stem suffix flect))) (elstr-set-accent - (elstr-append stem suffix flect) - (if (< nsyl 2) - (+ nsyl 1) - 3)))) + result + (min (if (< nsyl 2) + (+ nsyl 1) + 3) + (elstr-number-of-syllables result))))) ((char=? acc #\-) @@ -428,4 +444,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" stem suffix flect))) - (if (and augment (= (+ (elstr-number-of-syllables obj) 1) - num)) + (if (and augment + (= (+ (elstr-number-of-syllables obj) 1) + num)) (set! obj (elstr-append augment obj))) @@ -455,6 +472,6 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (let ((res (ellinika:sql-query - "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \ -FROM individual_verb i,verbflect f \ -WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\ -AND i.tense=\"~A\" AND i.ident=f.ident" + "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3\ + FROM individual_verb i,verbflect f\ + WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\ + AND i.tense=\"~A\" AND i.ident=f.ident" verb voice mood tense))) @@ -479,4 +496,8 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (let* ((vinfo (load-verb-info verb voice mood tense)) - (conj-list (get-conj-info (verb-get vinfo #:conj) - voice mood tense))) + (conj-list (get-conj-info (or + (verb-get vinfo #:class) + (verb-get vinfo #:conj)) + voice mood tense)) + (verb (force-string (verb-get vinfo #:verb)))) + (format #t "VINFO ~A~%" vinfo) (if (not conj-list) @@ -580,15 +601,20 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (car thema)))) -; (format #t "VINFO ~A~%" vinfo) - (fold - (lambda (stem prev) - (cons - (cons - (append (apply-flect conj vinfo verb stem) - (list (verb-get vinfo #:conj) - (verb-get vinfo #:attested))) - (conj-info #:fold conj)) - prev)) - prev - (verb-get vinfo #:stem)))))) + (fold + (lambda (suffix prev) + (append + (fold + (lambda (stem prev) + (cons + (cons + (append (apply-flect conj vinfo verb stem suffix) + (list (verb-get vinfo #:conj) + (verb-get vinfo #:attested))) + (conj-info #:fold conj)) + prev)) + '() + (verb-get vinfo #:stem)) + prev)) + prev + (get-suffix conj vinfo)))))) '() @@ -631,2 +657 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (return #t))))) - |