From 119c79bd50659612a9126f6793bd57b48792cb11 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Tue, 21 Jun 2011 12:13:02 +0300 Subject: Accept multiple suffixes. * data/irregular-verbs.xml: Update. * scm/verbop.scm: Allow for multiple suffixes. * src/ellinika/conjugator.scm: Accept multiple suffixes. Fix accent settings. * src/cgi-bin/conj.scm4: Minor changes. --- src/ellinika/conjugator.scm | 147 ++++++++++++++++++++++++++------------------ 1 file changed, 86 insertions(+), 61 deletions(-) (limited to 'src/ellinika') 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 @@ -46,6 +46,8 @@ (list-set! verb 1 value)) ((#:attested) (list-set! verb 3 (append (list-ref verb 3) (list value)))) + ((#:proplist) + (list-set! verb 2 value)) (else (let ((container (assoc key (list-ref verb 2))) (value (if (and (eq? key #:stem) (not (list? value))) @@ -78,8 +80,7 @@ ;; FIXME: deponentia? (else "A"))) -(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) (ellinika:sql-query "SELECT conj FROM verbclass WHERE verb=\"~A\"" @@ -89,23 +90,22 @@ verb (car rest))))) (cond ((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 (list (car rest) verb '() '()))))) -(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 "SELECT property,value FROM verbtense WHERE \ 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) '() (map @@ -120,17 +120,31 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" value)))) verbprop))) (stemlist '()) + (suflist '()) (outlist '())) ; (format #t "ARGS: ~A/~A/~A~%" inlist stemlist outlist) (cond ((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)) (define (thema-aoristoy-mesapathitikis-A stem) (cond @@ -239,11 +253,10 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" (verb-set! vinfo #:attested 'stem) stem) ((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 #f)))) ((string=? (verb-get vinfo #:conj) "B2") @@ -347,17 +360,18 @@ 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)))) (define (get-accmap conj vinfo) @@ -372,10 +386,9 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (conj-info #:accmap conj) "000000")))) -(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 "")) ; (format #t "STEM ~A, ACCMAP ~S, SUFFIX: ~A~%" stem accmap suffix) (cond @@ -388,7 +401,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (lambda (flect acc person) (cond ((verb-get vinfo (symbol->keyword - (string->symbol (number->string person)))) => + (string->symbol + (number->string person)))) => (lambda (personal-form) personal-form)) ((not flect) #f) @@ -414,20 +428,23 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (elstr-deaccent (elstr-append stem suffix)) flect)) ((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 #\-) #f) ((char-numeric? acc) (let ((num (- (char->integer acc) (char->integer #\0)))) (let ((obj (elstr-append 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))) (let ((nsyl (elstr-number-of-syllables obj))) (elstr-set-accent! obj (cond @@ -453,10 +470,10 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (define (individual-verb verb voice mood tense) (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))) (if (not (null? res)) (append (car res) @@ -477,8 +494,12 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (list res))) (else (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) (list (list #f #f #f #f #f #f #f #f)) (map car @@ -578,19 +599,24 @@ AND i.tense=\"~A\" AND i.ident=f.ident" voice (car (cdr thema))) (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)))))) '() conj-list)))))))) @@ -629,4 +655,3 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (return #f))) conj) (return #t))))) - -- cgit v1.2.1