aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--data/irregular-verbs.xml46
-rw-r--r--scm/verbop.scm57
-rw-r--r--src/cgi-bin/conj.scm412
-rw-r--r--src/ellinika/conjugator.scm147
4 files changed, 169 insertions, 93 deletions
diff --git a/data/irregular-verbs.xml b/data/irregular-verbs.xml
index 67d4126..312987e 100644
--- a/data/irregular-verbs.xml
+++ b/data/irregular-verbs.xml
@@ -201,7 +201,8 @@
<v>
<a>βαστώ</a>
<c>B1</c>
- <suffix>ηξ</suffix> <!-- also αξ -->
+ <suffix>ηξ</suffix>
+ <suffix>αξ</suffix>
</v>
<v>
@@ -514,11 +515,54 @@
</v>
<v>
+ <a>μπορώ</a>
+ <c>B2</c>
+ <suffix>εσ</suffix>
+ <pas/>
+ </v>
+
+ <v>
<a>ξέρω</a>
<c>A</c>
<augment>η</augment>
</v>
+ <!-- Unfinished -->
+ <v>
+ <a>πάω</a>
+ <c>B1</c>
+ <act>
+ <ind>
+ <t name="Ενεστώτας">
+ <p n="s" p="1" prop="true">πάω</p>
+ <p n="s" p="3" prop="true">πάει</p>
+ <p n="p" p="1" prop="true">πάμε</p>
+ <p n="p" p="3" prop="true">πάνε,παν</p>
+ </t>
+ <t name="Παρατατικός">
+ <prop name="stem">πήγαιν</prop>
+ <prop name="class">A</prop>
+ </t>
+ <t name="Αόριστος">
+ <suffix/>
+ </t>
+ </ind>
+ <sub>
+ <t name="Ενεστώτας">
+ <prop name="stem">πήγαιν</prop>
+ <prop name="class">A</prop>
+ </t>
+ <t name="Αόριστος">
+ <prop name="stem">πά</prop>
+ <prop name="class">A</prop>
+ <suffix/>
+ </t>
+ </sub>
+ <stem theme="aor">πηγ</stem>
+ </act>
+ <pas/>
+ </v>
+
<v>
<a>παθαίνω</a>
<c>A</c>
diff --git a/scm/verbop.scm b/scm/verbop.scm
index 464c384..0ad0f90 100644
--- a/scm/verbop.scm
+++ b/scm/verbop.scm
@@ -175,7 +175,15 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (command-line))" "$@"
(define (verb-set what val)
(if (null? verbdef)
(verb-init))
- (list-set! verbdef (verbdef:index what) val))
+ (let ((val (cond
+ ((not (eq? what #:suffix))
+ val)
+ ((list-ref verbdef (verbdef:index what)) =>
+ (lambda (entry)
+ (cons val entry)))
+ (else
+ (list val)))))
+ (list-set! verbdef (verbdef:index what) val)))
(define (verb-init)
(set! verbdef (make-list 9 #f))
@@ -331,27 +339,31 @@ VALUES (~Q,~Q,~Q,~Q)"
; (format #t "MOOD ~A~%" mood-ref)
(for-each
(lambda (tense-name)
- (let* ((tense (or (assoc tense-name (cdr mood-ref))
- (begin
- (append!
- mood-ref
- (list
- (cons tense-name
- (append
- (make-list 6 #f)
- (list
- (cons "default" #t))))))
-; (format #t "NM ~A~%" mood-ref)
- (assoc tense-name
- (cdr mood-ref)))))
+ (let* ((tense
+ (or (assoc tense-name (cdr mood-ref))
+ (begin
+ (append!
+ mood-ref
+ (list
+ (cons tense-name
+ (append
+ (make-list 6 #f)
+ (list
+ (cons "default" #t))))))
+; (format #t "NM ~A~%" mood-ref)
+ (assoc tense-name
+ (cdr mood-ref)))))
(prop (begin
-; (format #t "TENSE ~A~%" tense)
+; (format #t "TENSE ~A~%" tense)
(list-tail tense 7))))
-; (format #t "PROP ~A ~A~%" tense prop)
+; (format #t "PROP ~A ~A~%" tense prop)
(if (not (assoc attr prop))
- (append! tense
- (list
- (cons attr value))))))
+ (for-each
+ (lambda (value)
+ (append! tense
+ (list
+ (cons attr value))))
+ (if (list? value) value (list value))))))
(cdr mood-tenses))))
mtlist)))))
attrlist))
@@ -506,12 +518,7 @@ VALUES (~Q,~Q,~Q,~Q)"
(tag attr text)
(cond
((xmltrans:parent? "v")
- (cond
- ((verb-get #:suffix)
- (xmltrans:parse-error #f "Suffix was already defined")
- (mark-invalid))
- (else
- (verb-set #:suffix text))))
+ (verb-set #:suffix text))
((xmltrans:parent? "t")
(set! tense-prop (cons (cons "suffix" text) tense-prop)))
(else
diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
index 1894485..a8d84f1 100644
--- a/src/cgi-bin/conj.scm4
+++ b/src/cgi-bin/conj.scm4
@@ -105,10 +105,10 @@ ifelse(IFACE,[CGI],(cgi:init))
(cdr tense))))
(display "<th>")
(cond
- ((not (member 'root att))
- (display "<a href=\"#root-na\">?</a>&nbsp;")
- (if (not (member 'root unattested))
- (set! unattested (cons 'root unattested)))))
+ ((not (member 'stem att))
+ (display "<a href=\"#stem-na\">?</a>&nbsp;")
+ (if (not (member 'stem unattested))
+ (set! unattested (cons 'stem unattested)))))
(display tense-name)
(display "</th>")
(newline)))
@@ -145,7 +145,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(fold
(lambda (elt prev)
(if prev
- (string-append prev "," elt)
+ (string-append prev ",<br>" elt)
elt))
#f
lst))
@@ -385,7 +385,7 @@ ifelse(IFACE,[CGI],(cgi:init))
(print-footnote "class-na" "*"
"Conjugation class of this verb is not attested"))
((root)
- (print-footnote "root-na" "?"
+ (print-footnote "stem-na" "?"
(_ "Το θέμα αυτού του χρόνου δεν επιβεβαιώνεται από τη βάση δεδοµένων")))))
unattested)
(display "</div>"))
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
@@ -46,6 +46,8 @@
(list-set! verb 1 value))
((#: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)))
(value (if (and (eq? key #:stem) (not (list? value)))
@@ -78,8 +80,7 @@
;; FIXME: deponentia?
(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
"SELECT conj FROM verbclass WHERE verb=\"~A\""
@@ -89,23 +90,22 @@
verb (car rest)))))
(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)
'()
(map
@@ -120,17 +120,31 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
value))))
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)
(cond
@@ -239,11 +253,10 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(verb-set! vinfo #:attested 'stem)
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))))
((string=? (verb-get vinfo #:conj) "B2")
@@ -347,17 +360,18 @@ 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))))
(define (get-accmap conj vinfo)
@@ -372,10 +386,9 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(conj-info #:accmap conj)
"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)
(cond
@@ -388,7 +401,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(lambda (flect acc person)
(cond
((verb-get vinfo (symbol->keyword
- (string->symbol (number->string person)))) =>
+ (string->symbol
+ (number->string person)))) =>
(lambda (personal-form)
personal-form))
((not flect) #f)
@@ -414,20 +428,23 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(elstr-deaccent (elstr-append stem suffix))
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)
((char-numeric? acc)
(let ((num (- (char->integer acc) (char->integer #\0))))
(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)))
(elstr-set-accent! obj (cond
@@ -453,10 +470,10 @@ 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))
(append (car res)
@@ -477,8 +494,12 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(list res)))
(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))
(map car
@@ -578,19 +599,24 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
voice
(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))))))))
@@ -629,4 +655,3 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(return #f)))
conj)
(return #t)))))
-

Return to:

Send suggestions and report system problems to the System administrator.