aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ellinika/conjugator.scm126
1 files changed, 79 insertions, 47 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index e73a1cc..2a6425c 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -371,8 +371,12 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment))
(let ((forms
(map
- (lambda (flect acc)
+ (lambda (flect acc person)
(cond
+ ((verb-get vinfo (symbol->keyword
+ (string->symbol (number->string person)))) =>
+ (lambda (personal-form)
+ personal-form))
((not flect) #f)
((char=? acc #\0)
(let* ((rs (force-elstr root))
@@ -421,7 +425,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(throw 'conjugator-error 'conjugator-error-db
"invalid accent character ~A" (list acc)))))
(conj-info #:flect conj)
- accmap)))
+ accmap
+ '(1 2 3 4 5 6))))
(if (conj-info #:particle conj)
(map
(lambda (w)
@@ -463,7 +468,7 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(if (not conj-list)
(list (list #f #f #f #f #f #f #f #f))
(map car
- (fold-right
+ (fold
(lambda (elt prev)
; (format #t "ELT ~A~%" elt)
(if (null? prev)
@@ -478,55 +483,82 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(cdr prev))
(cons elt prev)))))
'()
- (map
- (lambda (conj)
-; (format #t "CONJ ~S~%" conj)
- (if (member #:nopart rest)
- (conj-info-set! #:particle conj #f))
+ (fold
+ (lambda (conj prev)
+; (format #t "CONJ ~A~%" conj)
+ (if (member #:nopart rest)
+ (conj-info-set! #:particle conj #f))
+ (cond
+ ((and (string=? (conj-info #:thema conj) "synt")
+ (conj-info #:aux conj))
(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
+ (cons
+ (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-get vinfo #:accmap)
+ (conj-info #:accmap conj)
+ "000000")))
+ (list (verb-get vinfo #:conj)
+ (conjugation:attested verb-conj))))
+ (else
+ #f)))
+ (conj-info #:fold conj))
+ prev))
+ ((and (string=? (conj-info #:thema conj) "synt")
+ (conj-info #:auxtense conj))
+ (let ((part (conj-info #:particle conj)))
+ (fold-right
+ (lambda (tenses prev)
+ (cons
+ (cons
(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-get vinfo #:accmap)
- (conj-info #:accmap conj)
- "000000")))
- (list (verb-get vinfo #:conj)
- (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))
+ (lambda (t)
+ (elstr->string (elstr-append part " " t)))
+ (list-head tenses 6))
+ (list-tail tenses 6))
+ (conj-info #:fold conj))
+ prev))
+ prev
+ (conjugate verb voice "ind"
+ (conj-info #:auxtense conj)))))
+ (else
+ (if (not (verb-get vinfo #:root))
+ (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-get vinfo #:conj)
- (verb-get vinfo #:attested))))))
- (conj-info #:fold conj)))
- conj-list))))))))
+ (cons
+ (cons
+ (append (apply-flect conj vinfo verb)
+ (list (verb-get vinfo #:conj)
+ (verb-get vinfo #:attested)))
+ (conj-info #:fold conj))
+ prev))))
+ '()
+ conj-list))))))))
(define-public (conjugator verb voice mood tense)
(conjugate verb voice mood tense))

Return to:

Send suggestions and report system problems to the System administrator.