diff options
Diffstat (limited to 'src/ellinika/conjugator.scm')
-rw-r--r-- | src/ellinika/conjugator.scm | 73 |
1 files changed, 46 insertions, 27 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index 0abec8d..f70e20c 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm | |||
@@ -49,3 +49,6 @@ | |||
49 | (else | 49 | (else |
50 | (let ((container (assoc key (list-ref verb 2)))) | 50 | (let ((container (assoc key (list-ref verb 2))) |
51 | (value (if (and (eq? key #:root) (not (list? value))) | ||
52 | (list value) | ||
53 | value))) | ||
51 | (if container | 54 | (if container |
@@ -103,17 +106,29 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" | |||
103 | verb voice mood tense))) | 106 | verb voice mood tense))) |
104 | (create-basic-verb-info verb | 107 | (create-basic-verb-info |
105 | (if (null? verbprop) | 108 | verb |
106 | '() | 109 | (let loop ((inlist (if (null? verbprop) |
107 | (map | 110 | '() |
108 | (lambda (elt) | 111 | (map |
109 | (let ((name (car elt)) | 112 | (lambda (elt) |
110 | (value (cadr elt))) | 113 | (let ((name (car elt)) |
111 | (if (string=? name "override") | 114 | (value (cadr elt))) |
112 | (cons #:override | 115 | (if (string=? name "override") |
113 | (string-split value #\,)) | 116 | (cons #:override |
114 | (cons (symbol->keyword | 117 | (string-split value #\,)) |
115 | (string->symbol name)) | 118 | (cons (symbol->keyword |
116 | value)))) | 119 | (string->symbol name)) |
117 | verbprop))))) | 120 | value)))) |
118 | 121 | verbprop))) | |
122 | (rootlist '()) | ||
123 | (outlist '())) | ||
124 | ; (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist) | ||
125 | (cond | ||
126 | ((null? inlist) | ||
127 | (if (null? rootlist) | ||
128 | outlist | ||
129 | (cons (cons #:root rootlist) outlist))) | ||
130 | ((eq? (caar inlist) #:root) | ||
131 | (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist)) | ||
132 | (else | ||
133 | (loop (cdr inlist) rootlist (cons (car inlist) outlist)))))))) | ||
119 | 134 | ||
@@ -194,3 +209,3 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" | |||
194 | (verb-set! vinfo #:attested 'root) | 209 | (verb-set! vinfo #:attested 'root) |
195 | (caar result)) | 210 | (map car result)) |
196 | ((string=? (verb-get vinfo #:conj) "A") | 211 | ((string=? (verb-get vinfo #:conj) "A") |
@@ -359,6 +374,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" | |||
359 | 374 | ||
360 | (define (apply-flect conj vinfo verb) | 375 | (define (apply-flect conj vinfo verb root) |
361 | ; (format #t "VINFO ~A~%" vinfo) | 376 | ; (format #t "VINFO ~A~%" vinfo) |
362 | (let ((root (verb-get vinfo #:root)) | 377 | (let ((suffix (get-suffix conj vinfo)) |
363 | (suffix (get-suffix conj vinfo)) | ||
364 | (accmap (string->list (get-accmap conj vinfo))) | 378 | (accmap (string->list (get-accmap conj vinfo))) |
@@ -554,9 +568,14 @@ AND i.tense=\"~A\" AND i.ident=f.ident" | |||
554 | ; (format #t "VINFO ~A~%" vinfo) | 568 | ; (format #t "VINFO ~A~%" vinfo) |
555 | (cons | 569 | |
556 | (cons | 570 | (fold |
557 | (append (apply-flect conj vinfo verb) | 571 | (lambda (stem prev) |
558 | (list (verb-get vinfo #:conj) | 572 | (cons |
559 | (verb-get vinfo #:attested))) | 573 | (cons |
560 | (conj-info #:fold conj)) | 574 | (append (apply-flect conj vinfo verb stem) |
561 | prev))))) | 575 | (list (verb-get vinfo #:conj) |
576 | (verb-get vinfo #:attested))) | ||
577 | (conj-info #:fold conj)) | ||
578 | prev)) | ||
579 | prev | ||
580 | (verb-get vinfo #:root)))))) | ||
562 | '() | 581 | '() |