Accept multiple suffixes.

* data/irregular-verbs.xml: Update.
* scm/verbop.scm: Allow for multiple suffixes.
* src/ellinika/conjugator.scm: Accept multiple suffixes.
Fix accent settings.

* src/cgi-bin/conj.scm4: Minor changes.

1 files changed, 86 insertions, 61 deletions

diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index 536b48e..bffc6be 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -47,4 +47,6 @@
     ((#:attested)
      (list-set! verb 3 (append (list-ref verb 3) (list value))))
+    ((#:proplist)
+     (list-set! verb 2 value))
     (else
      (let ((container (assoc key (list-ref verb 2)))
@@ -79,6 +81,5 @@
    (else                         "A")))
 
-(define (create-basic-verb-info verb proplist . rest)
-;  (format #t "PROPLIST ~A~%" proplist)
+(define (create-basic-verb-info verb . rest)
   (let ((vdb (if (null? rest)
 		 (ellinika:sql-query
@@ -90,21 +91,20 @@
     (cond
      ((and vdb (not (null? vdb)))
-      (list (caar vdb) verb proplist '(class)))
+      (list (caar vdb) verb '() '(class)))
      ((elstr-suffix? verb "άω")
       (create-basic-verb-info (elstr-append
-			       (elstr-trim verb -2) "ώ") proplist "B1"))
+			       (elstr-trim verb -2) "ώ") "B1"))
      ((null? rest)
-      (list (guess-verb-class verb) verb proplist '()))
+      (list (guess-verb-class verb) verb '() '()))
      (else
       (list (car rest) verb '() '())))))
 
-(define (load-verb-info verb voice mood tense)
-;  (format #t "LOAD ~A~%" verb)
+(define (load-proplist vinfo voice mood tense)
   (let ((verbprop (ellinika:sql-query
 		   "SELECT property,value FROM verbtense WHERE \
 verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
-		   verb voice mood tense)))
-    (create-basic-verb-info
-     verb
+		   (verb-get vinfo #:verb) voice mood tense)))
+    (verb-set!
+     vinfo #:proplist
      (let loop ((inlist (if (null? verbprop)
 			    '()
@@ -121,15 +121,29 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
 			     verbprop)))
 		(stemlist '())
+		(suflist '())
 		(outlist '()))
 ;       (format #t "ARGS: ~A/~A/~A~%" inlist stemlist outlist)
        (cond
 	((null? inlist)
-	 (if (null? stemlist)
-	     outlist
-	     (cons (cons #:stem stemlist) outlist)))
+	 (append
+	  (if (not (null? stemlist))
+	      (list (cons #:stem stemlist))
+	      '())
+	  (if (not (null? suflist))
+	      (list (cons #:suffix suflist))
+	      '())
+	  outlist))
 	((eq? (caar inlist) #:stem)
-	 (loop (cdr inlist) (cons (cdar inlist) stemlist) outlist))
+	 (loop (cdr inlist) (cons (cdar inlist) stemlist) suflist outlist))
+	((eq? (caar inlist) #:suffix)
+	 (loop (cdr inlist) stemlist (cons (cdar inlist) suflist) outlist))
 	(else
-	 (loop (cdr inlist) stemlist (cons (car inlist) outlist))))))))
+	 (loop (cdr inlist) stemlist suflist (cons (car inlist) outlist))))))))
+
+(define (load-verb-info verb voice mood tense)
+;  (format #t "LOAD ~A~%" verb)
+  (let ((vinfo (create-basic-verb-info verb)))
+    (load-proplist vinfo voice mood tense)
+    vinfo))
 	
 (define (thema-aoristoy-mesapathitikis-A stem)
@@ -240,9 +254,8 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
 		     stem)
 		    ((or (string=? thema "aor") (string=? thema "sub"))
-		     (thema-aoristoy-mesapathitikis-B
-		      stem
-		      (list-ref
-		       (conjugate verb "act" "ind" "Αόριστος")
-		       0)))
+		     (map
+		      (lambda (aor)
+			(thema-aoristoy-mesapathitikis-B stem aor))
+		      (conjugate verb "act" "ind" "Αόριστος")))
 		    (else
 		     #f))))
@@ -348,15 +361,16 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 
 (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)
-	    ""))))
+  (let ((ret (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)
+		       "")))))
+    (if (list? ret) ret (list ret))))
 	
 
@@ -373,8 +387,7 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 	    "000000"))))
 	
-(define (apply-flect conj vinfo verb stem)
+(define (apply-flect conj vinfo verb stem suffix)
 ;  (format #t "VINFO ~A~%" vinfo)
-  (let ((suffix (get-suffix conj vinfo))
-	(accmap (string->list (get-accmap conj vinfo)))
+  (let ((accmap (string->list (get-accmap conj vinfo)))
 	(augment ""))
 ;    (format #t "STEM ~A, ACCMAP ~S, SUFFIX: ~A~%" stem accmap suffix)
@@ -389,5 +402,6 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 	      (cond
 	       ((verb-get vinfo (symbol->keyword
-				 (string->symbol (number->string person)))) =>
+				 (string->symbol
+				  (number->string person)))) =>
 		(lambda (personal-form)
 		  personal-form))
@@ -415,10 +429,12 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 		 flect))
 	       ((char=? acc #\s)
-		(let ((nsyl (elstr-number-of-syllables flect)))
+		(let ((nsyl (elstr-number-of-syllables flect))
+		      (result (elstr-append stem suffix flect)))
 		  (elstr-set-accent
-		   (elstr-append stem suffix flect)
-		   (if (< nsyl 2)
-		       (+ nsyl 1)
-		       3))))
+		   result
+		   (min (if (< nsyl 2)
+			    (+ nsyl 1)
+			    3)
+			(elstr-number-of-syllables result)))))
 	       ((char=? acc #\-)
 		#f)
@@ -427,6 +443,7 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 		  (let ((obj (elstr-append
 			      stem suffix flect)))
-		    (if (and augment (= (+ (elstr-number-of-syllables obj) 1)
-					num))
+		    (if (and augment
+			     (= (+ (elstr-number-of-syllables obj) 1)
+				num))
 			(set! obj (elstr-append augment obj)))
 		    (let ((nsyl (elstr-number-of-syllables obj)))
@@ -454,8 +471,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 (define (individual-verb verb voice mood tense)
   (let ((res (ellinika:sql-query
-	      "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
-FROM individual_verb i,verbflect f \
-WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
-AND i.tense=\"~A\" AND i.ident=f.ident"
+	      "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3\
+ FROM individual_verb i,verbflect f\
+ WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
+ AND i.tense=\"~A\" AND i.ident=f.ident"
 	      verb voice mood tense)))
     (if (not (null? res))
@@ -478,6 +495,10 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
    (else
     (let* ((vinfo (load-verb-info verb voice mood tense))
-	   (conj-list (get-conj-info (verb-get vinfo #:conj)
-				     voice mood tense)))
+	   (conj-list (get-conj-info (or
+				      (verb-get vinfo #:class)
+				      (verb-get vinfo #:conj))
+				     voice mood tense))
+	   (verb (force-string (verb-get vinfo #:verb))))
+      (format #t "VINFO ~A~%" vinfo)
       (if (not conj-list)
 	  (list (list #f #f #f #f #f #f #f #f))
@@ -579,17 +600,22 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
 						 (car (cdr thema)))
 					     (car thema))))
-;		    (format #t "VINFO ~A~%" vinfo)
 
-		 (fold
-		  (lambda (stem prev)
-		    (cons
-		     (cons
-		      (append (apply-flect conj vinfo verb stem)
-			      (list (verb-get vinfo #:conj)
-				    (verb-get vinfo #:attested)))
-		      (conj-info #:fold conj))
-		     prev))
-		  prev
-		  (verb-get vinfo #:stem))))))
+ 		 (fold
+ 		  (lambda (suffix prev)
+ 		    (append
+ 		     (fold
+ 		      (lambda (stem prev)
+ 			(cons
+ 			 (cons
+ 			  (append (apply-flect conj vinfo verb stem suffix)
+ 				  (list (verb-get vinfo #:conj)
+ 					(verb-get vinfo #:attested)))
+ 			  (conj-info #:fold conj))
+ 			 prev))
+ 		      '()
+ 		      (verb-get vinfo #:stem))
+ 		     prev))
+ 		  prev
+ 		  (get-suffix conj vinfo))))))
 	   '()
 	   conj-list))))))))
@@ -630,3 +656,2 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
        conj)
       (return #t)))))
-