From a9fa703eecfc81b26c1d969cc13a7ce476c84d6d Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Sun, 12 Jun 2011 03:29:59 +0300 Subject: Convert src/ellinika/conjugator.scm to module. --- src/ellinika/conjugator.scm | 258 ++++++++++---------------------------------- 1 file changed, 55 insertions(+), 203 deletions(-) (limited to 'src/ellinika') 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 . + +(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 "

~A

\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) -- cgit v1.2.1