diff options
-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 | |||
@@ -464,6 +464,7 @@ | |||
464 | </act> | 464 | </act> |
465 | <pas> | 465 | <pas> |
466 | <root theme="aor">ειπώθ</root> | 466 | <root theme="aor">ειπώθ</root> |
467 | <root theme="aor">λεχθ</root> | ||
467 | <ind> | 468 | <ind> |
468 | <t name="Ενεστώτας"> | 469 | <t name="Ενεστώτας"> |
469 | <prop name="root">λέγ</prop> | 470 | <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 | |||
@@ -130,10 +130,18 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@" | |||
130 | ret)) | 130 | ret)) |
131 | 131 | ||
132 | (define (conjugation-set key val) | 132 | (define (conjugation-set key val) |
133 | (let ((elt (cond | ||
134 | ((not (eq? key #:root)) | ||
135 | (cons key val)) | ||
136 | ((and conjugation (assoc (car val) conjugation)) => | ||
137 | (lambda (entry) | ||
138 | (set-cdr! entry (cons (cdr val) (cdr entry))))) | ||
139 | (else | ||
140 | (cons key (list val)))))) | ||
133 | (set! conjugation | 141 | (set! conjugation |
134 | (if conjugation | 142 | (if conjugation |
135 | (append conjugation (list (cons key val))) | 143 | (append conjugation (list elt)) |
136 | (list (cons key val))))) | 144 | (list elt))))) |
137 | 145 | ||
138 | 146 | ||
139 | ;;; Verb structure: | 147 | ;;; Verb structure: |
@@ -222,7 +230,8 @@ VALUES (~Q,~Q,~Q,~Q,~Q)" | |||
222 | 230 | ||
223 | (define (flush-mood mood vstr) | 231 | (define (flush-mood mood vstr) |
224 | (if (eq? (car mood) #:root) | 232 | (if (eq? (car mood) #:root) |
225 | (let ((val (cdr mood))) | 233 | (for-each |
234 | (lambda (val) | ||
226 | (ellinika:sql-query | 235 | (ellinika:sql-query |
227 | "INSERT INTO irregular_root (verb,voice,thema,root) \ | 236 | "INSERT INTO irregular_root (verb,voice,thema,root) \ |
228 | VALUES (~Q,~Q,~Q,~Q)" | 237 | VALUES (~Q,~Q,~Q,~Q)" |
@@ -230,6 +239,7 @@ VALUES (~Q,~Q,~Q,~Q)" | |||
230 | vstr | 239 | vstr |
231 | (car val) | 240 | (car val) |
232 | (cdr val))) | 241 | (cdr val))) |
242 | (cdr mood)) | ||
233 | (let ((mood-str (car mood))) | 243 | (let ((mood-str (car mood))) |
234 | (let ((lst (cdr mood))) | 244 | (let ((lst (cdr mood))) |
235 | (cond | 245 | (cond |
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 | |||
@@ -328,6 +328,8 @@ ifelse(IFACE,[CGI],(cgi:init)) | |||
328 | (cond | 328 | (cond |
329 | ((null? result) | 329 | ((null? result) |
330 | (search-failure key)) | 330 | (search-failure key)) |
331 | ((= (length result) 1) | ||
332 | (show-conjugation (caar result))) | ||
331 | (else | 333 | (else |
332 | (format #t | 334 | (format #t |
333 | "<div class=\"error\"><p>~A</p></div>" | 335 | "<div class=\"error\"><p>~A</p></div>" |
@@ -407,6 +409,7 @@ ifelse(IFACE,[CGI],(cgi:init)) | |||
407 | (cgi:names)))) | 409 | (cgi:names)))) |
408 | (cons "@@conj@@" | 410 | (cons "@@conj@@" |
409 | (lambda () | 411 | (lambda () |
412 | (format #t "<!-- ~A -->" (environ)) | ||
410 | (dict-connect) | 413 | (dict-connect) |
411 | (main-form) | 414 | (main-form) |
412 | (do-conj) | 415 | (do-conj) |
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 | |||
@@ -47,7 +47,10 @@ | |||
47 | ((#:attested) | 47 | ((#:attested) |
48 | (list-set! verb 3 (append (list-ref verb 3) (list value)))) | 48 | (list-set! verb 3 (append (list-ref verb 3) (list value)))) |
49 | (else | 49 | (else |
50 | (let ((container (assoc key (list-ref verb 2)))) | 50 | (let ((container (assoc key (list-ref verb 2))) |
51 | (value (if (and (eq? key #:root) (not (list? value))) | ||
52 | (list value) | ||
53 | value))) | ||
51 | (if container | 54 | (if container |
52 | (set-cdr! container value) | 55 | (set-cdr! container value) |
53 | (list-set! verb 2 (append (list-ref verb 2) | 56 | (list-set! verb 2 (append (list-ref verb 2) |
@@ -101,8 +104,9 @@ | |||
101 | "SELECT property,value FROM verbtense WHERE \ | 104 | "SELECT property,value FROM verbtense WHERE \ |
102 | verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | 105 | verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" |
103 | verb voice mood tense))) | 106 | verb voice mood tense))) |
104 | (create-basic-verb-info verb | 107 | (create-basic-verb-info |
105 | (if (null? verbprop) | 108 | verb |
109 | (let loop ((inlist (if (null? verbprop) | ||
106 | '() | 110 | '() |
107 | (map | 111 | (map |
108 | (lambda (elt) | 112 | (lambda (elt) |
@@ -114,8 +118,19 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | |||
114 | (cons (symbol->keyword | 118 | (cons (symbol->keyword |
115 | (string->symbol name)) | 119 | (string->symbol name)) |
116 | value)))) | 120 | value)))) |
117 | verbprop))))) | 121 | verbprop))) |
118 | 122 | (rootlist '()) | |
123 | (outlist '())) | ||
124 | ; (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist) | ||
125 | (cond | ||
126 | ((null? inlist) | ||
127 | (if (null? rootlist) | ||
128 | outlist | ||
129 | (cons (cons #:root rootlist) outlist))) | ||
130 | ((eq? (caar inlist) #:root) | ||
131 | (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist)) | ||
132 | (else | ||
133 | (loop (cdr inlist) rootlist (cons (car inlist) outlist)))))))) | ||
119 | 134 | ||
120 | (define (thema-aoristoy-mesapathitikis-A root) | 135 | (define (thema-aoristoy-mesapathitikis-A root) |
121 | (cond | 136 | (cond |
@@ -192,7 +207,7 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
192 | (cond | 207 | (cond |
193 | ((not (null? result)) | 208 | ((not (null? result)) |
194 | (verb-set! vinfo #:attested 'root) | 209 | (verb-set! vinfo #:attested 'root) |
195 | (caar result)) | 210 | (map car result)) |
196 | ((string=? (verb-get vinfo #:conj) "A") | 211 | ((string=? (verb-get vinfo #:conj) "A") |
197 | (let ((root (verb-A-root elverb))) | 212 | (let ((root (verb-A-root elverb))) |
198 | (cond | 213 | (cond |
@@ -357,10 +372,9 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
357 | (conj-info #:accmap conj) | 372 | (conj-info #:accmap conj) |
358 | "000000")))) | 373 | "000000")))) |
359 | 374 | ||
360 | (define (apply-flect conj vinfo verb) | 375 | (define (apply-flect conj vinfo verb root) |
361 | ; (format #t "VINFO ~A~%" vinfo) | 376 | ; (format #t "VINFO ~A~%" vinfo) |
362 | (let ((root (verb-get vinfo #:root)) | 377 | (let ((suffix (get-suffix conj vinfo)) |
363 | (suffix (get-suffix conj vinfo)) | ||
364 | (accmap (string->list (get-accmap conj vinfo))) | 378 | (accmap (string->list (get-accmap conj vinfo))) |
365 | (augment "")) | 379 | (augment "")) |
366 | ; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix) | 380 | ; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix) |
@@ -552,13 +566,18 @@ AND i.tense=\"~A\" AND i.ident=f.ident" | |||
552 | (car (cdr thema))) | 566 | (car (cdr thema))) |
553 | (car thema)))) | 567 | (car thema)))) |
554 | ; (format #t "VINFO ~A~%" vinfo) | 568 | ; (format #t "VINFO ~A~%" vinfo) |
569 | |||
570 | (fold | ||
571 | (lambda (stem prev) | ||
555 | (cons | 572 | (cons |
556 | (cons | 573 | (cons |
557 | (append (apply-flect conj vinfo verb) | 574 | (append (apply-flect conj vinfo verb stem) |
558 | (list (verb-get vinfo #:conj) | 575 | (list (verb-get vinfo #:conj) |
559 | (verb-get vinfo #:attested))) | 576 | (verb-get vinfo #:attested))) |
560 | (conj-info #:fold conj)) | 577 | (conj-info #:fold conj)) |
561 | prev))))) | 578 | prev)) |
579 | prev | ||
580 | (verb-get vinfo #:root)))))) | ||
562 | '() | 581 | '() |
563 | conj-list)))))))) | 582 | conj-list)))))))) |
564 | 583 | ||
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 | |||
@@ -44,7 +44,7 @@ | |||
44 | ((string? arg) arg) | 44 | ((string? arg) arg) |
45 | ((elstr? arg) (elstr->string arg)) | 45 | ((elstr? arg) (elstr->string arg)) |
46 | ((number? arg) (number->string arg)) | 46 | ((number? arg) (number->string arg)) |
47 | ((bool? arg) (if arg "true" "false")) | 47 | ((boolean? arg) (if arg "true" "false")) |
48 | (else | 48 | (else |
49 | (error "Unhandled argument type: ~S" arg)))) | 49 | (error "Unhandled argument type: ~S" arg)))) |
50 | 50 | ||