From 338097b8af7c7095db714782ac864ad9f0584b0f Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Mon, 20 Jun 2011 17:20:55 +0300 Subject: Minor stylistic change: use "stem" for \thema rhmatos. --- src/cgi-bin/conj.scm4 | 1 - src/ellinika/conjugator.scm | 138 +++++++++++++++++++------------------- src/ellinika/test-conjugation.scm | 2 +- 3 files changed, 70 insertions(+), 71 deletions(-) (limited to 'src') diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4 index 8c5e317..1894485 100644 --- a/src/cgi-bin/conj.scm4 +++ b/src/cgi-bin/conj.scm4 @@ -409,7 +409,6 @@ ifelse(IFACE,[CGI],(cgi:init)) (cgi:names)))) (cons "@@conj@@" (lambda () - (format #t "" (environ)) (dict-connect) (main-form) (do-conj) 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)) -- cgit v1.2.1