diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-20 17:20:55 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2011-06-20 17:21:58 +0300 |
commit | 338097b8af7c7095db714782ac864ad9f0584b0f (patch) | |
tree | 9d849e31b537a9808e0e6cfe793b1595f62bb5d0 /src/ellinika | |
parent | b6bbb4f2cf0144aa58701cd2b46277838743a277 (diff) | |
download | ellinika-338097b8af7c7095db714782ac864ad9f0584b0f.tar.gz ellinika-338097b8af7c7095db714782ac864ad9f0584b0f.tar.bz2 |
Minor stylistic change: use "stem" for \thema rhmatos.
Diffstat (limited to 'src/ellinika')
-rw-r--r-- | src/ellinika/conjugator.scm | 138 | ||||
-rw-r--r-- | src/ellinika/test-conjugation.scm | 2 |
2 files changed, 70 insertions, 70 deletions
diff --git a/src/ellinika/conjugator.scm b/src/ellinika/conjugator.scm index f70e20c..001a882 100644 --- a/src/ellinika/conjugator.scm +++ b/src/ellinika/conjugator.scm @@ -45,13 +45,13 @@ ((#:verb) (list-set! verb 1 value)) ((#:attested) (list-set! verb 3 (append (list-ref verb 3) (list value)))) (else (let ((container (assoc key (list-ref verb 2))) - (value (if (and (eq? key #:root) (not (list? value))) + (value (if (and (eq? key #:stem) (not (list? value))) (list value) value))) (if container (set-cdr! container value) (list-set! verb 2 (append (list-ref verb 2) (list @@ -116,80 +116,80 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\"" (cons #:override (string-split value #\,)) (cons (symbol->keyword (string->symbol name)) value)))) verbprop))) - (rootlist '()) + (stemlist '()) (outlist '())) -; (format #t "ARGS: ~A/~A/~A~%" inlist rootlist outlist) +; (format #t "ARGS: ~A/~A/~A~%" inlist stemlist outlist) (cond ((null? inlist) - (if (null? rootlist) + (if (null? stemlist) outlist - (cons (cons #:root rootlist) outlist))) - ((eq? (caar inlist) #:root) - (loop (cdr inlist) (cons (cdar inlist) rootlist) outlist)) + (cons (cons #:stem stemlist) outlist))) + ((eq? (caar inlist) #:stem) + (loop (cdr inlist) (cons (cdar inlist) stemlist) outlist)) (else - (loop (cdr inlist) rootlist (cons (car inlist) outlist)))))))) + (loop (cdr inlist) stemlist (cons (car inlist) outlist)))))))) -(define (thema-aoristoy-mesapathitikis-A root) +(define (thema-aoristoy-mesapathitikis-A stem) (cond - ((elstr-suffix? root "αίν") - (elstr-append (elstr-trim root -3) "ανθ")) ;; FIXME: Also αθ, ηθ + ((elstr-suffix? stem "αίν") + (elstr-append (elstr-trim stem -3) "ανθ")) ;; FIXME: Also αθ, ηθ ((and - (elstr-suffix? root "ν") - (logand (elstr-char-prop-bitmask root -2) elmorph:vowel)) - (elstr-append (elstr-trim root -1) "θ")) ;; FIXME: also στ, νθ, θ + (elstr-suffix? stem "ν") + (logand (elstr-char-prop-bitmask stem -2) elmorph:vowel)) + (elstr-append (elstr-trim stem -1) "θ")) ;; FIXME: also στ, νθ, θ ((and - (elstr-suffix? root "δ" "θ" "ζ" "ν") ;; FIXME: see above - (logand (elstr-char-prop-bitmask root -2) elmorph:vowel)) - (elstr-append (elstr-trim root -1) "στ")) - ((elstr-suffix? root "γγ" "σσ" "ττ" "χν" "γ" "ζ" "κ" "χ") => + (elstr-suffix? stem "δ" "θ" "ζ" "ν") ;; FIXME: see above + (logand (elstr-char-prop-bitmask stem -2) elmorph:vowel)) + (elstr-append (elstr-trim stem -1) "στ")) + ((elstr-suffix? stem "γγ" "σσ" "ττ" "χν" "γ" "ζ" "κ" "χ") => (lambda (suf) - (elstr-append (elstr-trim root (- 0 (elstr-length (string->elstr suf)))) + (elstr-append (elstr-trim stem (- 0 (elstr-length (string->elstr suf)))) "χτ"))) ;; also χθ - ((elstr-suffix? root "π" "β" "φ" "πτ" "φτ") => + ((elstr-suffix? stem "π" "β" "φ" "πτ" "φτ") => (lambda (suf) - (elstr-append (elstr-trim root (- 0 (elstr-length (string->elstr suf)))) + (elstr-append (elstr-trim stem (- 0 (elstr-length (string->elstr suf)))) "φτ"))) ;; also φθ - ((elstr-suffix? root "αύ" "εύ") => + ((elstr-suffix? stem "αύ" "εύ") => (lambda (suf) - (elstr-append root "τ"))) - ((elstr-suffix? root "άρ" "ίρ") - ((elstr-append root "ιστ"))) - ((logand (elstr-char-prop-bitmask root -1) elmorph:vowel) - (elstr-append root "θ")) + (elstr-append stem "τ"))) + ((elstr-suffix? stem "άρ" "ίρ") + ((elstr-append stem "ιστ"))) + ((logand (elstr-char-prop-bitmask stem -1) elmorph:vowel) + (elstr-append stem "θ")) (else #f))) -(define (thema-aoristoy-mesapathitikis-B root conj-aor) - (let ((root-aor (elstr-trim (list-ref conj-aor 0) -1))) +(define (thema-aoristoy-mesapathitikis-B stem conj-aor) + (let ((stem-aor (elstr-trim (list-ref conj-aor 0) -1))) (cond - ((elstr-suffix? root-aor "σ") - (elstr-append root - (elstr-slice root-aor -2 1) + ((elstr-suffix? stem-aor "σ") + (elstr-append stem + (elstr-slice stem-aor -2 1) "θ")) - ((elstr-suffix? root-aor "ξ") - (elstr-append root - (elstr-slice root-aor -2 1) + ((elstr-suffix? stem-aor "ξ") + (elstr-append stem + (elstr-slice stem-aor -2 1) "χτ")) - ((elstr-suffix? root-aor "ψ") - (elstr-append root - (elstr-slice root-aor -2 1) + ((elstr-suffix? stem-aor "ψ") + (elstr-append stem + (elstr-slice stem-aor -2 1) "φτ")) (else - (elstr-append root "ηθ"))))) + (elstr-append stem "ηθ"))))) (define (lookup-verb-info verb voice thema) (ellinika:sql-query - "SELECT root FROM irregular_root \ + "SELECT stem FROM irregular_stem \ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" verb voice thema)) -(define (verb-A-root verb) +(define (verb-A-stem verb) (cond ((elstr-suffix? verb "ω") (elstr-trim verb -1)) ((elstr-suffix? verb "ομαι") (elstr-trim verb -4)) (else @@ -200,63 +200,63 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\"" ; (format #t "COMPLEMENT ~A~%" vinfo) (let ((elverb (string->elstr verb)) (result (let ((tmpres (lookup-verb-info verb voice thema))) (if (and (null? tmpres) (string=? thema "sub")) (lookup-verb-info verb voice "aor") tmpres)))) - (verb-set! vinfo #:root + (verb-set! vinfo #:stem (cond ((not (null? result)) - (verb-set! vinfo #:attested 'root) + (verb-set! vinfo #:attested 'stem) (map car result)) ((string=? (verb-get vinfo #:conj) "A") - (let ((root (verb-A-root elverb))) + (let ((stem (verb-A-stem elverb))) (cond ((string=? thema "pres") - (verb-set! vinfo #:attested 'root) - root) + (verb-set! vinfo #:attested 'stem) + stem) ((or (string=? thema "aor") (string=? thema "sub")) (if (string=? voice "act") - (elstr-thema-aoristoy root) - (thema-aoristoy-mesapathitikis-A root))) + (elstr-thema-aoristoy stem) + (thema-aoristoy-mesapathitikis-A stem))) (else #f)))) ((string=? (verb-get vinfo #:conj) "A-depon") - (let ((root (verb-A-root elverb))) + (let ((stem (verb-A-stem elverb))) (cond ((string=? thema "pres") - (verb-set! vinfo #:attested 'root) - root) + (verb-set! vinfo #:attested 'stem) + stem) ((or (string=? thema "aor") (string=? thema "sub")) #f) ; FIXME (else #f)))) ((string=? (verb-get vinfo #:conj) "B1") - (let ((root (if (elstr-suffix? elverb "άω") + (let ((stem (if (elstr-suffix? elverb "άω") (elstr-trim elverb -2) (elstr-trim elverb -1)))) (cond ((or (string=? voice "act") (string=? thema "pres")) - (verb-set! vinfo #:attested 'root) - root) + (verb-set! vinfo #:attested 'stem) + stem) ((or (string=? thema "aor") (string=? thema "sub")) (thema-aoristoy-mesapathitikis-B - root + stem (list-ref (conjugate verb "act" "ind" "Αόριστος") 0))) (else #f)))) ((string=? (verb-get vinfo #:conj) "B2") - (let ((root (elstr-trim elverb -1))) + (let ((stem (elstr-trim elverb -1))) (cond ((or (string=? voice "act") (string=? thema "pres")) - (verb-set! vinfo #:attested 'root) - root) + (verb-set! vinfo #:attested 'stem) + stem) ((or (string=? thema "aor") (string=? thema "sub")) - (elstr-append root "ηθ")) ;; FIXME: guesswork + (elstr-append stem "ηθ")) ;; FIXME: guesswork (else #f)))) (else #f))))) (define-syntax conj-info @@ -369,18 +369,18 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" (or (verb-get vinfo #:accmap) t))) (or (verb-get vinfo #:accmap) (conj-info #:accmap conj) "000000")))) -(define (apply-flect conj vinfo verb root) +(define (apply-flect conj vinfo verb stem) ; (format #t "VINFO ~A~%" vinfo) (let ((suffix (get-suffix conj vinfo)) (accmap (string->list (get-accmap conj vinfo))) (augment "")) -; (format #t "ROOT ~A, ACCMAP ~S, SUFFIX: ~A~%" root accmap suffix) +; (format #t "STEM ~A, ACCMAP ~S, SUFFIX: ~A~%" stem accmap suffix) (cond ((> (length accmap) 6) (set! accmap (list-head accmap 6)) (set! augment (or (verb-get vinfo #:augment) "ε")))) ; (format #t "AUGMENT ~A ~A~%" vinfo (verb-get vinfo #:augment)) (let ((forms @@ -390,13 +390,13 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" ((verb-get vinfo (symbol->keyword (string->symbol (number->string person)))) => (lambda (personal-form) personal-form)) ((not flect) #f) ((char=? acc #\0) - (let* ((rs (force-elstr root)) + (let* ((rs (force-elstr stem)) (suf (elstr-deaccent (elstr-append suffix flect))) (result (elstr-append rs suf)) (nsyl (elstr-number-of-syllables result)) (acc-syl (+ (- nsyl (let ((n (accented-syllable-0 rs))) (if (= 0 n) @@ -408,27 +408,27 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold" ((> acc-syl 3) (elstr-set-accent result 3)) ; FIXME (else (elstr-set-accent result acc-syl))))) ((char=? acc #\f) (elstr-append - (elstr-deaccent (elstr-append root suffix)) + (elstr-deaccent (elstr-append stem suffix)) flect)) ((char=? acc #\s) (let ((nsyl (elstr-number-of-syllables flect))) (elstr-set-accent - (elstr-append root suffix flect) + (elstr-append stem suffix flect) (if (< nsyl 2) (+ nsyl 1) 3)))) ((char=? acc #\-) #f) ((char-numeric? acc) (let ((num (- (char->integer acc) (char->integer #\0)))) (let ((obj (elstr-append - root suffix flect))) + stem suffix flect))) (if (and augment (= (+ (elstr-number-of-syllables obj) 1) num)) (set! obj (elstr-append augment obj))) (let ((nsyl (elstr-number-of-syllables obj))) (elstr-set-accent! obj (cond ((< num nsyl) num) @@ -458,13 +458,13 @@ 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))) (if (not (null? res)) (append (car res) (list "I" - '(class root))) + '(class stem))) #f))) (define (merge-conjugated-forms lista listb) (map (lambda (a b) (or a b)) @@ -553,14 +553,14 @@ AND i.tense=\"~A\" AND i.ident=f.ident" prev)) prev (conjugate verb voice "ind" (conj-info #:auxtense conj))))) (else (let ((vinfo (copy-tree vinfo))) - (if (verb-get vinfo #:root) - (verb-set! vinfo #:attested 'root) + (if (verb-get vinfo #:stem) + (verb-set! vinfo #:attested 'stem) (let ((thema (string-split (conj-info #:thema conj) #\:))) ; (format #t "THEMA ~A~%" thema) (complement-verb-info vinfo verb (if (null? (cdr thema)) voice (car (cdr thema))) @@ -574,13 +574,13 @@ AND i.tense=\"~A\" AND i.ident=f.ident" (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 #:root)))))) + (verb-get vinfo #:stem)))))) '() conj-list)))))))) (define-public (conjugator verb voice mood tense) (conjugate verb voice mood tense)) diff --git a/src/ellinika/test-conjugation.scm b/src/ellinika/test-conjugation.scm index 1504553..64be1fd 100644 --- a/src/ellinika/test-conjugation.scm +++ b/src/ellinika/test-conjugation.scm @@ -42,13 +42,13 @@ (cond ((not att) (display "*")) (else (if (not (member 'class att)) (display "*")) - (if (not (member 'root att)) + (if (not (member 'stem att)) (display "!")))) (display conj))))) (newline)) (conjugator verb voice mood tense)) (gc)) |