aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-21 12:13:02 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2011-06-21 12:13:02 +0300
commit119c79bd50659612a9126f6793bd57b48792cb11 (patch)
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')
-rw-r--r--src/ellinika/conjugator.scm99
1 files changed, 62 insertions, 37 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,7 +360,7 @@ 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)))
@@ -357,7 +370,8 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
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,19 +428,22 @@ 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
446 (= (+ (elstr-number-of-syllables obj) 1)
430 num)) 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)))
@@ -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)