aboutsummaryrefslogtreecommitdiff
path: root/scm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-12 02:49:37 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-12 02:49:37 +0300
commit5e1fd46a66dec0db5bda84126e782fc6439d377e (patch)
tree82a5ff8a3d239bf4d6c954c36fb556d711689f3b /scm
parent169d0e2887a40e4d845efcaa1e46ec49d02421b7 (diff)
downloadellinika-5e1fd46a66dec0db5bda84126e782fc6439d377e.tar.gz
ellinika-5e1fd46a66dec0db5bda84126e782fc6439d377e.tar.bz2
Update conjugator.
* data/dbverb.struct (conjugation) <fold>: New member. Everything updated. (verb) <suffix_aor_path>: Rename to suffix. * data/irregular-verbs.xml: Update. * scm/conjugator.scm: Rewrite to accept different variants of conjugation.
Diffstat (limited to 'scm')
-rw-r--r--scm/conjugator.scm255
-rw-r--r--scm/verbop.scm2
2 files changed, 161 insertions, 96 deletions
diff --git a/scm/conjugator.scm b/scm/conjugator.scm
index 7783d3a..edc649e 100644
--- a/scm/conjugator.scm
+++ b/scm/conjugator.scm
@@ -1,4 +1,5 @@
-(use-modules (ellinika elmorph)
+(use-modules (srfi srfi-1)
+ (ellinika elmorph)
(ellinika i18n)
(ellinika cgi)
(ellinika tenses)
@@ -38,8 +39,10 @@
'())))
(define (my-sql-query conn query)
-; (display "Q:")(display query)(newline)
- (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)
@@ -47,32 +50,37 @@
(_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
(apply format (current-error-port) fmt fmtargs))
-(define (guess-verb-info verb)
- (let ((elverb (force-elstr verb)))
- (cond
- ;; FIXME
- ((elstr-suffix? elverb "άω")
- (list "B1"
+(define verb-info-template
+ (list
+ (list "A"
+ #f
+ "ε"
+ #f
+ #f
+ #f)
+ (list "B1"
#f
#f
- "ησ"
#f
- #f))
- ((elstr-suffix? elverb "ώ")
- (list "B2"
#f
+ #f)
+ (list "B2"
#f
- "ησ"
#f
- #f))
- ;; FIXME: deponentia?
- (else
- (list "A"
#f
- "ε"
#f
- #f
- #f)))))
+ #f)))
+
+(define (guess-verb-info verb)
+ (cond
+ ;; FIXME
+ ((elstr-suffix? verb "άω")
+ (assoc "B1" verb-info-template))
+ ((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))
@@ -82,7 +90,7 @@
(let ((vdb (my-sql-query
conn
(string-append
- "SELECT conj,accmap,augment,suffix_aor_path FROM verb \
+ "SELECT conj,accmap,augment,suffix FROM verb \
WHERE verb='" (force-string verb) "'"
class))))
(cond
@@ -98,9 +106,11 @@ WHERE verb='" (force-string verb) "'"
((elstr-suffix? verb "άω")
(get-verb-info (elstr-append
(elstr-trim verb -2) "ώ") "B1"))
+ ((null? rest)
+ (guess-verb-info verb))
(else
- (guess-verb-info verb))))))
-
+ (assoc (car rest) verb-info-template))))))
+
(define (thema-aoristoy-mesapathitikis root)
(cond
((elstr-suffix? root "αίν")
@@ -148,7 +158,7 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(error "cannot handle ~A~%" verb))))
(define (complement-verb-info vinfo verb voice thema)
-; (format #t "COMPLEMENT ~S~%" thema)
+; (format #t "COMPLEMENT ~A~%" thema)
(let ((elverb (string->elstr verb))
(result (let ((tmpres (lookup-verb-info verb voice thema)))
(if (and (null? tmpres) (string=? thema "sub"))
@@ -254,20 +264,22 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(list-ref v 4))
((conj-info #:auxtense v)
(list-ref v 5))
+ ((conj-info #:fold v)
+ (list-ref v 6))
((conj-info #:flect v)
- (list-tail v 6))
+ (list-tail v 7))
((conj-info #:sing 1 v)
- (list-ref v 7))
- ((conj-info #:sing 2 v)
(list-ref v 8))
- ((conj-info #:sing 3 v)
+ ((conj-info #:sing 2 v)
(list-ref v 9))
- ((conj-info #:plur 1 v)
+ ((conj-info #:sing 3 v)
(list-ref v 10))
((conj-info #:plur 1 v)
(list-ref v 11))
((conj-info #:plur 1 v)
- (list-ref v 12))))
+ (list-ref v 12))
+ ((conj-info #:plur 1 v)
+ (list-ref v 13))))
(define-syntax conj-info-set!
(syntax-rules ()
@@ -279,14 +291,14 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(let ((answer (my-sql-query
conn
(string-append
- "SELECT c.thema,c.suffix,c.accmap,c.particle,c.aux,c.auxtense,\
+ "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"))))
+"' AND c.tense='" tense "' AND c.flect = f.ident ORDER by fold"))))
(if (null? answer)
#f
- (car answer)))))
+ answer))))
(define (force-string str)
(if (elstr? str)
@@ -316,7 +328,7 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(conj-info #:accmap conj)
"000000")))
(augment ""))
-; (format #t "ROOT ~S, ACCMAP ~S~%" root accmap)
+; (format #t "ROOT ~S, ACCMAP ~S, SUFFIX: ~S~%" root accmap suffix)
(cond
((> (length accmap) 6)
(set! accmap (list-head accmap 6))
@@ -394,51 +406,88 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
'(class root)))
#f)))
+(define (merge-conjugated-forms lista listb)
+ (map
+ (lambda (a b)
+ (or a b))
+ lista listb))
+
(define (conjugate verb voice mood tense . rest)
(cond
((individual-verb verb voice mood tense) =>
(lambda (res)
- res))
+ (list res)))
(else
- (let* ((vinfo (get-verb-info verb))
- (conj (get-conj-info (verb-info #:conj vinfo) voice mood tense)))
- (if (not conj)
- (error "cannot obtain conjugation information for "
- (verb-info #:conj vinfo) voice mood tense))
- (if (member #:nopart rest)
- (conj-info-set! #:particle conj #f))
- (cond
- ((string=? (conj-info #:thema conj) "synt")
- (let* ((verb-conj (conjugate 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
- (map
- (lambda (aux flag)
- (if (char=? flag #\-)
- #f
- (elstr->string
- (if part
- (elstr-append part " " aux " " form)
- (elstr-append aux " " form)))))
- (conjugation:table (conjugate (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
- ; (format #t "CONJ ~S~%" conj)
- (complement-verb-info vinfo verb voice (conj-info #:thema conj))
- (append (apply-flect conj vinfo verb)
- (list (verb-info #:conj vinfo)
- (verb-info #:attested vinfo)))))))))
+ (map car
+ (let* ((vinfo (get-verb-info verb))
+ (conj-list (get-conj-info (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)
+ (if (null? prev)
+ (list elt)
+ (let ((top (car prev)))
+ (if (let ((a (cdr elt))
+ (b (cdr top)))
+ (and (string? a) (string? b) (string=? a b)))
+ (cons (cons
+ (merge-conjugated-forms (car top) (car elt))
+ (cdr top))
+ (cdr prev))
+ (cons elt prev)))))
+ '()
+ (map
+ (lambda (conj)
+; (format #t "CONJ ~S~%" conj)
+ (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)))
+ (form (list-ref verb-conj 2))
+ (part (conj-info #:particle conj)))
+ (cond
+ (form
+; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME
+ (append
+ (map
+ (lambda (aux flag)
+ (if (char=? flag #\-)
+ #f
+ (elstr->string
+ (if part
+ (elstr-append part " " aux " " form)
+ (elstr-append aux " " form)))))
+ (conjugation:table
+ (car (conjugate (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
+ (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)
(cond
@@ -446,12 +495,15 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
#f)
(else
(list-head conj 6))))
+
+
(define (conjugation:class conj)
(cond
((not conj)
#f)
(else
(list-ref conj 6))))
+
(define (conjugation:attested conj)
(cond
((not conj)
@@ -487,24 +539,26 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(or (assoc-ref transtab x) x))
(define (test-conjugation verb voice mood tense)
- (format #t "~A ~A/~A/~A: " verb (term voice) (term mood) tense)
- (let* ((result (conjugate verb voice mood tense))
- (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)
+ (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)
@@ -526,7 +580,7 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
;; (test-conjugation "είμαι" "act" "ind" "Αόριστος")
;; (test-conjugation "έχω" "act" "ind" "Ενεστώτας")
-;; (test-conjugation "έχω" "act" "ind" "Παρατατίκος")
+(test-conjugation "έχω" "act" "ind" "Παρατατίκος")
;; (test-conjugation "έχω" "act" "ind" "Μέλλοντας διαρκείας")
;; (test-conjugation "έχω" "act" "sub" "Ενεστώτας")
;; (test-conjugation "έχω" "act" "imp" "Ενεστώτας")
@@ -588,5 +642,16 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
;; (test-conjugation "έρχομαι" "pas" "ind" "Ενεστώτας");FIXME!
;; (test-conjugation "έρχομαι" "pas" "ind" "Υπερσυντέλικος")
-(test-voice "pas" "ντύνω")
+;(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)
diff --git a/scm/verbop.scm b/scm/verbop.scm
index f3ecc33..621ea6c 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -267,7 +267,7 @@ VALUES (~A,~A,~A,~A);~%"
;;
(case (verb-get #:action)
((insert)
- (run-query "INSERT INTO verb (verb,conj,augment,accmap,suffix_aor_path) \
+ (run-query "INSERT INTO verb (verb,conj,augment,accmap,suffix) \
VALUES (~A,~A,~A,~A,~A);~%"
(verb-get-sql #:verb)
(verb-get-sql #:class)

Return to:

Send suggestions and report system problems to the System administrator.