diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-19 06:31:26 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-19 06:31:26 +0300 |
commit | 3b0729ca8599173a61b97d59513c32b8b8eb1ea4 (patch) | |
tree | fdd8c21bcc770b4b761205c3b5bdbb058228b3da /src | |
parent | b8f74f94f21826901ff303095c2b88caad4a695e (diff) | |
download | ellinika-3b0729ca8599173a61b97d59513c32b8b8eb1ea4.tar.gz ellinika-3b0729ca8599173a61b97d59513c32b8b8eb1ea4.tar.bz2 |
Conjugator: revamp handling of simple synthetic tenses (e.g. mellontas diarkeias).
* data/dbverb.struct: Rewrite definitions of simple compound
tenses.
* data/irregular-verbs.xml: Update.
* scm/verbop.scm (prop): New tag.
(p): New attribute "prop".
* src/ellinika/conjugator.scm (apply-flect): Use "flection"
property, if defined.
(conjugate): Handle simple synthetic tenses.
Diffstat (limited to 'src')
-rw-r--r-- | src/ellinika/conjugator.scm | 126 |
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" | |||
371 | ; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment)) | 371 | ; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment)) |
372 | (let ((forms | 372 | (let ((forms |
373 | (map | 373 | (map |
374 | (lambda (flect acc) | 374 | (lambda (flect acc person) |
375 | (cond | 375 | (cond |
376 | ((verb-get vinfo (symbol->keyword | ||
377 | (string->symbol (number->string person)))) => | ||
378 | (lambda (personal-form) | ||
379 | personal-form)) | ||
376 | ((not flect) #f) | 380 | ((not flect) #f) |
377 | ((char=? acc #\0) | 381 | ((char=? acc #\0) |
378 | (let* ((rs (force-elstr root)) | 382 | (let* ((rs (force-elstr root)) |
@@ -421,7 +425,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
421 | (throw 'conjugator-error 'conjugator-error-db | 425 | (throw 'conjugator-error 'conjugator-error-db |
422 | "invalid accent character ~A" (list acc))))) | 426 | "invalid accent character ~A" (list acc))))) |
423 | (conj-info #:flect conj) | 427 | (conj-info #:flect conj) |
424 | accmap))) | 428 | accmap |
429 | '(1 2 3 4 5 6)))) | ||
425 | (if (conj-info #:particle conj) | 430 | (if (conj-info #:particle conj) |
426 | (map | 431 | (map |
427 | (lambda (w) | 432 | (lambda (w) |
@@ -463,7 +468,7 @@ AND i.tense=\"~A\" AND i.ident=f.ident" | |||
463 | (if (not conj-list) | 468 | (if (not conj-list) |
464 | (list (list #f #f #f #f #f #f #f #f)) | 469 | (list (list #f #f #f #f #f #f #f #f)) |
465 | (map car | 470 | (map car |
466 | (fold-right | 471 | (fold |
467 | (lambda (elt prev) | 472 | (lambda (elt prev) |
468 | ; (format #t "ELT ~A~%" elt) | 473 | ; (format #t "ELT ~A~%" elt) |
469 | (if (null? prev) | 474 | (if (null? prev) |
@@ -478,55 +483,82 @@ AND i.tense=\"~A\" AND i.ident=f.ident" | |||
478 | (cdr prev)) | 483 | (cdr prev)) |
479 | (cons elt prev))))) | 484 | (cons elt prev))))) |
480 | '() | 485 | '() |
481 | (map | 486 | (fold |
482 | (lambda (conj) | 487 | (lambda (conj prev) |
483 | ; (format #t "CONJ ~S~%" conj) | 488 | ; (format #t "CONJ ~A~%" conj) |
484 | (if (member #:nopart rest) | 489 | (if (member #:nopart rest) |
485 | (conj-info-set! #:particle conj #f)) | 490 | (conj-info-set! #:particle conj #f)) |
491 | (cond | ||
492 | ((and (string=? (conj-info #:thema conj) "synt") | ||
493 | (conj-info #:aux conj)) | ||
486 | (cons | 494 | (cons |
487 | (cond | 495 | (cons |
488 | ((string=? (conj-info #:thema conj) "synt") | 496 | (let* ((verb-conj |
489 | (let* ((verb-conj | 497 | (car (conjugate verb voice "sub" "Αόριστος" |
490 | (car (conjugate verb voice "sub" "Αόριστος" | 498 | #:nopart))) |
491 | #:nopart))) | 499 | (form (list-ref verb-conj 2)) |
492 | (form (list-ref verb-conj 2)) | 500 | (part (conj-info #:particle conj))) |
493 | (part (conj-info #:particle conj))) | 501 | (cond |
494 | (cond | 502 | (form |
495 | (form | ||
496 | ; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME | 503 | ; (format #t "FORM ~A FROM ~A~%" form verb-conj);;FIXME |
504 | (append | ||
505 | (map | ||
506 | (lambda (aux flag) | ||
507 | (if (char=? flag #\-) | ||
508 | #f | ||
509 | (elstr->string | ||
510 | (if part | ||
511 | (elstr-append part " " aux " " form) | ||
512 | (elstr-append aux " " form))))) | ||
513 | (conjugation:table | ||
514 | (car (conjugate (conj-info #:aux conj) "act" "ind" | ||
515 | (conj-info #:auxtense conj)))) | ||
516 | (string->list (or (verb-get vinfo #:accmap) | ||
517 | (conj-info #:accmap conj) | ||
518 | "000000"))) | ||
519 | (list (verb-get vinfo #:conj) | ||
520 | (conjugation:attested verb-conj)))) | ||
521 | (else | ||
522 | #f))) | ||
523 | (conj-info #:fold conj)) | ||
524 | prev)) | ||
525 | ((and (string=? (conj-info #:thema conj) "synt") | ||
526 | (conj-info #:auxtense conj)) | ||
527 | (let ((part (conj-info #:particle conj))) | ||
528 | (fold-right | ||
529 | (lambda (tenses prev) | ||
530 | (cons | ||
531 | (cons | ||
497 | (append | 532 | (append |
498 | (map | 533 | (map |
499 | (lambda (aux flag) | 534 | (lambda (t) |
500 | (if (char=? flag #\-) | 535 | (elstr->string (elstr-append part " " t))) |
501 | #f | 536 | (list-head tenses 6)) |
502 | (elstr->string | 537 | (list-tail tenses 6)) |
503 | (if part | 538 | (conj-info #:fold conj)) |
504 | (elstr-append part " " aux " " form) | 539 | prev)) |
505 | (elstr-append aux " " form))))) | 540 | prev |
506 | (conjugation:table | 541 | (conjugate verb voice "ind" |
507 | (car (conjugate (conj-info #:aux conj) "act" "ind" | 542 | (conj-info #:auxtense conj))))) |
508 | (conj-info #:auxtense conj)))) | 543 | (else |
509 | (string->list (or (verb-get vinfo #:accmap) | 544 | (if (not (verb-get vinfo #:root)) |
510 | (conj-info #:accmap conj) | 545 | (let ((thema (string-split (conj-info #:thema conj) #\:))) |
511 | "000000"))) | 546 | ; (format #t "THEMA ~A~%" thema) |
512 | (list (verb-get vinfo #:conj) | 547 | (complement-verb-info vinfo verb |
513 | (conjugation:attested verb-conj)))) | 548 | (if (null? (cdr thema)) |
514 | (else | 549 | voice |
515 | #f)))) | 550 | (car (cdr thema))) |
516 | (else | 551 | (car thema)))) |
517 | (let ((thema (string-split (conj-info #:thema conj) #\:))) | ||
518 | ; (format #t "THEMA ~A~%" thema) | ||
519 | (complement-verb-info vinfo verb | ||
520 | (if (null? (cdr thema)) | ||
521 | voice | ||
522 | (car (cdr thema))) | ||
523 | (car thema)) | ||
524 | ; (format #t "VINFO ~A~%" vinfo) | 552 | ; (format #t "VINFO ~A~%" vinfo) |
525 | (append (apply-flect conj vinfo verb) | 553 | (cons |
526 | (list (verb-get vinfo #:conj) | 554 | (cons |
527 | (verb-get vinfo #:attested)))))) | 555 | (append (apply-flect conj vinfo verb) |
528 | (conj-info #:fold conj))) | 556 | (list (verb-get vinfo #:conj) |
529 | conj-list)))))))) | 557 | (verb-get vinfo #:attested))) |
558 | (conj-info #:fold conj)) | ||
559 | prev)))) | ||
560 | '() | ||
561 | conj-list)))))))) | ||
530 | 562 | ||
531 | (define-public (conjugator verb voice mood tense) | 563 | (define-public (conjugator verb voice mood tense) |
532 | (conjugate verb voice mood tense)) | 564 | (conjugate verb voice mood tense)) |