diff options
Diffstat (limited to 'src/ellinika')
| -rw-r--r-- | src/ellinika/conjugator.scm | 258 |
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 +1,20 @@ +;;;; 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) @@ -3,5 +22,3 @@ (ellinika i18n) - (ellinika cgi) (ellinika tenses) - (xmltools dict) (gamma sql)) @@ -10,32 +27,2 @@ -; 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) @@ -46,8 +33,2 @@ - -(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 @@ -84,5 +65,4 @@ -(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) "" @@ -106,3 +86,3 @@ WHERE verb='" (force-string verb) "'" ((elstr-suffix? verb "άω") - (get-verb-info (elstr-append + (get-verb-info conn (elstr-append (elstr-trim verb -2) "ώ") "B1")) @@ -143,5 +123,5 @@ WHERE verb='" (force-string verb) "'" -(define (lookup-verb-info verb voice thema) +(define (lookup-verb-info conn verb voice thema) (my-sql-query - (dict-connect) + conn (string-append @@ -159,8 +139,8 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) -(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)))) @@ -288,7 +268,6 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'"))) -(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,\ @@ -298,5 +277,5 @@ 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))) @@ -394,5 +373,5 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood -(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 @@ -414,5 +393,5 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood -(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) @@ -421,5 +400,6 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (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) @@ -451,3 +431,4 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (let* ((verb-conj - (car (conjugate verb voice "sub" "Αόριστος" #:nopart))) + (car (conjugate conn verb voice "sub" "Αόριστος" + #:nopart))) (form (list-ref verb-conj 2)) @@ -467,3 +448,4 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood (conjugation:table - (car (conjugate (conj-info #:aux conj) "act" "ind" + (car (conjugate conn + (conj-info #:aux conj) "act" "ind" (conj-info #:auxtense conj)))) @@ -479,3 +461,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood ; (format #t "THEMA ~A~%" thema) - (complement-verb-info vinfo verb + (complement-verb-info conn vinfo verb (if (null? (cdr thema)) @@ -490,4 +472,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood 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 @@ -499,3 +484,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood -(define (conjugation:class conj) +(define-public (conjugation:class conj) (cond @@ -506,3 +491,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood -(define (conjugation:attested conj) +(define-public (conjugation:attested conj) (cond @@ -512,3 +497,3 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood -(define (empty-conjugation? conj) +(define-public (empty-conjugation? conj) (or @@ -524,134 +509 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood -;; -;(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) |