diff options
Diffstat (limited to 'src/ellinika/conjugator.scm')
-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 @@ -43,12 +43,14 @@ ((#:conj) (list-set! verb 0 value)) ((#:verb) (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))) (list value) value))) (if container @@ -75,40 +77,38 @@ ;; FIXME ((elstr-suffix? verb "άω") "B1") ((elstr-suffix? verb "ώ") "B2") ;; 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\"" verb) (ellinika:sql-query "SELECT conj FROM verbclass WHERE verb=\"~A\" AND conj=~Q" 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 (lambda (elt) (let ((name (car elt)) (value (cadr elt))) @@ -117,23 +117,37 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" (string-split value #\,)) (cons (symbol->keyword (string->symbol name)) 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 ((elstr-suffix? stem "αίν") (elstr-append (elstr-trim stem -3) "ανθ")) ;; FIXME: Also αθ, ηθ ((and @@ -236,17 +250,16 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" (elstr-trim elverb -1)))) (cond ((or (string=? voice "act") (string=? thema "pres")) (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") (let ((stem (elstr-trim elverb -1))) (cond ((or (string=? voice "act") (string=? thema "pres")) @@ -344,23 +357,24 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" ;; (or (verb-get vinfo key) ;; (conj-info key conj) ;; default)))))) (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) (let ((override (verb-get vinfo #:override))) (if (and override (member "accmap" override)) @@ -369,29 +383,29 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (or (verb-get vinfo #:accmap) t))) (or (verb-get vinfo #:accmap) (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 ((> (length accmap) 6) (set! accmap (list-head accmap 6)) (set! augment (or (verb-get vinfo #:augment) "ε")))) ; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment)) (let ((forms (map (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) ((char=? acc #\0) (let* ((rs (force-elstr stem)) (suf (elstr-deaccent (elstr-append suffix flect))) @@ -411,26 +425,29 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (elstr-set-accent result acc-syl))))) ((char=? acc #\f) (elstr-append (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 ((< num nsyl) num) ((< nsyl 3) nsyl) (else 3))) @@ -450,16 +467,16 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" #f)) forms) (map force-string forms))))) (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) (list "I" '(class stem))) #f))) @@ -474,14 +491,18 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (cond ((individual-verb verb voice mood tense) => (lambda (res) (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 (fold (lambda (elt prev) ; (format #t "ELT ~A~%" elt) @@ -575,25 +596,30 @@ AND i.tense=\"~A\" AND i.ident=f.ident" ; (format #t "THEMA ~A~%" thema) (complement-verb-info vinfo verb (if (null? (cdr thema)) 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)))))))) (define-public (conjugator verb voice mood tense) (conjugate verb voice mood tense)) @@ -626,7 +652,6 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (for-each (lambda (x) (if x (return #f))) conj) (return #t))))) - |