From b6bbb4f2cf0144aa58701cd2b46277838743a277 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Mon, 20 Jun 2011 17:06:59 +0300
Subject: Allow for alternative stems in a same tense.

* data/irregular-verbs.xml: Add alternative passive aorist stem
for "lev".
* scm/verbop.scm (conjugation-set): When setting #:root,
keep a list of alternative stems.
(flush-mood): Update for changes in #:root storage.
* src/cgi-bin/conj.scm4 (show-best-matches): If only one
match is produced, show it immediately.
* src/ellinika/conjugator.scm: Allow for multiple stems.
* src/ellinika/sql.scm (->string): Bugfix.
---
 src/cgi-bin/conj.scm4       |  3 ++
 src/ellinika/conjugator.scm | 73 ++++++++++++++++++++++++++++-----------------
 src/ellinika/sql.scm        |  2 +-
 3 files changed, 50 insertions(+), 28 deletions(-)

(limited to 'src')

diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
index fec7eca..8c5e317 100644
--- a/src/cgi-bin/conj.scm4
+++ b/src/cgi-bin/conj.scm4
@@ -328,6 +328,8 @@ ifelse(IFACE,[CGI],(cgi:init))
     (cond
      ((null? result)
       (search-failure key))
+     ((= (length result) 1)
+      (show-conjugation (caar result)))
      (else
       (format #t
 	      "<div class=\"error\"><p>~A</p></div>"
@@ -407,6 +409,7 @@ ifelse(IFACE,[CGI],(cgi:init))
 			    (cgi:names))))
 		   (cons "@@conj@@"
 			 (lambda ()
+			   (format #t "<!-- ~A -->" (environ))
 			   (dict-connect)
 			   (main-form)
 			   (do-conj)
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm
index 0abec8d..f70e20c 100644
--- a/src/ellinika/conjugator.scm
+++ b/src/ellinika/conjugator.scm
@@ -47,7 +47,10 @@
     ((#:attested)
      (list-set! verb 3 (append (list-ref verb 3) (list value))))
     (else
-     (let ((container (assoc key (list-ref verb 2))))
+     (let ((container (assoc key (list-ref verb 2)))
+	   (value (if (and (eq? key #:root) (not (list? value)))
+		      (list value)
+		      value)))
        (if container
 	   (set-cdr! container value)
 	   (list-set! verb 2 (append (list-ref verb 2)
@@ -101,21 +104,33 @@
 		   "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
-			    (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)))))
-    
+    (create-basic-verb-info
+     verb
+     (let loop ((inlist (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)))
+		(rootlist '())
+		(outlist '()))
+;       (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist)
+       (cond
+	((null? inlist)
+	 (if (null? rootlist)
+	     outlist
+	     (cons (cons #:root rootlist) outlist)))
+	((eq? (caar inlist) #:root)
+	 (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist))
+	(else
+	 (loop (cdr inlist) rootlist (cons (car inlist) outlist))))))))
 	
 (define (thema-aoristoy-mesapathitikis-A root)
   (cond
@@ -192,7 +207,7 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
 	       (cond
 		((not (null? result))
 		 (verb-set! vinfo #:attested 'root)
-		 (caar result))
+		 (map car result))
 		((string=? (verb-get vinfo #:conj) "A")
 		 (let ((root (verb-A-root elverb)))
 		   (cond
@@ -357,10 +372,9 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
 	    (conj-info #:accmap conj)
 	    "000000"))))
 	
-(define (apply-flect conj vinfo verb)
+(define (apply-flect conj vinfo verb root)
 ;  (format #t "VINFO ~A~%" vinfo)
-  (let ((root (verb-get vinfo #:root))
-	(suffix (get-suffix conj vinfo))
+  (let ((suffix (get-suffix conj vinfo))
 	(accmap (string->list (get-accmap conj vinfo)))
 	(augment ""))
 ;    (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix)
@@ -552,13 +566,18 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
 						 (car (cdr thema)))
 					     (car thema))))
 ;		    (format #t "VINFO ~A~%" vinfo)
-		 (cons
-		  (cons
-		   (append (apply-flect conj vinfo verb)
-			   (list (verb-get vinfo #:conj)
-				 (verb-get vinfo #:attested)))
-		   (conj-info #:fold conj))
-		  prev)))))
+
+		 (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 #:root))))))
 	   '()
 	   conj-list))))))))
 
diff --git a/src/ellinika/sql.scm b/src/ellinika/sql.scm
index 5867d28..f281847 100644
--- a/src/ellinika/sql.scm
+++ b/src/ellinika/sql.scm
@@ -44,7 +44,7 @@
    ((string? arg) arg)
    ((elstr? arg) (elstr->string arg))
    ((number? arg) (number->string arg))
-   ((bool? arg) (if arg "true" "false"))
+   ((boolean? arg) (if arg "true" "false"))
    (else
     (error "Unhandled argument type: ~S" arg))))
       
-- 
cgit v1.2.1