summaryrefslogtreecommitdiffabout
path: root/src/ellinika
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-21 09:13:02 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-21 09:13:02 (GMT)
commit119c79bd50659612a9126f6793bd57b48792cb11 (patch) (unidiff)
tree2c282cd1010fd9c913a3aade777f8c9dd8c8ed3b /src/ellinika
parentcc53aa452ef0caca75931a126860500d3bd67f04 (diff)
downloadellinika-119c79bd50659612a9126f6793bd57b48792cb11.tar.gz
ellinika-119c79bd50659612a9126f6793bd57b48792cb11.tar.bz2
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.
Diffstat (limited to 'src/ellinika') (more/less context) (ignore whitespace changes)
-rw-r--r--src/ellinika/conjugator.scm147
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
@@ -46,6 +46,8 @@
46 (list-set! verb 1 value)) 46 (list-set! verb 1 value))
47 ((#:attested) 47 ((#:attested)
48 (list-set! verb 3 (append (list-ref verb 3) (list value)))) 48 (list-set! verb 3 (append (list-ref verb 3) (list value))))
49 ((#:proplist)
50 (list-set! verb 2 value))
49 (else 51 (else
50 (let ((container (assoc key (list-ref verb 2))) 52 (let ((container (assoc key (list-ref verb 2)))
51 (value (if (and (eq? key #:stem) (not (list? value))) 53 (value (if (and (eq? key #:stem) (not (list? value)))
@@ -78,8 +80,7 @@
78 ;; FIXME: deponentia? 80 ;; FIXME: deponentia?
79 (else "A"))) 81 (else "A")))
80 82
81(define (create-basic-verb-info verb proplist . rest) 83(define (create-basic-verb-info verb . rest)
82; (format #t "PROPLIST ~A~%" proplist)
83 (let ((vdb (if (null? rest) 84 (let ((vdb (if (null? rest)
84 (ellinika:sql-query 85 (ellinika:sql-query
85 "SELECT conj FROM verbclass WHERE verb=\"~A\"" 86 "SELECT conj FROM verbclass WHERE verb=\"~A\""
@@ -89,23 +90,22 @@
89 verb (car rest))))) 90 verb (car rest)))))
90 (cond 91 (cond
91 ((and vdb (not (null? vdb))) 92 ((and vdb (not (null? vdb)))
92 (list (caar vdb) verb proplist '(class))) 93 (list (caar vdb) verb '() '(class)))
93 ((elstr-suffix? verb "άω") 94 ((elstr-suffix? verb "άω")
94 (create-basic-verb-info (elstr-append 95 (create-basic-verb-info (elstr-append
95 (elstr-trim verb -2) "ώ") proplist "B1")) 96 (elstr-trim verb -2) "ώ") "B1"))
96 ((null? rest) 97 ((null? rest)
97 (list (guess-verb-class verb) verb proplist '())) 98 (list (guess-verb-class verb) verb '() '()))
98 (else 99 (else
99 (list (car rest) verb '() '()))))) 100 (list (car rest) verb '() '())))))
100 101
101(define (load-verb-info verb voice mood tense) 102(define (load-proplist vinfo voice mood tense)
102; (format #t "LOAD ~A~%" verb)
103 (let ((verbprop (ellinika:sql-query 103 (let ((verbprop (ellinika:sql-query
104 "SELECT property,value FROM verbtense WHERE \ 104 "SELECT property,value FROM verbtense WHERE \
105verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" 105verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
106 verb voice mood tense))) 106 (verb-get vinfo #:verb) voice mood tense)))
107 (create-basic-verb-info 107 (verb-set!
108 verb 108 vinfo #:proplist
109 (let loop ((inlist (if (null? verbprop) 109 (let loop ((inlist (if (null? verbprop)
110 '() 110 '()
111 (map 111 (map
@@ -120,17 +120,31 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
120 value)))) 120 value))))
121 verbprop))) 121 verbprop)))
122 (stemlist '()) 122 (stemlist '())
123 (suflist '())
123 (outlist '())) 124 (outlist '()))
124; (format #t "ARGS: ~A/~A/~A~%" inlist stemlist outlist) 125; (format #t "ARGS: ~A/~A/~A~%" inlist stemlist outlist)
125 (cond 126 (cond
126 ((null? inlist) 127 ((null? inlist)
127 (if (null? stemlist) 128 (append
128 outlist 129 (if (not (null? stemlist))
129 (cons (cons #:stem stemlist) outlist))) 130 (list (cons #:stem stemlist))
131 '())
132 (if (not (null? suflist))
133 (list (cons #:suffix suflist))
134 '())
135 outlist))
130 ((eq? (caar inlist) #:stem) 136 ((eq? (caar inlist) #:stem)
131 (loop (cdr inlist) (cons (cdar inlist) stemlist) outlist)) 137 (loop (cdr inlist) (cons (cdar inlist) stemlist) suflist outlist))
138 ((eq? (caar inlist) #:suffix)
139 (loop (cdr inlist) stemlist (cons (cdar inlist) suflist) outlist))
132 (else 140 (else
133 (loop (cdr inlist) stemlist (cons (car inlist) outlist)))))))) 141 (loop (cdr inlist) stemlist suflist (cons (car inlist) outlist))))))))
142
143(define (load-verb-info verb voice mood tense)
144; (format #t "LOAD ~A~%" verb)
145 (let ((vinfo (create-basic-verb-info verb)))
146 (load-proplist vinfo voice mood tense)
147 vinfo))
134 148
135(define (thema-aoristoy-mesapathitikis-A stem) 149(define (thema-aoristoy-mesapathitikis-A stem)
136 (cond 150 (cond
@@ -239,11 +253,10 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
239 (verb-set! vinfo #:attested 'stem) 253 (verb-set! vinfo #:attested 'stem)
240 stem) 254 stem)
241 ((or (string=? thema "aor") (string=? thema "sub")) 255 ((or (string=? thema "aor") (string=? thema "sub"))
242 (thema-aoristoy-mesapathitikis-B 256 (map
243 stem 257 (lambda (aor)
244 (list-ref 258 (thema-aoristoy-mesapathitikis-B stem aor))
245 (conjugate verb "act" "ind" "Αόριστος") 259 (conjugate verb "act" "ind" "Αόριστος")))
246 0)))
247 (else 260 (else
248 #f)))) 261 #f))))
249 ((string=? (verb-get vinfo #:conj) "B2") 262 ((string=? (verb-get vinfo #:conj) "B2")
@@ -347,17 +360,18 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
347 360
348 361
349(define (get-suffix conj vinfo) 362(define (get-suffix conj vinfo)
350 (let ((override (verb-get vinfo #:override))) 363 (let ((ret (let ((override (verb-get vinfo #:override)))
351 (if (and override 364 (if (and override
352 (member "suffix" override)) 365 (member "suffix" override))
353 (let ((t (conj-info #:suffix conj))) 366 (let ((t (conj-info #:suffix conj)))
354 (if t 367 (if t
355 (or (verb-get vinfo #:suffix) 368 (or (verb-get vinfo #:suffix)
356 t) 369 t)
357 "")) 370 ""))
358 (or (verb-get vinfo #:suffix) 371 (or (verb-get vinfo #:suffix)
359 (conj-info #:suffix conj) 372 (conj-info #:suffix conj)
360 "")))) 373 "")))))
374 (if (list? ret) ret (list ret))))
361 375
362 376
363(define (get-accmap conj vinfo) 377(define (get-accmap conj vinfo)
@@ -372,10 +386,9 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
372 (conj-info #:accmap conj) 386 (conj-info #:accmap conj)
373 "000000")))) 387 "000000"))))
374 388
375(define (apply-flect conj vinfo verb stem) 389(define (apply-flect conj vinfo verb stem suffix)
376; (format #t "VINFO ~A~%" vinfo) 390; (format #t "VINFO ~A~%" vinfo)
377 (let ((suffix (get-suffix conj vinfo)) 391 (let ((accmap (string->list (get-accmap conj vinfo)))
378 (accmap (string->list (get-accmap conj vinfo)))
379 (augment "")) 392 (augment ""))
380; (format #t "STEM ~A, ACCMAP ~S, SUFFIX: ~A~%" stem accmap suffix) 393; (format #t "STEM ~A, ACCMAP ~S, SUFFIX: ~A~%" stem accmap suffix)
381 (cond 394 (cond
@@ -388,7 +401,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
388 (lambda (flect acc person) 401 (lambda (flect acc person)
389 (cond 402 (cond
390 ((verb-get vinfo (symbol->keyword 403 ((verb-get vinfo (symbol->keyword
391 (string->symbol (number->string person)))) => 404 (string->symbol
405 (number->string person)))) =>
392 (lambda (personal-form) 406 (lambda (personal-form)
393 personal-form)) 407 personal-form))
394 ((not flect) #f) 408 ((not flect) #f)
@@ -414,20 +428,23 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
414 (elstr-deaccent (elstr-append stem suffix)) 428 (elstr-deaccent (elstr-append stem suffix))
415 flect)) 429 flect))
416 ((char=? acc #\s) 430 ((char=? acc #\s)
417 (let ((nsyl (elstr-number-of-syllables flect))) 431 (let ((nsyl (elstr-number-of-syllables flect))
432 (result (elstr-append stem suffix flect)))
418 (elstr-set-accent 433 (elstr-set-accent
419 (elstr-append stem suffix flect) 434 result
420 (if (< nsyl 2) 435 (min (if (< nsyl 2)
421 (+ nsyl 1) 436 (+ nsyl 1)
422 3)))) 437 3)
438 (elstr-number-of-syllables result)))))
423 ((char=? acc #\-) 439 ((char=? acc #\-)
424 #f) 440 #f)
425 ((char-numeric? acc) 441 ((char-numeric? acc)
426 (let ((num (- (char->integer acc) (char->integer #\0)))) 442 (let ((num (- (char->integer acc) (char->integer #\0))))
427 (let ((obj (elstr-append 443 (let ((obj (elstr-append
428 stem suffix flect))) 444 stem suffix flect)))
429 (if (and augment (= (+ (elstr-number-of-syllables obj) 1) 445 (if (and augment
430 num)) 446 (= (+ (elstr-number-of-syllables obj) 1)
447 num))
431 (set! obj (elstr-append augment obj))) 448 (set! obj (elstr-append augment obj)))
432 (let ((nsyl (elstr-number-of-syllables obj))) 449 (let ((nsyl (elstr-number-of-syllables obj)))
433 (elstr-set-accent! obj (cond 450 (elstr-set-accent! obj (cond
@@ -453,10 +470,10 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
453 470
454(define (individual-verb verb voice mood tense) 471(define (individual-verb verb voice mood tense)
455 (let ((res (ellinika:sql-query 472 (let ((res (ellinika:sql-query
456 "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \ 473 "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3\
457FROM individual_verb i,verbflect f \ 474 FROM individual_verb i,verbflect f\
458WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\ 475 WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
459AND i.tense=\"~A\" AND i.ident=f.ident" 476 AND i.tense=\"~A\" AND i.ident=f.ident"
460 verb voice mood tense))) 477 verb voice mood tense)))
461 (if (not (null? res)) 478 (if (not (null? res))
462 (append (car res) 479 (append (car res)
@@ -477,8 +494,12 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
477 (list res))) 494 (list res)))
478 (else 495 (else
479 (let* ((vinfo (load-verb-info verb voice mood tense)) 496 (let* ((vinfo (load-verb-info verb voice mood tense))
480 (conj-list (get-conj-info (verb-get vinfo #:conj) 497 (conj-list (get-conj-info (or
481 voice mood tense))) 498 (verb-get vinfo #:class)
499 (verb-get vinfo #:conj))
500 voice mood tense))
501 (verb (force-string (verb-get vinfo #:verb))))
502 (format #t "VINFO ~A~%" vinfo)
482 (if (not conj-list) 503 (if (not conj-list)
483 (list (list #f #f #f #f #f #f #f #f)) 504 (list (list #f #f #f #f #f #f #f #f))
484 (map car 505 (map car
@@ -578,19 +599,24 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
578 voice 599 voice
579 (car (cdr thema))) 600 (car (cdr thema)))
580 (car thema)))) 601 (car thema))))
581 ; (format #t "VINFO ~A~%" vinfo)
582 602
583 (fold 603 (fold
584 (lambda (stem prev) 604 (lambda (suffix prev)
585 (cons 605 (append
586 (cons 606 (fold
587 (append (apply-flect conj vinfo verb stem) 607 (lambda (stem prev)
588 (list (verb-get vinfo #:conj) 608 (cons
589 (verb-get vinfo #:attested))) 609 (cons
590 (conj-info #:fold conj)) 610 (append (apply-flect conj vinfo verb stem suffix)
591 prev)) 611 (list (verb-get vinfo #:conj)
592 prev 612 (verb-get vinfo #:attested)))
593 (verb-get vinfo #:stem)))))) 613 (conj-info #:fold conj))
614 prev))
615 '()
616 (verb-get vinfo #:stem))
617 prev))
618 prev
619 (get-suffix conj vinfo))))))
594 '() 620 '()
595 conj-list)))))))) 621 conj-list))))))))
596 622
@@ -629,4 +655,3 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
629 (return #f))) 655 (return #f)))
630 conj) 656 conj)
631 (return #t))))) 657 (return #t)))))
632

Return to:

Send suggestions and report system problems to the System administrator.