summaryrefslogtreecommitdiffabout
path: root/src/ellinika
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-13 23:21:00 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-13 23:26:46 (GMT)
commitbee3becef44e298f59d72cee3c8e552bccb10d65 (patch) (side-by-side diff)
treed62e1cc162c52f89b2c7a7fb8aa7a3f0e2df115f /src/ellinika
parentd7b0bf03404d26c7c972b3040725eda339f57122 (diff)
downloadellinika-bee3becef44e298f59d72cee3c8e552bccb10d65.tar.gz
ellinika-bee3becef44e298f59d72cee3c8e552bccb10d65.tar.bz2
Improve verb database structure for better handling of individual verbs.
* data/dbverb.struct (verbflect): Split alternative flections into separate groups. (conjugation): Set fold values for imp. Add missing accmaps (verb): Drop table. (verbclass,verbtense): New tables. * data/irregular-verbs.xml: Update. * scm/verbop.scm: Rewrite for the new database structure. * src/ellinika/conjugator.scm: Likewise. * src/ellinika/tests/conj/ntynv.scm: Fix typo. * src/ellinika/tests/conj/bastv.scm: New file. * src/ellinika/tests/conj/kauomai.scm: New file.
Diffstat (limited to 'src/ellinika') (more/less context) (ignore whitespace changes)
-rw-r--r--src/ellinika/conjugator.scm427
-rw-r--r--src/ellinika/tests/conj/bastv.scm3
-rw-r--r--src/ellinika/tests/conj/kauomai.scm4
-rw-r--r--src/ellinika/tests/conj/ntynv.scm2
4 files changed, 255 insertions, 181 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index c8fd012..25ae255 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -30,68 +30,102 @@
(let ((res (sql-query conn query)))
; (format #t "R: ~A~%" res)
res))
+
+;; Verb info
+;; #:verb - Verb in dictionary form
+;; #:conj - Conjugation class
+;;
+;; Verb structure:
+;; (class verb flag assoc)
+;; class - Verb class
+;; verb - the verb itself
+;; properties - associative list of properties
+;; attested
-(define verb-info-template
- (list
- (list "A"
- #f
- "ε"
- #f
- #f
- #f)
- (list "B1"
- #f
- #f
- #f
- #f
- #f)
- (list "B2"
- #f
- #f
- #f
- #f
- #f)))
-
-(define (guess-verb-info verb)
+(define (verb-set! verb key value)
+; (format #t "VERB ~A KEY ~A VALUE ~A~%" verb key value)
+ (case key
+ ((#:conj)
+ (list-set! verb 0 value))
+ ((#:verb)
+ (list-set! verb 1 value))
+ ((#:attested)
+ (list-set! verb 3 (append (list-ref verb 3) (list value))))
+ (else
+ (let ((container (assoc key (list-ref verb 2))))
+ (if container
+ (set-cdr! container value)
+ (list-set! verb 2 (append (list-ref verb 2)
+ (list
+ (cons key value)))))))))
+
+
+(define (verb-get verb key)
+ (case key
+ ((#:conj)
+ (list-ref verb 0))
+ ((#:verb)
+ (list-ref verb 1))
+ ((#:attested)
+ (list-ref verb 3))
+ (else
+ (assoc-ref (list-ref verb 2) key))))
+
+
+(define (guess-verb-class verb)
(cond
;; FIXME
- ((elstr-suffix? verb "άω")
- (assoc "B1" verb-info-template))
- ((elstr-suffix? verb "ώ")
- (assoc "B2" verb-info-template))
+ ((elstr-suffix? verb "άω") "B1")
+ ((elstr-suffix? verb "ώ") "B2")
;; FIXME: deponentia?
- (else
- (assoc "A" verb-info-template))))
+ (else "A")))
-(define (get-verb-info conn verb . rest)
+(define (create-basic-verb-info conn verb proplist . rest)
+; (format #t "PROPLIST ~A~%" proplist)
(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 \
-WHERE verb='" (force-string verb) "'"
- class))))
+ "SELECT conj FROM verbclass WHERE verb='" (force-string verb) "'"
+ class))))
(cond
- ((and vdb (not (null? vdb)))
- (let ((x (car vdb)))
- (list
- (list-ref x 0)
- (list-ref x 1)
- (or (list-ref x 2) "ε")
- (list-ref x 3)
- #f
- '(class))))
+ ((and vdb (not (null? vdb)));FIXME
+ (list (caar vdb) verb proplist '(class)))
((elstr-suffix? verb "άω")
- (get-verb-info conn (elstr-append
- (elstr-trim verb -2) "ώ") "B1"))
+ (create-basic-verb-info conn (elstr-append
+ (elstr-trim verb -2) "ώ") "B1"))
((null? rest)
- (guess-verb-info verb))
+ (list (guess-verb-class verb) verb proplist '()))
(else
- (assoc (car rest) verb-info-template))))))
+ (list (car rest) verb '() '()))))))
+
+(define (load-verb-info conn verb voice mood tense)
+; (format #t "LOAD ~A~%" verb)
+ (let ((verbprop (my-sql-query
+ conn
+ (string-append
+ "SELECT property,value FROM verbtense WHERE "
+ "verb=\"" verb "\" AND voice=\"" voice
+ "\" AND mood=\"" mood "\" AND tense=\"" tense "\""))))
+ (create-basic-verb-info conn verb
+ (if (null? verbprop)
+ '()
+ (map
+ (lambda (elt)
+ (let ((name (car elt))
+ (value (cadr elt)))
+ (if (string=? name "override")
+ (cons #:override
+ (string-split value #\,))
+ (cons (symbol->keyword
+ (string->symbol name))
+ value))))
+ verbprop)))))
+
-(define (thema-aoristoy-mesapathitikis root)
+(define (thema-aoristoy-mesapathitikis-A root)
(cond
((elstr-suffix? root "αίν")
(elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ
@@ -121,6 +155,24 @@ WHERE verb='" (force-string verb) "'"
(else
#f)))
+(define (thema-aoristoy-mesapathitikis-B root conj-aor)
+ (let ((root-aor (elstr-trim (list-ref conj-aor 0) -1)))
+ (cond
+ ((elstr-suffix? root-aor "σ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "θ"))
+ ((elstr-suffix? root-aor "ξ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "χτ"))
+ ((elstr-suffix? root-aor "ψ")
+ (elstr-append root
+ (elstr-slice root-aor -2 1)
+ "φτ"))
+ (else
+ (elstr-append root "ηθ")))))
+
(define (lookup-verb-info conn verb voice thema)
(my-sql-query
conn
@@ -144,50 +196,54 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(if (and (null? tmpres) (string=? thema "sub"))
(lookup-verb-info conn verb voice "aor")
tmpres))))
- (verb-info-set! #:root vinfo
+ (verb-set! vinfo #:root
(cond
((not (null? result))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
(caar result))
- ((string=? (verb-info #:conj vinfo) "A")
+ ((string=? (verb-get vinfo #:conj) "A")
(let ((root (verb-A-root elverb)))
(cond
((string=? thema "pres")
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
(if (string=? voice "act")
(elstr-thema-aoristoy root)
- (thema-aoristoy-mesapathitikis root)))
+ (thema-aoristoy-mesapathitikis-A root)))
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "A-depon")
+ ((string=? (verb-get vinfo #:conj) "A-depon")
(let ((root (verb-A-root elverb)))
(cond
((string=? thema "pres")
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
#f) ; FIXME
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "B1")
+ ((string=? (verb-get vinfo #:conj) "B1")
(let ((root (if (elstr-suffix? elverb "άω")
(elstr-trim elverb -2)
(elstr-trim elverb -1))))
(cond
((or (string=? voice "act") (string=? thema "pres"))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
- (elstr-append root "ηθ")) ;; FIXME: guesswork
+ (thema-aoristoy-mesapathitikis-B
+ root
+ (list-ref
+ (conjugate conn verb "act" "ind" "Αόριστος")
+ 0)))
(else
#f))))
- ((string=? (verb-info #:conj vinfo) "B2")
+ ((string=? (verb-get vinfo #:conj) "B2")
(let ((root (elstr-trim elverb -1)))
(cond
((or (string=? voice "act") (string=? thema "pres"))
- (verb-info-set! #:attested vinfo 'root)
+ (verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
(elstr-append root "ηθ")) ;; FIXME: guesswork
@@ -196,40 +252,6 @@ WHERE verb='" verb "' AND voice='" voice "' AND thema='" thema "'")))
(else
#f)))))
-(define-syntax verb-info
- (syntax-rules ()
- ((verb-info #:conj v)
- (list-ref v 0))
- ((verb-info #:accmap v)
- (list-ref v 1))
- ((verb-info #:augment v)
- (list-ref v 2))
- ((verb-info #:suffix v)
- (list-ref v 3))
- ((verb-info #:root v)
- (list-ref v 4))
- ((verb-info #:attested v)
- (list-ref v 5))))
-
-(define-syntax verb-info-set!
- (syntax-rules ()
- ((verb-info-set! #:root v val)
- (list-set! v 4 val))
- ((verb-info-set! #:attested v val)
- (list-set! v 5
- (if (not val)
- val
- (let ((oldval (list-ref v 5)))
- (cond
- ((not oldval)
- (list val))
- ((boolean? oldval)
- (list val))
- ((member val oldval)
- oldval)
- (else
- (cons val oldval)))))))))
-
(define-syntax conj-info
(syntax-rules ()
((conj-info #:thema v)
@@ -264,7 +286,11 @@ 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))))
+ (list-set! v 3 val))
+ ((conj-info-set! #:suffix v)
+ (list-set! v 1 val))
+ ((conj-info-set! #:accmap v)
+ (list-set! v 2 val)) ))
(define (get-conj-info conn conj voice mood tense)
(let ((answer (my-sql-query
@@ -296,22 +322,61 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
syl
(+ (- len syl) 1))))
+;; (define (get-property conj vinfo key default)
+;; (if ((override (verb-get vinfo
+;; (symbol->keyword
+;; (string->symbol
+;; (string-append
+;; (symbol->string (keyword->symbol key))
+;; "-override"))))))
+;; (if override
+;; (let ((t (conj-info key conj)))
+;; (if t
+;; (or (verb-get vinfo key)
+;; t)
+;; (or (verb-get vinfo key)
+;; (conj-info key conj)
+;; default))))))
+
+
+(define (get-suffix conj vinfo)
+ (let ((override (verb-get vinfo #:override)))
+ (if (and override
+ (member "suffix" override))
+ (let ((t (conj-info #:suffix conj)))
+ (if t
+ (or (verb-get vinfo #:suffix)
+ t)
+ ""))
+ (or (verb-get vinfo #:suffix)
+ (conj-info #:suffix conj)
+ ""))))
+
+
+(define (get-accmap conj vinfo)
+ (let ((override (verb-get vinfo #:override)))
+ (if (and override
+ (member "accmap" override))
+ (let ((t (conj-info #:accmap conj)))
+ (if t
+ (or (verb-get vinfo #:accmap)
+ t)))
+ (or (verb-get vinfo #:accmap)
+ (conj-info #:accmap conj)
+ "000000"))))
+
(define (apply-flect conj vinfo verb)
; (format #t "VINFO ~A~%" vinfo)
- (let ((root (verb-info #:root vinfo))
- (suffix (let ((s (conj-info #:suffix conj)))
- (if s
- (or (verb-info #:suffix vinfo) s)
- "")))
- (accmap (string->list (or (verb-info #:accmap vinfo)
- (conj-info #:accmap conj)
- "000000")))
+ (let ((root (verb-get vinfo #:root))
+ (suffix (get-suffix conj vinfo))
+ (accmap (string->list (get-accmap conj vinfo)))
(augment ""))
-; (format #t "ROOT ~S, ACCMAP ~S, SUFFIX: ~S~%" root accmap suffix)
+; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix)
(cond
((> (length accmap) 6)
(set! accmap (list-head accmap 6))
- (set! augment (verb-info #:augment vinfo))))
+ (set! augment (or (verb-get vinfo #:augment) "ε"))))
+; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment))
(let ((forms
(map
(lambda (flect acc)
@@ -339,10 +404,12 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(elstr-deaccent (elstr-append root suffix))
flect))
((char=? acc #\s)
- (elstr-append
- (elstr-deaccent root)
- suffix
- (elstr-deaccent flect)))
+ (let ((nsyl (elstr-number-of-syllables flect)))
+ (elstr-set-accent
+ (elstr-append root suffix flect)
+ (if (< nsyl 2)
+ (+ nsyl 1)
+ 3))))
((char=? acc #\-)
#f)
((char-numeric? acc)
@@ -367,7 +434,8 @@ WHERE c.conj='" conj "' AND c.voice='" voice "' AND c.mood='" mood
(lambda (w)
(if w
(string-append
- (conj-info #:particle conj) " " (force-string w))))
+ (conj-info #:particle conj) " " (force-string w))
+ #f))
forms)
(map force-string forms)))))
@@ -390,86 +458,85 @@ WHERE i.verb='" verb "' AND i.voice='" voice "' AND i.mood='" mood
(lambda (a b)
(or a b))
lista listb))
-
+
(define (conjugate conn verb voice mood tense . rest)
(cond
((individual-verb conn verb voice mood tense) =>
(lambda (res)
(list res)))
(else
- (map car
- (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)
- (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 conn verb voice "sub" "Αόριστος"
- #:nopart)))
- (form (list-ref verb-conj 2))
- (part (conj-info #:particle conj)))
+ (let* ((vinfo (load-verb-info conn verb voice mood tense))
+ (conj-list (get-conj-info conn
+ (verb-get vinfo #:conj)
+ voice mood tense)))
+ (if (not conj-list)
+ (list (list #f #f #f #f #f #f) #f #f)
+ (map car
+ (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
- (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 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))))
+ ((string=? (conj-info #:thema conj) "synt")
+ (let* ((verb-conj
+ (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
+ (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 conn
+ (conj-info #:aux conj) "act" "ind"
+ (conj-info #:auxtense conj))))
+ (string->list (or (verb-get vinfo #:accmap)
+ (conj-info #:accmap conj)
+ "000000")))
+ (list (verb-get vinfo #:conj)
+ (conjugation:attested verb-conj))))
+ (else
+ #f))))
(else
- #f))))
- (else
- (let ((thema (string-split (conj-info #:thema conj) #\:)))
-; (format #t "THEMA ~A~%" thema)
- (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)))))))
+ (let ((thema (string-split (conj-info #:thema conj) #\:)))
+; (format #t "THEMA ~A~%" thema)
+ (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-get vinfo #:conj)
+ (verb-get vinfo #:attested))))))
+ (conj-info #:fold conj)))
+ conj-list))))))))
(define-public (conjugator conn verb voice mood tense)
(conjugate conn verb voice mood tense))
diff --git a/src/ellinika/tests/conj/bastv.scm b/src/ellinika/tests/conj/bastv.scm
new file mode 100644
index 0000000..f8a173f
--- a/dev/null
+++ b/src/ellinika/tests/conj/bastv.scm
@@ -0,0 +1,3 @@
+(use-modules ((ellinika test-conjugation)))
+
+(test-conjugation:verb "βαστώ")
diff --git a/src/ellinika/tests/conj/kauomai.scm b/src/ellinika/tests/conj/kauomai.scm
new file mode 100644
index 0000000..000b19c
--- a/dev/null
+++ b/src/ellinika/tests/conj/kauomai.scm
@@ -0,0 +1,4 @@
+(use-modules ((ellinika test-conjugation)))
+
+(test-conjugation:verb "κάθομαι")
+;(test-conjugation:tense "κάθομαι" "pas" "ind" "Αόριστος")
diff --git a/src/ellinika/tests/conj/ntynv.scm b/src/ellinika/tests/conj/ntynv.scm
index 160832d..1fd1545 100644
--- a/src/ellinika/tests/conj/ntynv.scm
+++ b/src/ellinika/tests/conj/ntynv.scm
@@ -1,3 +1,3 @@
-(use-modules ((ellinika test-conjugation)))
+(use-modules (ellinika test-conjugation))
(test-conjugation:verb "ντύνω")

Return to:

Send suggestions and report system problems to the System administrator.