From 3b0729ca8599173a61b97d59513c32b8b8eb1ea4 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Sun, 19 Jun 2011 06:31:26 +0300
Subject: 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.
---
 src/ellinika/conjugator.scm | 126 +++++++++++++++++++++++++++-----------------
 1 file changed, 79 insertions(+), 47 deletions(-)

(limited to 'src')

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