aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika
diff options
context:
space:
mode:
Diffstat (limited to 'src/ellinika')
-rw-r--r--src/ellinika/conjugator.scm147
1 files changed, 86 insertions, 61 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
@@ -48,2 +48,4 @@
(list-set! verb 3 (append (list-ref verb 3) (list value))))
+ ((#:proplist)
+ (list-set! verb 2 value))
(else
@@ -80,4 +82,3 @@
-(define (create-basic-verb-info verb proplist . rest)
-; (format #t "PROPLIST ~A~%" proplist)
+(define (create-basic-verb-info verb . rest)
(let ((vdb (if (null? rest)
@@ -91,8 +92,8 @@
((and vdb (not (null? vdb)))
- (list (caar vdb) verb proplist '(class)))
+ (list (caar vdb) verb '() '(class)))
((elstr-suffix? verb "άω")
(create-basic-verb-info (elstr-append
- (elstr-trim verb -2) "ώ") proplist "B1"))
+ (elstr-trim verb -2) "ώ") "B1"))
((null? rest)
- (list (guess-verb-class verb) verb proplist '()))
+ (list (guess-verb-class verb) verb '() '()))
(else
@@ -100,4 +101,3 @@
-(define (load-verb-info verb voice mood tense)
-; (format #t "LOAD ~A~%" verb)
+(define (load-proplist vinfo voice mood tense)
(let ((verbprop (ellinika:sql-query
@@ -105,5 +105,5 @@
verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
- verb voice mood tense)))
- (create-basic-verb-info
- verb
+ (verb-get vinfo #:verb) voice mood tense)))
+ (verb-set!
+ vinfo #:proplist
(let loop ((inlist (if (null? verbprop)
@@ -122,2 +122,3 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
(stemlist '())
+ (suflist '())
(outlist '()))
@@ -126,9 +127,22 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
((null? inlist)
- (if (null? stemlist)
- outlist
- (cons (cons #:stem stemlist) outlist)))
+ (append
+ (if (not (null? stemlist))
+ (list (cons #:stem stemlist))
+ '())
+ (if (not (null? suflist))
+ (list (cons #:suffix suflist))
+ '())
+ outlist))
((eq? (caar inlist) #:stem)
- (loop (cdr inlist) (cons (cdar inlist) stemlist) outlist))
+ (loop (cdr inlist) (cons (cdar inlist) stemlist) suflist outlist))
+ ((eq? (caar inlist) #:suffix)
+ (loop (cdr inlist) stemlist (cons (cdar inlist) suflist) outlist))
(else
- (loop (cdr inlist) stemlist (cons (car inlist) outlist))))))))
+ (loop (cdr inlist) stemlist suflist (cons (car inlist) outlist))))))))
+
+(define (load-verb-info verb voice mood tense)
+; (format #t "LOAD ~A~%" verb)
+ (let ((vinfo (create-basic-verb-info verb)))
+ (load-proplist vinfo voice mood tense)
+ vinfo))
@@ -241,7 +255,6 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
((or (string=? thema "aor") (string=? thema "sub"))
- (thema-aoristoy-mesapathitikis-B
- stem
- (list-ref
- (conjugate verb "act" "ind" "Αόριστος")
- 0)))
+ (map
+ (lambda (aor)
+ (thema-aoristoy-mesapathitikis-B stem aor))
+ (conjugate verb "act" "ind" "Αόριστος")))
(else
@@ -349,13 +362,14 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(define (get-suffix conj vinfo)
- (let ((override (verb-get vinfo #:override)))
- (if (and override
- (member "suffix" override))
- (let ((t (conj-info #:suffix conj)))
- (if t
- (or (verb-get vinfo #:suffix)
- t)
- ""))
- (or (verb-get vinfo #:suffix)
- (conj-info #:suffix conj)
- ""))))
+ (let ((ret (let ((override (verb-get vinfo #:override)))
+ (if (and override
+ (member "suffix" override))
+ (let ((t (conj-info #:suffix conj)))
+ (if t
+ (or (verb-get vinfo #:suffix)
+ t)
+ ""))
+ (or (verb-get vinfo #:suffix)
+ (conj-info #:suffix conj)
+ "")))))
+ (if (list? ret) ret (list ret))))
@@ -374,6 +388,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
-(define (apply-flect conj vinfo verb stem)
+(define (apply-flect conj vinfo verb stem suffix)
; (format #t "VINFO ~A~%" vinfo)
- (let ((suffix (get-suffix conj vinfo))
- (accmap (string->list (get-accmap conj vinfo)))
+ (let ((accmap (string->list (get-accmap conj vinfo)))
(augment ""))
@@ -390,3 +403,4 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
((verb-get vinfo (symbol->keyword
- (string->symbol (number->string person)))) =>
+ (string->symbol
+ (number->string person)))) =>
(lambda (personal-form)
@@ -416,8 +430,10 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
((char=? acc #\s)
- (let ((nsyl (elstr-number-of-syllables flect)))
+ (let ((nsyl (elstr-number-of-syllables flect))
+ (result (elstr-append stem suffix flect)))
(elstr-set-accent
- (elstr-append stem suffix flect)
- (if (< nsyl 2)
- (+ nsyl 1)
- 3))))
+ result
+ (min (if (< nsyl 2)
+ (+ nsyl 1)
+ 3)
+ (elstr-number-of-syllables result)))))
((char=? acc #\-)
@@ -428,4 +444,5 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
stem suffix flect)))
- (if (and augment (= (+ (elstr-number-of-syllables obj) 1)
- num))
+ (if (and augment
+ (= (+ (elstr-number-of-syllables obj) 1)
+ num))
(set! obj (elstr-append augment obj)))
@@ -455,6 +472,6 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(let ((res (ellinika:sql-query
- "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3 \
-FROM individual_verb i,verbflect f \
-WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
-AND i.tense=\"~A\" AND i.ident=f.ident"
+ "SELECT f.sing1,f.sing2,f.sing3,f.plur1,f.plur2,f.plur3\
+ FROM individual_verb i,verbflect f\
+ WHERE i.verb=\"~A\" AND i.voice=\"~A\" AND i.mood=\"~A\"\
+ AND i.tense=\"~A\" AND i.ident=f.ident"
verb voice mood tense)))
@@ -479,4 +496,8 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(let* ((vinfo (load-verb-info verb voice mood tense))
- (conj-list (get-conj-info (verb-get vinfo #:conj)
- voice mood tense)))
+ (conj-list (get-conj-info (or
+ (verb-get vinfo #:class)
+ (verb-get vinfo #:conj))
+ voice mood tense))
+ (verb (force-string (verb-get vinfo #:verb))))
+ (format #t "VINFO ~A~%" vinfo)
(if (not conj-list)
@@ -580,15 +601,20 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(car thema))))
-; (format #t "VINFO ~A~%" vinfo)
- (fold
- (lambda (stem prev)
- (cons
- (cons
- (append (apply-flect conj vinfo verb stem)
- (list (verb-get vinfo #:conj)
- (verb-get vinfo #:attested)))
- (conj-info #:fold conj))
- prev))
- prev
- (verb-get vinfo #:stem))))))
+ (fold
+ (lambda (suffix prev)
+ (append
+ (fold
+ (lambda (stem prev)
+ (cons
+ (cons
+ (append (apply-flect conj vinfo verb stem suffix)
+ (list (verb-get vinfo #:conj)
+ (verb-get vinfo #:attested)))
+ (conj-info #:fold conj))
+ prev))
+ '()
+ (verb-get vinfo #:stem))
+ prev))
+ prev
+ (get-suffix conj vinfo))))))
'()
@@ -631,2 +657 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(return #t)))))
-

Return to:

Send suggestions and report system problems to the System administrator.