diff options
-rw-r--r-- | data/irregular-verbs.xml | 1 | ||||
-rw-r--r-- | scm/verbop.scm | 32 | ||||
-rw-r--r-- | src/cgi-bin/conj.scm4 | 3 | ||||
-rw-r--r-- | src/ellinika/conjugator.scm | 73 | ||||
-rw-r--r-- | src/ellinika/sql.scm | 2 |
5 files changed, 72 insertions, 39 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 @@ -466,2 +466,3 @@ <root theme="aor">ειπώθ</root> + <root theme="aor">λεχθ</root> <ind> diff --git a/scm/verbop.scm b/scm/verbop.scm index 0fff38f..8308d70 100644 --- a/scm/verbop.scm +++ b/scm/verbop.scm @@ -132,6 +132,14 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@" (define (conjugation-set key val) - (set! conjugation - (if conjugation - (append conjugation (list (cons key val))) - (list (cons 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 elt)) + (list elt))))) @@ -224,10 +232,12 @@ VALUES (~Q,~Q,~Q,~Q,~Q)" (if (eq? (car mood) #:root) - (let ((val (cdr mood))) - (ellinika:sql-query - "INSERT INTO irregular_root (verb,voice,thema,root) \ + (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))) + (verb-get #:verb) + vstr + (car val) + (cdr val))) + (cdr mood)) (let ((mood-str (car mood))) 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 @@ -330,2 +330,4 @@ ifelse(IFACE,[CGI],(cgi:init)) (search-failure key)) + ((= (length result) 1) + (show-conjugation (caar result))) (else @@ -409,2 +411,3 @@ ifelse(IFACE,[CGI],(cgi:init)) (lambda () + (format #t "<!-- ~A -->" (environ)) (dict-connect) 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 @@ -49,3 +49,6 @@ (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 @@ -103,17 +106,29 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" verb voice mood tense))) - (create-basic-verb-info verb - (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))))) - + (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))) + (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)))))))) @@ -194,3 +209,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" (verb-set! vinfo #:attested 'root) - (caar result)) + (map car result)) ((string=? (verb-get vinfo #:conj) "A") @@ -359,6 +374,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" -(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))) @@ -554,9 +568,14 @@ AND i.tense=\"~A\" AND i.ident=f.ident" ; (format #t "VINFO ~A~%" vinfo) - (cons - (cons - (append (apply-flect conj vinfo verb) - (list (verb-get vinfo #:conj) - (verb-get vinfo #:attested))) - (conj-info #:fold conj)) - prev))))) + + (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 #:root)))))) '() 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 @@ -46,3 +46,3 @@ ((number? arg) (number->string arg)) - ((bool? arg) (if arg "true" "false")) + ((boolean? arg) (if arg "true" "false")) (else |