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 @@ | |||
466 | <root theme="aor">ειπώθ</root> | 466 | <root theme="aor">ειπώθ</root> |
467 | <root theme="aor">λεχθ</root> | ||
467 | <ind> | 468 | <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))" "$@" | |||
132 | (define (conjugation-set key val) | 132 | (define (conjugation-set key val) |
133 | (set! conjugation | 133 | (let ((elt (cond |
134 | (if conjugation | 134 | ((not (eq? key #:root)) |
135 | (append conjugation (list (cons key val))) | 135 | (cons key val)) |
136 | (list (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)))))) | ||
141 | (set! conjugation | ||
142 | (if conjugation | ||
143 | (append conjugation (list elt)) | ||
144 | (list elt))))) | ||
137 | 145 | ||
@@ -224,10 +232,12 @@ VALUES (~Q,~Q,~Q,~Q,~Q)" | |||
224 | (if (eq? (car mood) #:root) | 232 | (if (eq? (car mood) #:root) |
225 | (let ((val (cdr mood))) | 233 | (for-each |
226 | (ellinika:sql-query | 234 | (lambda (val) |
227 | "INSERT INTO irregular_root (verb,voice,thema,root) \ | 235 | (ellinika:sql-query |
236 | "INSERT INTO irregular_root (verb,voice,thema,root) \ | ||
228 | VALUES (~Q,~Q,~Q,~Q)" | 237 | VALUES (~Q,~Q,~Q,~Q)" |
229 | (verb-get #:verb) | 238 | (verb-get #:verb) |
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))) |
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)) | |||
330 | (search-failure key)) | 330 | (search-failure key)) |
331 | ((= (length result) 1) | ||
332 | (show-conjugation (caar result))) | ||
331 | (else | 333 | (else |
@@ -409,2 +411,3 @@ ifelse(IFACE,[CGI],(cgi:init)) | |||
409 | (lambda () | 411 | (lambda () |
412 | (format #t "<!-- ~A -->" (environ)) | ||
410 | (dict-connect) | 413 | (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 @@ | |||
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 |
@@ -103,17 +106,29 @@ 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 |
106 | '() | 109 | (let loop ((inlist (if (null? verbprop) |
107 | (map | 110 | '() |
108 | (lambda (elt) | 111 | (map |
109 | (let ((name (car elt)) | 112 | (lambda (elt) |
110 | (value (cadr elt))) | 113 | (let ((name (car elt)) |
111 | (if (string=? name "override") | 114 | (value (cadr elt))) |
112 | (cons #:override | 115 | (if (string=? name "override") |
113 | (string-split value #\,)) | 116 | (cons #:override |
114 | (cons (symbol->keyword | 117 | (string-split value #\,)) |
115 | (string->symbol name)) | 118 | (cons (symbol->keyword |
116 | value)))) | 119 | (string->symbol name)) |
117 | verbprop))))) | 120 | value)))) |
118 | 121 | verbprop))) | |
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 | ||
@@ -194,3 +209,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
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") |
@@ -359,6 +374,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
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))) |
@@ -554,9 +568,14 @@ AND i.tense=\"~A\" AND i.ident=f.ident" | |||
554 | ; (format #t "VINFO ~A~%" vinfo) | 568 | ; (format #t "VINFO ~A~%" vinfo) |
555 | (cons | 569 | |
556 | (cons | 570 | (fold |
557 | (append (apply-flect conj vinfo verb) | 571 | (lambda (stem prev) |
558 | (list (verb-get vinfo #:conj) | 572 | (cons |
559 | (verb-get vinfo #:attested))) | 573 | (cons |
560 | (conj-info #:fold conj)) | 574 | (append (apply-flect conj vinfo verb stem) |
561 | prev))))) | 575 | (list (verb-get vinfo #:conj) |
576 | (verb-get vinfo #:attested))) | ||
577 | (conj-info #:fold conj)) | ||
578 | prev)) | ||
579 | prev | ||
580 | (verb-get vinfo #:root)))))) | ||
562 | '() | 581 | '() |
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 @@ | |||
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 |