diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/cgi-bin/conj.scm4 | 12 | ||||
-rw-r--r-- | src/ellinika/conjugator.scm | 147 |
2 files changed, 92 insertions, 67 deletions
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4 index 1894485..a8d84f1 100644 --- a/src/cgi-bin/conj.scm4 +++ b/src/cgi-bin/conj.scm4 @@ -105,10 +105,10 @@ ifelse(IFACE,[CGI],(cgi:init)) (cdr tense)))) (display "<th>") (cond - ((not (member 'root att)) - (display "<a href=\"#root-na\">?</a> ") - (if (not (member 'root unattested)) - (set! unattested (cons 'root unattested))))) + ((not (member 'stem att)) + (display "<a href=\"#stem-na\">?</a> ") + (if (not (member 'stem unattested)) + (set! unattested (cons 'stem unattested))))) (display tense-name) (display "</th>") (newline))) @@ -145,7 +145,7 @@ ifelse(IFACE,[CGI],(cgi:init)) (fold (lambda (elt prev) (if prev - (string-append prev "," elt) + (string-append prev ",<br>" elt) elt)) #f lst)) @@ -385,7 +385,7 @@ ifelse(IFACE,[CGI],(cgi:init)) (print-footnote "class-na" "*" "Conjugation class of this verb is not attested")) ((root) - (print-footnote "root-na" "?" + (print-footnote "stem-na" "?" (_ "Το θέμα αυτού του χρόνου δεν επιβεβαιώνεται από τη βάση δεδοµένων"))))) unattested) (display "</div>")) 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))))) - |