aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--data/irregular-verbs.xml1
-rw-r--r--scm/verbop.scm32
-rw-r--r--src/cgi-bin/conj.scm43
-rw-r--r--src/ellinika/conjugator.scm73
-rw-r--r--src/ellinika/sql.scm2
5 files changed, 72 insertions, 39 deletions
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml
index 2e604e3..1923d88 100644
--- a/data/irregular-verbs.xml
+++ b/data/irregular-verbs.xml
@@ -466,2 +466,3 @@
<root theme="aor">ειπώθ</root>
+ <root theme="aor">λεχθ</root>
<ind>
diff --git a/scm/verbop.scm b/scm/verbop.scm
index 0fff38f..8308d70 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -132,6 +132,14 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@"
(define (conjugation-set key val)
- (set! conjugation
- (if conjugation
- (append conjugation (list (cons key val)))
- (list (cons key val)))))
+ (let ((elt (cond
+ ((not (eq? key #:root))
+ (cons key val))
+ ((and conjugation (assoc (car val) conjugation)) =>
+ (lambda (entry)
+ (set-cdr! entry (cons (cdr val) (cdr entry)))))
+ (else
+ (cons key (list val))))))
+ (set! conjugation
+ (if conjugation
+ (append conjugation (list elt))
+ (list elt)))))
@@ -224,10 +232,12 @@ VALUES (~Q,~Q,~Q,~Q,~Q)"
(if (eq? (car mood) #:root)
- (let ((val (cdr mood)))
- (ellinika:sql-query
- "INSERT INTO irregular_root (verb,voice,thema,root) \
+ (for-each
+ (lambda (val)
+ (ellinika:sql-query
+ "INSERT INTO irregular_root (verb,voice,thema,root) \
VALUES (~Q,~Q,~Q,~Q)"
- (verb-get #:verb)
- vstr
- (car val)
- (cdr val)))
+ (verb-get #:verb)
+ vstr
+ (car val)
+ (cdr val)))
+ (cdr mood))
(let ((mood-str (car mood)))
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
@@ -330,2 +330,4 @@ ifelse(IFACE,[CGI],(cgi:init))
(search-failure key))
+ ((= (length result) 1)
+ (show-conjugation (caar result)))
(else
@@ -409,2 +411,3 @@ ifelse(IFACE,[CGI],(cgi:init))
(lambda ()
+ (format #t "<!-- ~A -->" (environ))
(dict-connect)
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
@@ -49,3 +49,6 @@
(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
@@ -103,17 +106,29 @@ 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))))))))
@@ -194,3 +209,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(verb-set! vinfo #:attested 'root)
- (caar result))
+ (map car result))
((string=? (verb-get vinfo #:conj) "A")
@@ -359,6 +374,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
-(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)))
@@ -554,9 +568,14 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
; (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))))))
'()
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
@@ -46,3 +46,3 @@
((number? arg) (number->string arg))
- ((bool? arg) (if arg "true" "false"))
+ ((boolean? arg) (if arg "true" "false"))
(else

Return to:

Send suggestions and report system problems to the System administrator.