aboutsummaryrefslogtreecommitdiff
path: root/src
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 /src
parent246974441fb5dc155260c273c61757cbc90469a8 (diff)
downloadellinika-a9fa703eecfc81b26c1d969cc13a7ce476c84d6d.tar.gz
ellinika-a9fa703eecfc81b26c1d969cc13a7ce476c84d6d.tar.bz2
Convert src/ellinika/conjugator.scm to module.
Diffstat (limited to 'src')
-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 @@
+;;;; Modern Greek Verb Conjugator.
+;;;; This file is part of Ellinika project.
+;;;; Copyright (C) 2011 Sergey Poznyakoff
+;;;;
+;;;; Ellinika is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; Ellinika is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (ellinika conjugator))
+
(use-modules (srfi srfi-1)
(ellinika elmorph)
(ellinika i18n)
- (ellinika cgi)
(ellinika tenses)
- (xmltools dict)
(gamma sql))
(use-syntax (ice-9 syncase))
-; FIXME:
-(ellinika-cgi-init dict-template-file-name)
-
-(define (mk-dict-connect)
- (let ((db-connection #f))
- (lambda (. rest)
- (cond
- ((null? rest)
- (if (not db-connection)
- (begin
- (set! db-connection
- (sql-open-connection
- ellinika-sql-connection))
- (sql-query db-connection "SET NAMES utf8")
- )))
- (else
- (if db-connection
- (sql-close-connection db-connection))
- (set! db-connection #f)))
- db-connection)))
-
-(define dict-connect (mk-dict-connect))
-
-(define (q-my-sql-query conn query)
- (catch #t
- (lambda ()
- (sql-query conn query))
- (lambda args
- '())))
-
(define (my-sql-query conn query)
; (format #t "Q: ~A~%" query)
(let ((res (sql-query conn query)))
; (format #t "R: ~A~%" res)
res))
-
-(define (sql-error-handler key func fmt fmtargs data)
- (format #t "<h1 class=\"error\">~A</h1>\n"
- (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
- (apply format (current-error-port) fmt fmtargs))
-
(define verb-info-template
(list
(list "A"
@@ -82,9 +63,8 @@
(else
(assoc "A" verb-info-template))))
-(define (get-verb-info verb . rest)
- (let ((conn (dict-connect))
- (class (if (null? rest)
+(define (get-verb-info conn verb . rest)
+ (let ((class (if (null? rest)
""
(string-append " AND conj='" (car rest) "'"))))
(let ((vdb (my-sql-query
@@ -104,7 +84,7 @@ WHERE verb='" (force-string verb) "'"
#f
'(class))))
((elstr-suffix? verb "άω")
- (get-verb-info (elstr-append
+ (get-verb-info conn (elstr-append
(elstr-trim verb -2) "ώ") "B1"))
((null? rest)
(guess-verb-info verb))
@@ -141,9 +121,9 @@ WHERE verb='" (force-string verb) "'"
(else
#f)))
-(define (lookup-verb-info verb voice thema)
+(define (lookup-verb-info conn verb voice thema)
(my-sql-query
- (dict-connect)
+ conn
(string-append
"SELECT root FROM irregular_root \
WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
@@ -157,12 +137,12 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(else
(error "cannot handle ~A~%" verb))))
-(define (complement-verb-info vinfo verb voice thema)
+(define (complement-verb-info conn vinfo verb voice thema)
; (format #t "COMPLEMENT ~A~%" thema)
(let ((elverb (string->elstr verb))
- (result (let ((tmpres (lookup-verb-info verb voice thema)))
+ (result (let ((tmpres (lookup-verb-info conn verb voice thema)))
(if (and (null? tmpres) (string=? thema "sub"))
- (lookup-verb-info verb voice "aor")
+ (lookup-verb-info conn verb voice "aor")
tmpres))))
(verb-info-set! #:root vinfo
(cond
@@ -286,19 +266,18 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
((conj-info-set! #:particle v val)
(list-set! v 3 val))))
-(define (get-conj-info conj voice mood tense)
- (let ((conn (dict-connect)))
- (let ((answer (my-sql-query
- conn
- (string-append
+(define (get-conj-info conn conj voice mood tense)
+ (let ((answer (my-sql-query
+ conn
+ (string-append
"SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,c.fold AS fold,\
f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
FROM conjugation c, verbflect f \
WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
"' AND c.tense='" tense "' AND c.flect = f.ident ORDER by fold"))))
- (if (null? answer)
- #f
- answer))))
+ (if (null? answer)
+ #f
+ answer)))
(define (force-string str)
(if (elstr? str)
@@ -392,9 +371,9 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
forms)
(map force-string forms)))))
-(define (individual-verb verb voice mood tense)
+(define (individual-verb conn verb voice mood tense)
(let ((res (my-sql-query
- (dict-connect)
+ conn
(string-append
"SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
FROM individual_verb i,verbflect f \
@@ -412,16 +391,17 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(or a b))
lista listb))
-(define (conjugate verb voice mood tense . rest)
+(define (conjugate conn verb voice mood tense . rest)
(cond
- ((individual-verb verb voice mood tense) =>
+ ((individual-verb conn verb voice mood tense) =>
(lambda (res)
(list res)))
(else
(map car
- (let* ((vinfo (get-verb-info verb))
- (conj-list (get-conj-info (verb-info #:conj vinfo) voice mood
- tense)))
+ (let* ((vinfo (get-verb-info conn verb))
+ (conj-list (get-conj-info conn
+ (verb-info #:conj vinfo)
+ voice mood tense)))
(if (not conj-list)
(error "cannot obtain conjugation information for "
(verb-info #:conj vinfo) voice mood tense))
@@ -449,7 +429,8 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(cond
((string=? (conj-info #:thema conj) "synt")
(let* ((verb-conj
- (car (conjugate verb voice "sub" "Αόριστος" #:nopart)))
+ (car (conjugate conn verb voice "sub" "Αόριστος"
+ #:nopart)))
(form (list-ref verb-conj 2))
(part (conj-info #:particle conj)))
(cond
@@ -465,7 +446,8 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(elstr-append part " " aux " " form)
(elstr-append aux " " form)))))
(conjugation:table
- (car (conjugate (conj-info #:aux conj) "act" "ind"
+ (car (conjugate conn
+ (conj-info #:aux conj) "act" "ind"
(conj-info #:auxtense conj))))
(string->list (or (verb-info #:accmap vinfo)
(conj-info #:accmap conj)
@@ -477,7 +459,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(else
(let ((thema (string-split (conj-info #:thema conj) #\:)))
; (format #t "THEMA ~A~%" thema)
- (complement-verb-info vinfo verb
+ (complement-verb-info conn vinfo verb
(if (null? (cdr thema))
voice
(car (cdr thema)))
@@ -488,8 +470,11 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(verb-info #:attested vinfo))))))
(conj-info #:fold conj)))
conj-list)))))))
-
-(define (conjugation:table conj)
+
+(define-public (conjugator conn verb voice mood tense)
+ (conjugate conn verb voice mood tense))
+
+(define-public (conjugation:table conj)
(cond
((not conj)
#f)
@@ -497,20 +482,20 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(list-head conj 6))))
-(define (conjugation:class conj)
+(define-public (conjugation:class conj)
(cond
((not conj)
#f)
(else
(list-ref conj 6))))
-(define (conjugation:attested conj)
+(define-public (conjugation:attested conj)
(cond
((not conj)
#f)
(else (list-ref conj 7))))
-(define (empty-conjugation? conj)
+(define-public (empty-conjugation? conj)
(or
(not conj)
(call-with-current-continuation
@@ -522,136 +507,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
conj)
(return #t)))))
-;;
-;(display (verb-info "βρίσκω"))
-;(newline)
-;(display (verb-info "ανοίγω"))
-;(newline)
-
-(define transtab
- '(("act" . "Ενεργητηκή φωνή")
- ("pas" . "Μεσοπαθητική φωνή")
- ("ind" . "Οριστική")
- ("sub" . "Υποτακτική")
- ("imp" . "Προστακτική")))
-
-(define (term x)
- (or (assoc-ref transtab x) x))
-
-(define (test-conjugation verb voice mood tense)
- (for-each
- (lambda (result)
- (format #t "~A ~A/~A/~A: " verb (term voice) (term mood) tense)
- (let ((conj (conjugation:table result)))
- (cond
- ((empty-conjugation? conj)
- (display "#f"))
- (else
- (let ((att (conjugation:attested result)))
- (cond
- ((not att)
- (display "*"))
- (else
- (if (not (member 'class att))
- (display "*"))
- (if (not (member 'root att))
- (display "!"))))
- (display conj)))))
- (newline))
- (conjugate verb voice mood tense))
- (gc))
-
-(define (test-voice voice verb)
- (for-each
- (lambda (mood-tenses)
- (let ((mood (car mood-tenses)))
- (for-each
- (lambda (tense)
- (test-conjugation verb voice mood tense))
- (cdr mood-tenses))))
- ellinika-tense-list))
-
-;(test-conjugation "διαβάζω" "act" "imp" "Αόριστος")
-;; (test-conjugation "είμαι" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "είμαι" "act" "ind" "Παρατατίκος")
-;; (test-conjugation "είμαι" "act" "ind" "Μέλλοντας διαρκείας")
-;; (test-conjugation "είμαι" "act" "sub" "Ενεστώτας")
-;; (test-conjugation "είμαι" "act" "imp" "Ενεστώτας")
-;; (test-conjugation "είμαι" "act" "ind" "Αόριστος")
-
-;; (test-conjugation "έχω" "act" "ind" "Ενεστώτας")
-(test-conjugation "έχω" "act" "ind" "Παρατατίκος")
-;; (test-conjugation "έχω" "act" "ind" "Μέλλοντας διαρκείας")
-;; (test-conjugation "έχω" "act" "sub" "Ενεστώτας")
-;; (test-conjugation "έχω" "act" "imp" "Ενεστώτας")
-;; (test-conjugation "έχω" "act" "imp" "Αόριστος")
-
-;; (test-conjugation "ανοίγω" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "ανοίγω" "act" "ind" "Αόριστος")
-;; (test-conjugation "ανοίγω" "pas" "ind" "Αόριστος")
-;; (test-conjugation "δένω" "act" "ind" "Αόριστος")
-;; (test-conjugation "θέλω" "act" "ind" "Αόριστος")
-;; (test-conjugation "θέλω" "act" "ind" "Παρατατικός")
-;; (test-conjugation "βρίσκω" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "βρίσκω" "act" "ind" "Αόριστος")
-;; (test-conjugation "βρίσκω" "act" "ind" "Μέλλοντας στιγμιαίος")
-;; (test-conjugation "βρίσκω" "pas" "ind" "Αόριστος")
-;; (test-conjugation "βρίσκω" "act" "sub" "Ενεστώτας")
-;; (test-conjugation "βρίσκω" "act" "sub" "Αόριστος")
-;; (test-conjugation "βρίσκω" "act" "ind" "Παρακείμενος")
-;; (test-conjugation "βρίσκω" "act" "sub" "Παρακείμενος")
-;; (test-conjugation "βρίσκω" "act" "imp" "Αόριστος")
-
-;; (test-conjugation "νικάω" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "νικάω" "act" "ind" "Αόριστος")
-;; (test-conjugation "νικώ" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "νικώ" "act" "ind" "Αόριστος")
-;; (test-conjugation "νικώ" "pas" "ind" "Αόριστος")
-;; (test-conjugation "κρεμάω" "act" "ind" "Αόριστος")
-;; (test-conjugation "κιτάω" "act" "ind" "Αόριστος")
-;; (test-conjugation "τραβάω" "act" "ind" "Αόριστος")
-
-;; (test-conjugation "αγγέλω" "act" "ind" "Αόριστος")
-;; (test-conjugation "αγγέλω" "act" "sub" "Αόριστος")
-;; (test-conjugation "άγω" "act" "ind" "Αόριστος")
-;; (test-conjugation "άγω" "act" "sub" "Αόριστος")
-;; (test-conjugation "ανεβαίνω" "act" "ind" "Αόριστος")
-;; (test-conjugation "ανεβαίνω" "act" "sub" "Αόριστος")
-;; (test-conjugation "απονέμω" "act" "ind" "Αόριστος")
-;; (test-conjugation "απονέμω" "act" "sub" "Αόριστος")
-;; (test-conjugation "αρέσω" "act" "ind" "Αόριστος")
-;; (test-conjugation "αρέσω" "act" "sub" "Αόριστος")
-;; (test-conjugation "βάλλω" "act" "ind" "Αόριστος")
-;; (test-conjugation "βάλλω" "act" "sub" "Αόριστος")
-;; (test-conjugation "βγαίνω" "act" "ind" "Αόριστος")
-;; (test-conjugation "βγαίνω" "act" "sub" "Αόριστος")
-;; (test-conjugation "βλέπω" "act" "ind" "Αόριστος")
-;; (test-conjugation "βλέπω" "act" "sub" "Αόριστος")
-;; (test-conjugation "βλέπω" "act" "imp" "Αόριστος")
-;; (test-conjugation "πηγαίνω" "act" "ind" "Μέλλοντας στιγμιαίος")
-;; (test-conjugation "πίνω" "act" "ind" "Αόριστος")
-;; (test-conjugation "πίνω" "act" "sub" "Αόριστος")
-;; (test-conjugation "πίνω" "act" "imp" "Αόριστος")
-
-;(test-conjugation "έρχομαι" "pas" "ind" "Παρατατικός")
-;(test-conjugation "έρχομαι" "pas" "ind" "Αόριστος")
-;(test-conjugation "έρχομαι" "pas" "sub" "Αόριστος")
-;; (test-conjugation "έρχομαι" "pas" "ind" "Συντελεσμένος Μέλλοντας")
-;; (test-conjugation "έρχομαι" "act" "sub" "Αόριστος" )
-;; (test-conjugation "έρχομαι" "pas" "sub" "Αόριστος" )
-;; (test-conjugation "έρχομαι" "pas" "ind" "Ενεστώτας");FIXME!
-;; (test-conjugation "έρχομαι" "pas" "ind" "Υπερσυντέλικος")
-
-;(test-voice "pas" "ντύνω")
-(test-voice "pas" "έρχομαι")
-
-;(display (conjugate "ντύνω" "pas" "ind" "Ενεστώτας"))
-;(newline)
-;(display (conjugate "ντύνω" "pas" "imp" "Αόριστος"))
-;(newline)
-;(display (conjugate "ντύνω" "pas" "ind" "Συντελεσμένος Μέλλοντας"))
-;(newline)
-;(display (conjugate "τραβάω" "act" "ind" "Παρατατικός"))
-;(newline)
-
-(newline)

Return to:

Send suggestions and report system problems to the System administrator.