aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika/conjugator.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/ellinika/conjugator.scm')
-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,58 +1,39 @@
+;;;; 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"
#f
"ε"
#f
@@ -79,15 +60,14 @@
((elstr-suffix? verb "ώ")
(assoc "B2" verb-info-template))
;; FIXME: deponentia?
(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
conn
(string-append
"SELECT conj,accmap,augment,suffix FROM verb \
@@ -101,13 +81,13 @@ WHERE verb='" (force-string verb) "'"
(list-ref x 1)
(or (list-ref x 2) "ε")
(list-ref x 3)
#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))
(else
(assoc (car rest) verb-info-template))))))
@@ -138,15 +118,15 @@ WHERE verb='" (force-string verb) "'"
((elstr-append root "ιστ")))
((logand (elstr-char-prop-bitmask root -1) elmorph:vowel)
(elstr-append root "θ"))
(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 "'")))
(define (verb-A-root verb)
(cond
@@ -154,18 +134,18 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(elstr-trim verb -1))
((elstr-suffix? verb "ομαι")
(elstr-trim verb -4))
(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
((not (null? result))
(verb-info-set! #:attested vinfo 'root)
(caar result))
@@ -283,25 +263,24 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(define-syntax conj-info-set!
(syntax-rules ()
((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)
(elstr->string str)
str))
@@ -389,15 +368,15 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(if w
(string-append
(conj-info #:particle conj) " " (force-string w))))
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 \
WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
"' AND i.tense = '" tense "' AND i.ident=f.ident"))))
(if (not (null? res))
@@ -409,22 +388,23 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(define (merge-conjugated-forms lista listb)
(map
(lambda (a b)
(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))
(fold-right
(lambda (elt prev)
; (format #t "ELT ~A~%" elt)
@@ -446,13 +426,14 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(if (member #:nopart rest)
(conj-info-set! #:particle conj #f))
(cons
(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
(form
; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME
(append
@@ -462,196 +443,67 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
#f
(elstr->string
(if part
(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)
"000000")))
(list (verb-info #:conj vinfo)
(conjugation:attested verb-conj))))
(else
#f))))
(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)))
(car thema))
; (format #t "VINFO ~A~%" vinfo)
(append (apply-flect conj vinfo verb)
(list (verb-info #:conj vinfo)
(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)
(else
(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
(lambda (return)
(for-each
(lambda (x)
(if x
(return #f)))
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.