aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-20 17:06:59 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-20 17:06:59 +0300
commitb6bbb4f2cf0144aa58701cd2b46277838743a277 (patch)
tree1e9bcd3bd7871f2d38ee804b8d803f85317c788b
parent554d5663361e1506a757e7639524ce4d461d043c (diff)
downloadellinika-b6bbb4f2cf0144aa58701cd2b46277838743a277.tar.gz
ellinika-b6bbb4f2cf0144aa58701cd2b46277838743a277.tar.bz2
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.
-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
@@ -455,24 +455,25 @@
<imp>
<t name="Ενεστώτας">
<prop name="root">λέγ</prop>
</t>
<t name="Αόριστος">
<p n="s" p="2">πες</p>
<p n="p" p="2">πείτε,πέστε</p>
</t>
</imp>
</act>
<pas>
<root theme="aor">ειπώθ</root>
+ <root theme="aor">λεχθ</root>
<ind>
<t name="Ενεστώτας">
<prop name="root">λέγ</prop>
</t>
<t name="Παρατατικός">
<prop name="root">λέγ</prop>
</t>
</ind>
<imp>
<t name="Ενεστώτας">
<prop name="root">λέγ</prop>
</t>
diff --git a/scm/verbop.scm b/scm/verbop.scm
index 0fff38f..8308d70 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -121,28 +121,36 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@"
(set! mood (append mood (list (cons key val)))))
;;; Conjugation is an associative list of moods
(define conjugation #f)
(define (get-conjugation)
(let ((ret conjugation))
(set! conjugation #f)
ret))
(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)))))
;;; Verb structure:
(define verbdef '())
(define (verbdef:index c)
(case c
((#:verb) 0)
((#:class) 1)
((#:action) 2)
((#:augment) 3)
((#:suffix) 4)
@@ -213,32 +221,34 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@"
(define (insert-individual-verb voice mood tense ident)
(ellinika:sql-query
"INSERT INTO individual_verb (verb,voice,mood,tense,ident) \
VALUES (~Q,~Q,~Q,~Q,~Q)"
(verb-get #:verb)
voice
mood
tense
ident))
(define (flush-mood mood vstr)
(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)))
(let ((lst (cdr mood)))
(cond
((null? lst)
(for-each
(lambda (tense)
(insert-individual-verb vstr mood-str tense 0))
(assoc-ref ellinika-tense-list mood-str)))
(else
; (format #t "LST ~A~%" lst)
(for-each
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
@@ -319,24 +319,26 @@ ifelse(IFACE,[CGI],(cgi:init))
(display "</a>"))
(define (show-best-matches key)
(let ((result (ellinika:sql-query
"SELECT DISTINCT word\
FROM dict\
WHERE sound LIKE ~Q\
AND (pos & 1048576) <> 0 ORDER BY 1"
(ellinika:sounds-like key))))
(cond
((null? result)
(search-failure key))
+ ((= (length result) 1)
+ (show-conjugation (caar result)))
(else
(format #t
"<div class=\"error\"><p>~A</p></div>"
(_ "Στην λέξη εισαγωγής δεν υπάρχει τόνος. Μήπος θέλατε να κλίσετε ένα απ'αυτά τα ρήματα:"))
(display "<table width=\"100%\" class=\"noframe\">")
(let* ((result-length (length result))
(lim (1+ (quotient result-length match-list-columns))))
(do ((i 0 (1+ i)))
((= i lim) #f)
(display "<tr>")
(do ((j i (+ j lim)))
((>= j result-length) #f)
@@ -398,24 +400,25 @@ ifelse(IFACE,[CGI],(cgi:init))
(cond
((string=? name "lang"))
(else
(let ((v (cgi:value name)))
(cond ((and v (not (string-null? v)))
(display "&amp;")
(display name)
(display "=")
(display v)))))))
(cgi:names))))
(cons "@@conj@@"
(lambda ()
+ (format #t "<!-- ~A -->" (environ))
(dict-connect)
(main-form)
(do-conj)
(if (not (null? unattested))
(footnotes)))))))
(do ((line (read-line) (read-line)))
((eof-object? line) #f)
(expand-template explist line)
(newline))
(ellinika:sql-disconnect))))
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
@@ -38,25 +38,28 @@
;; attested
(define (verb-set! verb key value)
; (format #t "VERB ~A KEY ~A VALUE ~A~%" verb key value)
(case key
((#:conj)
(list-set! verb 0 value))
((#:verb)
(list-set! verb 1 value))
((#: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)
(list
(cons key value)))))))))
(define (verb-get verb key)
(case key
((#:conj)
(list-ref verb 0))
((#:verb)
@@ -92,39 +95,51 @@
(elstr-trim verb -2) "ώ") proplist "B1"))
((null? rest)
(list (guess-verb-class verb) verb proplist '()))
(else
(list (car rest) verb '() '())))))
(define (load-verb-info verb voice mood tense)
; (format #t "LOAD ~A~%" verb)
(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
- (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
((elstr-suffix? root "αίν")
(elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ
((and
(elstr-suffix? root "ν")
(logand (elstr-char-prop-bitmask root -2) elmorph:vowel))
(elstr-append (elstr-trim root -1) "θ")) ;; FIXME: also στ, νθ, θ
((and
(elstr-suffix? root "δ" "θ" "ζ" "ν") ;; FIXME: see above
(logand (elstr-char-prop-bitmask root -2) elmorph:vowel))
@@ -183,25 +198,25 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(define (complement-verb-info vinfo verb voice thema)
; (format #t "COMPLEMENT ~A~%" vinfo)
(let ((elverb (string->elstr verb))
(result (let ((tmpres (lookup-verb-info verb voice thema)))
(if (and (null? tmpres) (string=? thema "sub"))
(lookup-verb-info verb voice "aor")
tmpres))))
(verb-set! vinfo #:root
(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
((string=? thema "pres")
(verb-set! vinfo #:attested 'root)
root)
((or (string=? thema "aor") (string=? thema "sub"))
(if (string=? voice "act")
(elstr-thema-aoristoy root)
(thema-aoristoy-mesapathitikis-A root)))
(else
#f))))
@@ -348,28 +363,27 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(define (get-accmap conj vinfo)
(let ((override (verb-get vinfo #:override)))
(if (and override
(member "accmap" override))
(let ((t (conj-info #:accmap conj)))
(if t
(or (verb-get vinfo #:accmap)
t)))
(or (verb-get vinfo #:accmap)
(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)
(cond
((> (length accmap) 6)
(set! accmap (list-head accmap 6))
(set! augment (or (verb-get vinfo #:augment) "ε"))))
; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment))
(let ((forms
(map
(lambda (flect acc person)
(cond
@@ -543,31 +557,36 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(else
(let ((vinfo (copy-tree vinfo)))
(if (verb-get vinfo #:root)
(verb-set! vinfo #:attested '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)
- (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))))))))
(define-public (conjugator verb voice mood tense)
(conjugate verb voice mood tense))
(define-public (conjugation:table conj)
(cond
((not conj)
#f)
(else
(list-head conj 6))))
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
@@ -35,25 +35,25 @@
(sql-query ellinika:sql-conn "SET NAMES utf8"))
ellinika:sql-conn)))
(define-public (ellinika:sql-disconnect)
(if ellinika:sql-conn (sql-close-connection ellinika:sql-conn)))
(define (->string arg)
(cond
((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))))
;; Format specifiers:
;; ~A - escaped string
;; ~Q - escaped and quoted string; NULL if argument is #f
;; ~N - unescaped number
;; ~<anychar> - <anychar>
(define-public (ellinika:format-sql-query fmt args)
(let* ((fmtlist (string-split fmt #\~))
(segments (reverse

Return to:

Send suggestions and report system problems to the System administrator.