aboutsummaryrefslogtreecommitdiff
path: root/scm/verbop.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scm/verbop.scm')
-rw-r--r--scm/verbop.scm95
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)

Return to:

Send suggestions and report system problems to the System administrator.