aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--data/irregular-verbs.xml1
-rw-r--r--scm/verbop.scm32
-rw-r--r--src/cgi-bin/conj.scm43
-rw-r--r--src/ellinika/conjugator.scm73
-rw-r--r--src/ellinika/sql.scm2
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
@@ -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 (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
138 146
139;;; Verb structure: 147;;; Verb structure:
@@ -222,14 +230,16 @@ 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
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) \
228VALUES (~Q,~Q,~Q,~Q)" 237VALUES (~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)))
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,21 +104,33 @@
101 "SELECT property,value FROM verbtense WHERE \ 104 "SELECT property,value FROM verbtense WHERE \
102verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" 105verb=\"~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
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)
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 '()
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

Return to:

Send suggestions and report system problems to the System administrator.