diff options
Diffstat (limited to 'src/ellinika/conjugator.scm')
-rw-r--r-- | src/ellinika/conjugator.scm | 354 |
1 files changed, 189 insertions, 165 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index bffc6be..eae4ad0 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm | |||
@@ -39,3 +39,3 @@ | |||
39 | 39 | ||
40 | (define (verb-set! verb key value) | 40 | (define (vinfo-set! verb key value) |
41 | ; (format #t "VERB ~A KEY ~A VALUE ~A~%" verb key value) | 41 | ; (format #t "VERB ~A KEY ~A VALUE ~A~%" verb key value) |
@@ -62,3 +62,3 @@ | |||
62 | 62 | ||
63 | (define (verb-get verb key) | 63 | (define (vinfo-get verb key) |
64 | (case key | 64 | (case key |
@@ -105,4 +105,4 @@ | |||
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-get vinfo #:verb) voice mood tense))) | 106 | (vinfo-get vinfo #:verb) voice mood tense))) |
107 | (verb-set! | 107 | (vinfo-set! |
108 | vinfo #:proplist | 108 | vinfo #:proplist |
@@ -196,2 +196,7 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | |||
196 | 196 | ||
197 | (define (thema-aoristou-prostaktikhs stem) | ||
198 | (if (elstr-suffix? stem "β" "γ" "θ" "ν") | ||
199 | (elstr-append stem "ε") | ||
200 | stem)) | ||
201 | |||
197 | (define (lookup-verb-info verb voice thema) | 202 | (define (lookup-verb-info verb voice thema) |
@@ -212,2 +217,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
212 | 217 | ||
218 | ;; FIXME: Use vinfo #:verb instead of the verb argument. | ||
213 | (define (complement-verb-info vinfo verb voice thema) | 219 | (define (complement-verb-info vinfo verb voice thema) |
@@ -219,8 +225,8 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
219 | tmpres)))) | 225 | tmpres)))) |
220 | (verb-set! vinfo #:stem | 226 | (vinfo-set! vinfo #:stem |
221 | (cond | 227 | (cond |
222 | ((not (null? result)) | 228 | ((not (null? result)) |
223 | (verb-set! vinfo #:attested 'stem) | 229 | (vinfo-set! vinfo #:attested 'stem) |
224 | (map car result)) | 230 | (map car result)) |
225 | ((string=? (verb-get vinfo #:conj) "A") | 231 | ((string=? (vinfo-get vinfo #:conj) "A") |
226 | (let ((stem (verb-A-stem elverb))) | 232 | (let ((stem (verb-A-stem elverb))) |
@@ -228,11 +234,16 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
228 | ((string=? thema "pres") | 234 | ((string=? thema "pres") |
229 | (verb-set! vinfo #:attested 'stem) | 235 | (vinfo-set! vinfo #:attested 'stem) |
230 | stem) | 236 | stem) |
231 | ((or (string=? thema "aor") (string=? thema "sub")) | 237 | ((or (string=? thema "aor") (string=? thema "sub")) |
232 | (if (string=? voice "act") | 238 | (cond |
233 | (elstr-thema-aoristoy stem) | 239 | ((string=? voice "act") |
234 | (thema-aoristoy-mesapathitikis-A stem))) | 240 | (elstr-thema-aoristoy stem)) |
241 | ((string=? voice "pas") | ||
242 | (thema-aoristoy-mesapathitikis-A stem)) | ||
243 | (else | ||
244 | (throw 'conjugator-error 'conjugator-error-db | ||
245 | "invalid voice ~A" (list voice))))) | ||
235 | (else | 246 | (else |
236 | #f)))) | 247 | #f)))) |
237 | ((string=? (verb-get vinfo #:conj) "A-depon") | 248 | ((string=? (vinfo-get vinfo #:conj) "A-depon") |
238 | (let ((stem (verb-A-stem elverb))) | 249 | (let ((stem (verb-A-stem elverb))) |
@@ -240,3 +251,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
240 | ((string=? thema "pres") | 251 | ((string=? thema "pres") |
241 | (verb-set! vinfo #:attested 'stem) | 252 | (vinfo-set! vinfo #:attested 'stem) |
242 | stem) | 253 | stem) |
@@ -246,3 +257,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
246 | #f)))) | 257 | #f)))) |
247 | ((string=? (verb-get vinfo #:conj) "B1") | 258 | ((string=? (vinfo-get vinfo #:conj) "B1") |
248 | (let ((stem (if (elstr-suffix? elverb "άω") | 259 | (let ((stem (if (elstr-suffix? elverb "άω") |
@@ -252,3 +263,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
252 | ((or (string=? voice "act") (string=? thema "pres")) | 263 | ((or (string=? voice "act") (string=? thema "pres")) |
253 | (verb-set! vinfo #:attested 'stem) | 264 | (vinfo-set! vinfo #:attested 'stem) |
254 | stem) | 265 | stem) |
@@ -258,6 +269,6 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
258 | (thema-aoristoy-mesapathitikis-B stem aor)) | 269 | (thema-aoristoy-mesapathitikis-B stem aor)) |
259 | (conjugate verb "act" "ind" "Αόριστος"))) | 270 | (conjugate vinfo "act" "ind" "Αόριστος"))) |
260 | (else | 271 | (else |
261 | #f)))) | 272 | #f)))) |
262 | ((string=? (verb-get vinfo #:conj) "B2") | 273 | ((string=? (vinfo-get vinfo #:conj) "B2") |
263 | (let ((stem (elstr-trim elverb -1))) | 274 | (let ((stem (elstr-trim elverb -1))) |
@@ -265,3 +276,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
265 | ((or (string=? voice "act") (string=? thema "pres")) | 276 | ((or (string=? voice "act") (string=? thema "pres")) |
266 | (verb-set! vinfo #:attested 'stem) | 277 | (vinfo-set! vinfo #:attested 'stem) |
267 | stem) | 278 | stem) |
@@ -345,3 +356,3 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
345 | ;; (define (get-property conj vinfo key default) | 356 | ;; (define (get-property conj vinfo key default) |
346 | ;; (if ((override (verb-get vinfo | 357 | ;; (if ((override (vinfo-get vinfo |
347 | ;; (symbol->keyword | 358 | ;; (symbol->keyword |
@@ -354,5 +365,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
354 | ;; (if t | 365 | ;; (if t |
355 | ;; (or (verb-get vinfo key) | 366 | ;; (or (vinfo-get vinfo key) |
356 | ;; t) | 367 | ;; t) |
357 | ;; (or (verb-get vinfo key) | 368 | ;; (or (vinfo-get vinfo key) |
358 | ;; (conj-info key conj) | 369 | ;; (conj-info key conj) |
@@ -362,3 +373,3 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
362 | (define (get-suffix conj vinfo) | 373 | (define (get-suffix conj vinfo) |
363 | (let ((ret (let ((override (verb-get vinfo #:override))) | 374 | (let ((ret (let ((override (vinfo-get vinfo #:override))) |
364 | (if (and override | 375 | (if (and override |
@@ -367,6 +378,6 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
367 | (if t | 378 | (if t |
368 | (or (verb-get vinfo #:suffix) | 379 | (or (vinfo-get vinfo #:suffix) |
369 | t) | 380 | t) |
370 | "")) | 381 | "")) |
371 | (or (verb-get vinfo #:suffix) | 382 | (or (vinfo-get vinfo #:suffix) |
372 | (conj-info #:suffix conj) | 383 | (conj-info #:suffix conj) |
@@ -377,3 +388,3 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
377 | (define (get-accmap conj vinfo) | 388 | (define (get-accmap conj vinfo) |
378 | (let ((override (verb-get vinfo #:override))) | 389 | (let ((override (vinfo-get vinfo #:override))) |
379 | (if (and override | 390 | (if (and override |
@@ -382,5 +393,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
382 | (if t | 393 | (if t |
383 | (or (verb-get vinfo #:accmap) | 394 | (or (vinfo-get vinfo #:accmap) |
384 | t))) | 395 | t))) |
385 | (or (verb-get vinfo #:accmap) | 396 | (or (vinfo-get vinfo #:accmap) |
386 | (conj-info #:accmap conj) | 397 | (conj-info #:accmap conj) |
@@ -396,4 +407,4 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
396 | (set! accmap (list-head accmap 6)) | 407 | (set! accmap (list-head accmap 6)) |
397 | (set! augment (or (verb-get vinfo #:augment) "ε")))) | 408 | (set! augment (or (vinfo-get vinfo #:augment) "ε")))) |
398 | ; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment)) | 409 | ; (format #t "AUGMENT ~A ~A~%" vinfo (vinfo-get vinfo #:augment)) |
399 | (let ((forms | 410 | (let ((forms |
@@ -402,3 +413,3 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
402 | (cond | 413 | (cond |
403 | ((verb-get vinfo (symbol->keyword | 414 | ((vinfo-get vinfo (symbol->keyword |
404 | (string->symbol | 415 | (string->symbol |
@@ -470,3 +481,3 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
470 | 481 | ||
471 | (define (individual-verb verb voice mood tense) | 482 | (define (individual-verb vinfo voice mood tense) |
472 | (let ((res (ellinika:sql-query | 483 | (let ((res (ellinika:sql-query |
@@ -476,8 +487,12 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
476 | AND i.tense=\"~A\" AND i.ident=f.ident" | 487 | AND i.tense=\"~A\" AND i.ident=f.ident" |
477 | verb voice mood tense))) | 488 | (vinfo-get vinfo #:verb) voice mood tense))) |
478 | (if (not (null? res)) | 489 | (if (null? res) |
479 | (append (car res) | 490 | #f |
480 | (list "I" | 491 | (map |
481 | '(class stem))) | 492 | (lambda (elt) |
482 | #f))) | 493 | (append |
494 | elt | ||
495 | (list "I" | ||
496 | '(class stem)))) | ||
497 | res)))) | ||
483 | 498 | ||
@@ -489,137 +504,146 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
489 | 504 | ||
490 | (define (conjugate verb voice mood tense . rest) | 505 | (define (conjugate vinfo voice mood tense . rest) |
491 | (cond | 506 | (cond |
492 | ((individual-verb verb voice mood tense) => | 507 | ((individual-verb vinfo voice mood tense) => |
493 | (lambda (res) | 508 | (lambda (res) |
494 | (list res))) | 509 | res)) |
495 | (else | 510 | (else |
496 | (let* ((vinfo (load-verb-info verb voice mood tense)) | 511 | (let ((vinfo (copy-tree vinfo))) |
497 | (conj-list (get-conj-info (or | 512 | (if (not (member #:noload rest)) |
498 | (verb-get vinfo #:class) | 513 | (load-proplist vinfo voice mood tense)) |
499 | (verb-get vinfo #:conj)) | 514 | ; (format #t "VINFO ~A~%" vinfo) |
500 | voice mood tense)) | 515 | (let ((conj-list (get-conj-info (or |
501 | (verb (force-string (verb-get vinfo #:verb)))) | 516 | (vinfo-get vinfo #:class) |
502 | (format #t "VINFO ~A~%" vinfo) | 517 | (vinfo-get vinfo #:conj)) |
503 | (if (not conj-list) | 518 | voice mood tense)) |
504 | (list (list #f #f #f #f #f #f #f #f)) | 519 | (verb (force-string (vinfo-get vinfo #:verb)))) |
505 | (map car | 520 | ; (format #t "VINFO ~A~%" vinfo) |
506 | (fold | 521 | (if (not conj-list) |
507 | (lambda (elt prev) | 522 | (list (list #f #f #f #f #f #f #f #f)) |
508 | ; (format #t "ELT ~A~%" elt) | 523 | (map car |
509 | (if (null? prev) | 524 | (fold |
510 | (list elt) | 525 | (lambda (elt prev) |
511 | (let ((top (car prev))) | 526 | ; (format #t "ELT ~A~%" elt) |
512 | (if (let ((a (cdr elt)) | 527 | (if (null? prev) |
513 | (b (cdr top))) | 528 | (list elt) |
514 | (and (string? a) (string? b) (string=? a b))) | 529 | (let ((top (car prev))) |
515 | (cons (co |