aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-20 17:06:59 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-20 17:06:59 +0300
commitb6bbb4f2cf0144aa58701cd2b46277838743a277 (patch)
tree1e9bcd3bd7871f2d38ee804b8d803f85317c788b
parent554d5663361e1506a757e7639524ce4d461d043c (diff)
downloadellinika-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.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
@@ -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) \
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)))
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

Return to:

Send suggestions and report system problems to the System administrator.