diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-21 12:13:02 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-21 12:13:02 +0300 |
commit | 119c79bd50659612a9126f6793bd57b48792cb11 (patch) | |
tree | 2c282cd1010fd9c913a3aade777f8c9dd8c8ed3b /src/ellinika | |
parent | cc53aa452ef0caca75931a126860500d3bd67f04 (diff) | |
download | ellinika-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.scm | 99 |
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 \ |
105 | verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | 105 | verb=\"~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) |