aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika/conjugator.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/ellinika/conjugator.scm')
-rw-r--r--src/ellinika/conjugator.scm354
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 \
105verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" 105verb=\"~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