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 | |||
@@ -37,7 +37,7 @@ | |||
37 | ;; properties - associative list of properties | 37 | ;; properties - associative list of properties |
38 | ;; attested | 38 | ;; attested |
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) |
42 | (case key | 42 | (case key |
43 | ((#:conj) | 43 | ((#:conj) |
@@ -60,7 +60,7 @@ | |||
60 | (cons key value))))))))) | 60 | (cons key value))))))))) |
61 | 61 | ||
62 | 62 | ||
63 | (define (verb-get verb key) | 63 | (define (vinfo-get verb key) |
64 | (case key | 64 | (case key |
65 | ((#:conj) | 65 | ((#:conj) |
66 | (list-ref verb 0)) | 66 | (list-ref verb 0)) |
@@ -103,8 +103,8 @@ | |||
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-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 |
109 | (let loop ((inlist (if (null? verbprop) | 109 | (let loop ((inlist (if (null? verbprop) |
110 | '() | 110 | '() |
@@ -194,6 +194,11 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | |||
194 | (else | 194 | (else |
195 | (elstr-append stem "ηθ"))))) | 195 | (elstr-append stem "ηθ"))))) |
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) |
198 | (ellinika:sql-query | 203 | (ellinika:sql-query |
199 | "SELECT stem FROM irregular_stem \ | 204 | "SELECT stem FROM irregular_stem \ |
@@ -210,6 +215,7 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
210 | (throw 'conjugator-error 'conjugator-error-input | 215 | (throw 'conjugator-error 'conjugator-error-input |
211 | "cannot handle ~A" (list (force-string verb)))))) | 216 | "cannot handle ~A" (list (force-string verb)))))) |
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) |
214 | ; (format #t "COMPLEMENT ~A~%" vinfo) | 220 | ; (format #t "COMPLEMENT ~A~%" vinfo) |
215 | (let ((elverb (string->elstr verb)) | 221 | (let ((elverb (string->elstr verb)) |
@@ -217,53 +223,58 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
217 | (if (and (null? tmpres) (string=? thema "sub")) | 223 | (if (and (null? tmpres) (string=? thema "sub")) |
218 | (lookup-verb-info verb voice "aor") | 224 | (lookup-verb-info verb voice "aor") |
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))) |
227 | (cond | 233 | (cond |
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))) |
239 | (cond | 250 | (cond |
240 | ((string=? thema "pres") | 251 | ((string=? thema "pres") |
241 | (verb-set! vinfo #:attested 'stem) | 252 | (vinfo-set! vinfo #:attested 'stem) |
242 | stem) | 253 | stem) |
243 | ((or (string=? thema "aor") (string=? thema "sub")) | 254 | ((or (string=? thema "aor") (string=? thema "sub")) |
244 | #f) ; FIXME | 255 | #f) ; FIXME |
245 | (else | 256 | (else |
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 "άω") |
249 | (elstr-trim elverb -2) | 260 | (elstr-trim elverb -2) |
250 | (elstr-trim elverb -1)))) | 261 | (elstr-trim elverb -1)))) |
251 | (cond | 262 | (cond |
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) |
255 | ((or (string=? thema "aor") (string=? thema "sub")) | 266 | ((or (string=? thema "aor") (string=? thema "sub")) |
256 | (map | 267 | (map |
257 | (lambda (aor) | 268 | (lambda (aor) |
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))) |
264 | (cond | 275 | (cond |
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) |
268 | ((or (string=? thema "aor") (string=? thema "sub")) | 279 | ((or (string=? thema "aor") (string=? thema "sub")) |
269 | (elstr-append stem "ηθ")) ;; FIXME: guesswork | 280 | (elstr-append stem "ηθ")) ;; FIXME: guesswork |
@@ -343,7 +354,7 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
343 | (+ (- len syl) 1)))) | 354 | (+ (- len syl) 1)))) |
344 | 355 | ||
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 |
348 | ;; (string->symbol | 359 | ;; (string->symbol |
349 | ;; (string-append | 360 | ;; (string-append |
@@ -352,37 +363,37 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
352 | ;; (if override | 363 | ;; (if override |
353 | ;; (let ((t (conj-info key conj))) | 364 | ;; (let ((t (conj-info key conj))) |
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) |
359 | ;; default)))))) | 370 | ;; default)))))) |
360 | 371 | ||
361 | 372 | ||
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 |
365 | (member "suffix" override)) | 376 | (member "suffix" override)) |
366 | (let ((t (conj-info #:suffix conj))) | 377 | (let ((t (conj-info #:suffix conj))) |
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) |
373 | ""))))) | 384 | ""))))) |
374 | (if (list? ret) ret (list ret)))) | 385 | (if (list? ret) ret (list ret)))) |
375 | 386 | ||
376 | 387 | ||
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 |
380 | (member "accmap" override)) | 391 | (member "accmap" override)) |
381 | (let ((t (conj-info #:accmap conj))) | 392 | (let ((t (conj-info #:accmap conj))) |
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 |