diff options
Diffstat (limited to 'scm/verbop.scm')
-rw-r--r-- | scm/verbop.scm | 95 |
1 files changed, 55 insertions, 40 deletions
diff --git a/scm/verbop.scm b/scm/verbop.scm index bb54126..f3ecc33 100644 --- a/scm/verbop.scm +++ b/scm/verbop.scm @@ -2,7 +2,7 @@ (xmltools xmltrans) (ellinika elmorph) (gamma sql) - (ellinika xlat) + (ellinika tenses) (ice-9 getopt-long)) (define cleanup-option #f) @@ -51,12 +51,12 @@ (debug 100 rest) (let ((q (apply format (cons #f rest)))) (if verbose-option - (format #t "QUERY: ~S\n" q)) + (format #t "QUERY: ~A\n" q)) (cond (connection (let ((res (sql-query connection q))) (if verbose-option - (format #t "RESULT: ~S\n" res)) + (format #t "RESULT: ~A\n" res)) res)) (else #f)))) @@ -197,6 +197,15 @@ conj) (return #t)))) +(define (insert-individual-verb voice mood tense ident) + (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \ +VALUES (~A,~A,~A,~A,~A);~%" + (verb-get-sql #:verb) + (sql-val voice) + (sql-val mood) + (sql-val tense) + (number->string ident))) + (define (flush-mood mood vstr) (if (eq? (car mood) #:root) (let ((val (cdr mood))) @@ -207,45 +216,51 @@ VALUES (~A,~A,~A,~A);~%" (sql-val (car val)) (sql-val (cdr val)))) (let ((mood-str (mood-key->string (car mood)))) - (for-each - (lambda (p) - (let ((key (car p))) - (debug 1 "flush-mood: " p) - (cond - ((empty-conjugation? (cdr p)) - (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \ -VALUES (~A,~A,~A,~A,~A);~%" - (verb-get-sql #:verb) - (sql-val vstr) - (sql-val mood-str) - (sql-val key) - "0")) - (else - (let ((num (next-flect-ident)) - (l (cdr p))) - (run-query "INSERT INTO verbflect VALUES (~A,~A,~A,~A,~A,~A,~A);~%" - num - (sql-val (list-ref l 0)) - (sql-val (list-ref l 1)) - (sql-val (list-ref l 2)) - (sql-val (list-ref l 3)) - (sql-val (list-ref l 4)) - (sql-val (list-ref l 5))) - (run-query "INSERT INTO individual_verb (verb,voice,mood,tense,ident) \ -VALUES (~A,~A,~A,~A,~A);~%" - (verb-get-sql #:verb) - (sql-val vstr) - (sql-val mood-str) - (sql-val key) - num) ))))) - (cdr mood))))) + (let ((lst (cdr mood))) + (if (null? lst) + (for-each + (lambda (tense) + (insert-individual-verb vstr mood-str tense 0)) + (assoc-ref ellinika-tense-list mood-str)) + + (for-each + (lambda (p) + (let ((key (car p))) + (debug 1 "flush-mood: " p) + (cond + ((empty-conjugation? (cdr p)) + (insert-individual-verb vstr mood-str key 0)) + (else + (let ((num (next-flect-ident)) + (l (cdr p))) + (run-query + "INSERT INTO verbflect VALUES (~A,~A,~A,~A,~A,~A,~A);~%" + num + (sql-val (list-ref l 0)) + (sql-val (list-ref l 1)) + (sql-val (list-ref l 2)) + (sql-val (list-ref l 3)) + (sql-val (list-ref l 4)) + (sql-val (list-ref l 5))) + (insert-individual-verb vstr mood-str key num) ))))) + lst)))))) (define (flush-voice vstr conj-list) - (if conj-list - (for-each - (lambda (mood) - (flush-mood mood vstr)) - conj-list))) + (cond + ((null? conj-list) + (for-each + (lambda (vp) + (let ((mood (car vp))) + (for-each + (lambda (tense) + (insert-individual-verb vstr mood tense 0)) + (cdr vp)))) + ellinika-tense-list)) + (conj-list + (for-each + (lambda (mood) + (flush-mood mood vstr)) + conj-list)))) ;;; Fush verb definition to the database (define (verb-flush) |