summaryrefslogtreecommitdiffabout
path: root/src/ellinika
authorSergey Poznyakoff <gray@gnu.org.ua>2011-06-20 14:20:55 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2011-06-20 14:21:58 (GMT)
commit338097b8af7c7095db714782ac864ad9f0584b0f (patch) (side-by-side diff)
tree9d849e31b537a9808e0e6cfe793b1595f62bb5d0 /src/ellinika
parentb6bbb4f2cf0144aa58701cd2b46277838743a277 (diff)
downloadellinika-338097b8af7c7095db714782ac864ad9f0584b0f.tar.gz
ellinika-338097b8af7c7095db714782ac864ad9f0584b0f.tar.bz2
Minor stylistic change: use "stem" for \thema rhmatos.
Diffstat (limited to 'src/ellinika') (more/less context) (ignore whitespace changes)
-rw-r--r--src/ellinika/conjugator.scm138
-rw-r--r--src/ellinika/test-conjugation.scm2
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
@@ -48,7 +48,7 @@
(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
@@ -119,74 +119,74 @@ verb=\"~A\" AND voice=\"~A\" AND mood=\"~A\" AND tense=\"~A\""
(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))
@@ -203,57 +203,57 @@ WHERE verb=\"~A\" AND voice=\"~A\" AND thema=\"~A\""
(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
@@ -372,12 +372,12 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(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))
@@ -393,7 +393,7 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
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))
@@ -411,12 +411,12 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
(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))))
@@ -425,7 +425,7 @@ AND c.tense=\"~A\" AND c.flect = f.ident ORDER by fold"
((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)))
@@ -461,7 +461,7 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(if (not (null? res))
(append (car res)
(list "I"
- '(class root)))
+ '(class stem)))
#f)))
(define (merge-conjugated-forms lista listb)
@@ -556,8 +556,8 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(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
@@ -577,7 +577,7 @@ AND i.tense=\"~A\" AND i.ident=f.ident"
(conj-info #:fold conj))
prev))
prev
- (verb-get vinfo #:root))))))
+ (verb-get vinfo #:stem))))))
'()
conj-list))))))))
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
@@ -45,7 +45,7 @@
(else
(if (not (member 'class att))
(display "*"))
- (if (not (member 'root att))
+ (if (not (member 'stem att))
(display "!"))))
(display conj)))))
(newline))

Return to:

Send suggestions and report system problems to the System administrator.