diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-20 17:06:59 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-20 17:06:59 +0300 |
commit | b6bbb4f2cf0144aa58701cd2b46277838743a277 (patch) | |
tree | 1e9bcd3bd7871f2d38ee804b8d803f85317c788b | |
parent | 554d5663361e1506a757e7639524ce4d461d043c (diff) | |
download | ellinika-b6bbb4f2cf0144aa58701cd2b46277838743a277.tar.gz ellinika-b6bbb4f2cf0144aa58701cd2b46277838743a277.tar.bz2 |
Allow for alternative stems in a same tense.
* data/irregular-verbs.xml: Add alternative passive aorist stem
for "lev".
* scm/verbop.scm (conjugation-set): When setting #:root,
keep a list of alternative stems.
(flush-mood): Update for changes in #:root storage.
* src/cgi-bin/conj.scm4 (show-best-matches): If only one
match is produced, show it immediately.
* src/ellinika/conjugator.scm: Allow for multiple stems.
* src/ellinika/sql.scm (->string): Bugfix.
-rw-r--r-- | data/irregular-verbs.xml | 1 | ||||
-rw-r--r-- | scm/verbop.scm | 16 | ||||
-rw-r--r-- | src/cgi-bin/conj.scm4 | 3 | ||||
-rw-r--r-- | src/ellinika/conjugator.scm | 41 | ||||
-rw-r--r-- | src/ellinika/sql.scm | 2 |
5 files changed, 48 insertions, 15 deletions
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml index 2e604e3..1923d88 100644 --- a/data/irregular-verbs.xml +++ b/data/irregular-verbs.xml @@ -461,12 +461,13 @@ <p n="p" p="2">πείτε,πέστε</p> </t> </imp> </act> <pas> <root theme="aor">ειπώθ</root> + <root theme="aor">λεχθ</root> <ind> <t name="Ενεστώτας"> <prop name="root">λέγ</prop> </t> <t name="Παρατατικός"> <prop name="root">λέγ</prop> diff --git a/scm/verbop.scm b/scm/verbop.scm index 0fff38f..8308d70 100644 --- a/scm/verbop.scm +++ b/scm/verbop.scm @@ -127,16 +127,24 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@" (define (get-conjugation) (let ((ret conjugation)) (set! conjugation #f) ret)) (define (conjugation-set key val) + (let ((elt (cond + ((not (eq? key #:root)) + (cons key val)) + ((and conjugation (assoc (car val) conjugation)) => + (lambda (entry) + (set-cdr! entry (cons (cdr val) (cdr entry))))) + (else + (cons key (list val)))))) (set! conjugation (if conjugation - (append conjugation (list (cons key val))) - (list (cons key val))))) + (append conjugation (list elt)) + (list elt))))) ;;; Verb structure: (define verbdef '()) (define (verbdef:index c) @@ -219,20 +227,22 @@ VALUES (~Q,~Q,~Q,~Q,~Q)" mood tense ident)) (define (flush-mood mood vstr) (if (eq? (car mood) #:root) - (let ((val (cdr mood))) + (for-each + (lambda (val) (ellinika:sql-query "INSERT INTO irregular_root (verb,voice,thema,root) \ VALUES (~Q,~Q,~Q,~Q)" (verb-get #:verb) vstr (car val) (cdr val))) + (cdr mood)) (let ((mood-str (car mood))) (let ((lst (cdr mood))) (cond ((null? lst) (for-each (lambda (tense) diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4 index fec7eca..8c5e317 100644 --- a/src/cgi-bin/conj.scm4 +++ b/src/cgi-bin/conj.scm4 @@ -325,12 +325,14 @@ ifelse(IFACE,[CGI],(cgi:init)) WHERE sound LIKE ~Q\ AND (pos & 1048576) <> 0 ORDER BY 1" (ellinika:sounds-like key)))) (cond ((null? result) (search-failure key)) + ((= (length result) 1) + (show-conjugation (caar result))) (else (format #t "<div class=\"error\"><p>~A</p></div>" (_ "Στην λέξη εισαγωγής δεν υπάρχει τόνος. Μήπος θέλατε να κλίσετε ένα απ'αυτά τα ρήματα:")) (display "<table width=\"100%\" class=\"noframe\">") (let* ((result-length (length result)) @@ -404,12 +406,13 @@ ifelse(IFACE,[CGI],(cgi:init)) (display name) (display "=") (display v))))))) (cgi:names)))) (cons "@@conj@@" (lambda () + (format #t "<!-- ~A -->" (environ)) (dict-connect) (main-form) (do-conj) (if (not (null? unattested)) (footnotes))))))) diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index 0abec8d..f70e20c 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm @@ -44,13 +44,16 @@ (list-set! verb 0 value)) ((#:verb) (list-set! verb 1 value)) ((#:attested) (list-set! verb 3 (append (list-ref verb 3) (list value)))) (else - (let ((container (assoc key (list-ref verb 2)))) + (let ((container (assoc key (list-ref verb 2))) + (value (if (and (eq? key #:root) (not (list? value))) + (list value) + value))) (if container (set-cdr! container value) (list-set! verb 2 (append (list-ref verb 2) (list (cons key value))))))))) @@ -98,27 +101,39 @@ (define (load-verb-info verb voice mood tense) ; (format #t "LOAD ~A~%" verb) (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 - (if (null? verbprop) + (create-basic-verb-info + verb + (let loop ((inlist (if (null? verbprop) '() (map (lambda (elt) (let ((name (car elt)) (value (cadr elt))) (if (string=? name "override") (cons #:override (string-split value #\,)) (cons (symbol->keyword (string->symbol name)) value)))) - verbprop))))) - + verbprop))) + (rootlist '()) + (outlist '())) +; (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist) + (cond + ((null? inlist) + (if (null? rootlist) + outlist + (cons (cons #:root rootlist) outlist))) + ((eq? (caar inlist) #:root) + (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist)) + (else + (loop (cdr inlist) rootlist (cons (car inlist) outlist)))))))) (define (thema-aoristoy-mesapathitikis-A root) (cond ((elstr-suffix? root "αίν") (elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ ((and @@ -189,13 +204,13 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" (lookup-verb-info verb voice "aor") tmpres)))) (verb-set! vinfo #:root (cond ((not (null? result)) (verb-set! vinfo #:attested 'root) - (caar result)) + (map car result)) ((string=? (verb-get vinfo #:conj) "A") (let ((root (verb-A-root elverb))) (cond ((string=? thema "pres") (verb-set! vinfo #:attested 'root) root) @@ -354,16 +369,15 @@ 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) +(define (apply-flect conj vinfo verb root) ; (format #t "VINFO ~A~%" vinfo) - (let ((root (verb-get vinfo #:root)) - (suffix (get-suffix conj vinfo)) + (let ((suffix (get-suffix conj vinfo)) (accmap (string->list (get-accmap conj vinfo))) (augment "")) ; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix) (cond ((> (length accmap) 6) (set! accmap (list-head accmap 6)) @@ -549,19 +563,24 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (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) + (append (apply-flect conj vinfo verb stem) (list (verb-get vinfo #:conj) (verb-get vinfo #:attested))) (conj-info #:fold conj)) - prev))))) + prev)) + prev + (verb-get vinfo #:root)))))) '() conj-list)))))))) (define-public (conjugator verb voice mood tense) (conjugate verb voice mood tense)) diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm index 5867d28..f281847 100644 --- a/src/ellinika/sql.scm +++ b/src/ellinika/sql.scm @@ -41,13 +41,13 @@ (define (->string arg) (cond ((string? arg) arg) ((elstr? arg) (elstr->string arg)) ((number? arg) (number->string arg)) - ((bool? arg) (if arg "true" "false")) + ((boolean? arg) (if arg "true" "false")) (else (error "Unhandled argument type: ~S" arg)))) ;; Format specifiers: ;; ~A - escaped string |