aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-12 03:29:59 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-12 03:29:59 +0300
commita9fa703eecfc81b26c1d969cc13a7ce476c84d6d (patch)
treebf0ff5fc9740378b37c23df3ad1fa369c4a9e787
parent246974441fb5dc155260c273c61757cbc90469a8 (diff)
downloadellinika-a9fa703eecfc81b26c1d969cc13a7ce476c84d6d.tar.gz
ellinika-a9fa703eecfc81b26c1d969cc13a7ce476c84d6d.tar.bz2
Convert src/ellinika/conjugator.scm to module.
-rw-r--r--src/ellinika/conjugator.scm258
1 files changed, 55 insertions, 203 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index edc649e..c8fd012 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -1,55 +1,36 @@
1;;;; Modern Greek Verb Conjugator.
2;;;; This file is part of Ellinika project.
3;;;; Copyright (C) 2011 Sergey Poznyakoff
4;;;;
5;;;; Ellinika is free software; you can redistribute it and/or modify
6;;;; it under the terms of the GNU General Public License as published by
7;;;; the Free Software Foundation; either version 3 of the License, or
8;;;; (at your option) any later version.
9;;;;
10;;;; Ellinika is distributed in the hope that it will be useful,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13;;;; GNU General Public License for more details.
14;;;;
15;;;; You should have received a copy of the GNU General Public License
16;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
17
18(define-module (ellinika conjugator))
19
1(use-modules (srfi srfi-1) 20(use-modules (srfi srfi-1)
2 (ellinika elmorph) 21 (ellinika elmorph)
3 (ellinika i18n) 22 (ellinika i18n)
4 (ellinika cgi)
5 (ellinika tenses) 23 (ellinika tenses)
6 (xmltools dict)
7 (gamma sql)) 24 (gamma sql))
8 25
9(use-syntax (ice-9 syncase)) 26(use-syntax (ice-9 syncase))
10 27
11; FIXME:
12(ellinika-cgi-init dict-template-file-name)
13
14(define (mk-dict-connect)
15 (let ((db-connection #f))
16 (lambda (. rest)
17 (cond
18 ((null? rest)
19 (if (not db-connection)
20 (begin
21 (set! db-connection
22 (sql-open-connection
23 ellinika-sql-connection))
24 (sql-query db-connection "SET NAMES utf8")
25 )))
26 (else
27 (if db-connection
28 (sql-close-connection db-connection))
29 (set! db-connection #f)))
30 db-connection)))
31
32(define dict-connect (mk-dict-connect))
33
34(define (q-my-sql-query conn query)
35 (catch #t
36 (lambda ()
37 (sql-query conn query))
38 (lambda args
39 '())))
40
41(define (my-sql-query conn query) 28(define (my-sql-query conn query)
42; (format #t "Q: ~A~%" query) 29; (format #t "Q: ~A~%" query)
43 (let ((res (sql-query conn query))) 30 (let ((res (sql-query conn query)))
44; (format #t "R: ~A~%" res) 31; (format #t "R: ~A~%" res)
45 res)) 32 res))
46 33
47
48(define (sql-error-handler key func fmt fmtargs data)
49 (format #t "<h1 class=\"error\">~A</h1>\n"
50 (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
51 (apply format (current-error-port) fmt fmtargs))
52
53(define verb-info-template 34(define verb-info-template
54 (list 35 (list
55 (list "A" 36 (list "A"
@@ -82,9 +63,8 @@
82 (else 63 (else
83 (assoc "A" verb-info-template)))) 64 (assoc "A" verb-info-template))))
84 65
85(define (get-verb-info verb . rest) 66(define (get-verb-info conn verb . rest)
86 (let ((conn (dict-connect)) 67 (let ((class (if (null? rest)
87 (class (if (null? rest)
88 "" 68 ""
89 (string-append " AND conj='" (car rest) "'")))) 69 (string-append " AND conj='" (car rest) "'"))))
90 (let ((vdb (my-sql-query 70 (let ((vdb (my-sql-query
@@ -104,7 +84,7 @@ WHERE verb='" (force-string verb) "'"
104 #f 84 #f
105 '(class)))) 85 '(class))))
106 ((elstr-suffix? verb "άω") 86 ((elstr-suffix? verb "άω")
107 (get-verb-info (elstr-append 87 (get-verb-info conn (elstr-append
108 (elstr-trim verb -2) "ώ") "B1")) 88 (elstr-trim verb -2) "ώ") "B1"))
109 ((null? rest) 89 ((null? rest)
110 (guess-verb-info verb)) 90 (guess-verb-info verb))
@@ -141,9 +121,9 @@ WHERE verb='" (force-string verb) "'"
141 (else 121 (else
142 #f))) 122 #f)))
143 123
144(define (lookup-verb-info verb voice thema) 124(define (lookup-verb-info conn verb voice thema)
145 (my-sql-query 125 (my-sql-query
146 (dict-connect) 126 conn
147 (string-append 127 (string-append
148 "SELECT root FROM irregular_root \ 128 "SELECT root FROM irregular_root \
149WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) 129WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
@@ -157,12 +137,12 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
157 (else 137 (else
158 (error "cannot handle ~A~%" verb)))) 138 (error "cannot handle ~A~%" verb))))
159 139
160(define (complement-verb-info vinfo verb voice thema) 140(define (complement-verb-info conn vinfo verb voice thema)
161; (format #t "COMPLEMENT ~A~%" thema) 141; (format #t "COMPLEMENT ~A~%" thema)
162 (let ((elverb (string->elstr verb)) 142 (let ((elverb (string->elstr verb))
163 (result (let ((tmpres (lookup-verb-info verb voice thema))) 143 (result (let ((tmpres (lookup-verb-info conn verb voice thema)))
164 (if (and (null? tmpres) (string=? thema "sub")) 144 (if (and (null? tmpres) (string=? thema "sub"))
165 (lookup-verb-info verb voice "aor") 145 (lookup-verb-info conn verb voice "aor")
166 tmpres)))) 146 tmpres))))
167 (verb-info-set! #:root vinfo 147 (verb-info-set! #:root vinfo
168 (cond 148 (cond
@@ -286,19 +266,18 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
286 ((conj-info-set! #:particle v val) 266 ((conj-info-set! #:particle v val)
287 (list-set! v 3 val)))) 267 (list-set! v 3 val))))
288 268
289(define (get-conj-info conj voice mood tense) 269(define (get-conj-info conn conj voice mood tense)
290 (let ((conn (dict-connect))) 270 (let ((answer (my-sql-query
291 (let ((answer (my-sql-query 271 conn
292 conn 272 (string-append
293 (string-append
294 "SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,c.fold AS fold,\ 273 "SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,c.fold AS fold,\
295f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \ 274f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
296FROM conjugation c, verbflect f \ 275FROM conjugation c, verbflect f \
297WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood 276WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
298"' AND c.tense='" tense "' AND c.flect = f.ident ORDER by fold")))) 277"' AND c.tense='" tense "' AND c.flect = f.ident ORDER by fold"))))
299 (if (null? answer) 278 (if (null? answer)
300 #f 279 #f
301 answer)))) 280 answer)))
302 281
303(define (force-string str) 282(define (force-string str)
304 (if (elstr? str) 283 (if (elstr? str)
@@ -392,9 +371,9 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
392 forms) 371 forms)
393 (map force-string forms))))) 372 (map force-string forms)))))
394 373
395(define (individual-verb verb voice mood tense) 374(define (individual-verb conn verb voice mood tense)
396 (let ((res (my-sql-query 375 (let ((res (my-sql-query
397 (dict-connect) 376 conn
398 (string-append 377 (string-append
399 "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \ 378 "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
400FROM individual_verb i,verbflect f \ 379FROM individual_verb i,verbflect f \
@@ -412,16 +391,17 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
412 (or a b)) 391 (or a b))
413 lista listb)) 392 lista listb))
414 393
415(define (conjugate verb voice mood tense . rest) 394(define (conjugate conn verb voice mood tense . rest)
416 (cond 395 (cond
417 ((individual-verb verb voice mood tense) => 396 ((individual-verb conn verb voice mood tense) =>
418 (lambda (res) 397 (lambda (res)
419 (list res))) 398 (list res)))
420 (else 399 (else
421 (map car 400 (map car
422 (let* ((vinfo (get-verb-info verb)) 401 (let* ((vinfo (get-verb-info conn verb))
423 (conj-list (get-conj-info (verb-info #:conj vinfo) voice mood 402 (conj-list (get-conj-info conn
424 tense))) 403 (verb-info #:conj vinfo)
404 voice mood tense)))
425 (if (not conj-list) 405 (if (not conj-list)
426 (error "cannot obtain conjugation information for " 406 (error "cannot obtain conjugation information for "
427 (verb-info #:conj vinfo) voice mood tense)) 407 (verb-info #:conj vinfo) voice mood tense))
@@ -449,7 +429,8 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
449 (cond 429 (cond
450 ((string=? (conj-info #:thema conj) "synt") 430 ((string=? (conj-info #:thema conj) "synt")
451 (let* ((verb-conj 431 (let* ((verb-conj
452 (car (conjugate verb voice "sub" "Αόριστος" #:nopart))) 432 (car (conjugate conn verb voice "sub" "Αόριστος"
433 #:nopart)))
453 (form (list-ref verb-conj 2)) 434 (form (list-ref verb-conj 2))
454 (part (conj-info #:particl