diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-13 12:39:00 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2004-10-13 12:39:00 +0000 |
commit | 8f01c7329a5457c0e5e65267e936144b6d77a461 (patch) | |
tree | 8620989e2ec22df1dd6d8cbae2392316bcae4a25 /scm/dictrans.scm | |
parent | 3db1451f587869006f3c1aee564a23cc1774e6fe (diff) | |
download | ellinika-8f01c7329a5457c0e5e65267e936144b6d77a461.tar.gz ellinika-8f01c7329a5457c0e5e65267e936144b6d77a461.tar.bz2 |
Added INCLUDE support.
Diagnose duplicate entries.
Fixed bug in NODE.
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@234 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'scm/dictrans.scm')
-rw-r--r-- | scm/dictrans.scm | 78 |
1 files changed, 71 insertions, 7 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm index 4c365c2..fb4064f 100644 --- a/scm/dictrans.scm +++ b/scm/dictrans.scm @@ -20,13 +20,13 @@ ;;;; Dictionary structure ;;;; Internal representation: ;;;; ;;;; * Each dictionary entry is represented as a vector: ;;;; -;;;; #(KEY FORMS XREF P-LIST) +;;;; #(KEY FORMS XREF P-LIST LOC) ;;;; ;;;; KEY is list of strings ;;;; ;;;; * FORMS is either #f or a string describing forms of the key if they ;;;; are formed in an irregular manner. ;;;; @@ -40,12 +40,13 @@ ;;;; POS string part of speech ;;;; ARTICLE list(string) Dictionary article associated with this key/pos ;;;; AREF list(string) List of antonyms ;;;; XREF list(string) List of cross-references ;;;; TOPIC list(string) List of topics this item pertains to ;;;; +;;;; * LOC is source location where the entry was defined (cons FILE LINE). ;;;; ;;;; External representation (XML): ;;;; ;;;; <NODE> ;;;; <K>string</K>+ ;;;; [<F>string</F>] @@ -181,13 +182,15 @@ (vector-ref node 0)) ((node-get #:forms node) (vector-ref node 1)) ((node-get #:xref node) (vector-ref node 2)) ((node-get #:p-list node) - (vector-ref node 3)))) + (vector-ref node 3)) + ((node-get #:locus node) + (vector-ref node 4)))) (define-macro (current-node-get key) `(node-get ,key current-node)) (define (mark-invalid) (xmltrans:set-attr "NODE" "__INVALID__" 1)) @@ -224,13 +227,15 @@ (vector-set! node 3 (list p))))) ((node-set #:topic node t) ;; FIXME: Scope of <T> is position-dependent relative to <P> (for-each (lambda (p) (p-article-set #:topic p t)) - (node-get #:p-list node))))) + (node-get #:p-list node))) + ((node-set #:locus node loc) + (vector-set! node 4 loc)))) (define-macro (current-node-set key val) `(node-set ,key current-node ,val)) (define p-article #f) @@ -338,18 +343,32 @@ (set! expected-k #f)) ;;; (xmltrans:start-tag "NODE" (tag attr) - (set! current-node (vector #f #f '() '())) + (set! current-node (vector #f #f '() '() (xmltrans:get-input-location))) (set! p-article #f) (set! expected-k #t) (xmltrans:expect-next-tag "K" k-expect) #f) +;;;; INCLUDE +(xmltrans:end-tag + "INCLUDE" + (tag attr text) + (let ((fname (xmltrans:attr attr "FILE"))) + (cond + ((not fname) + (xmltrans:parse-error #f "File name not specified")) + ((string? fname) + (xmltrans:parse-file fname)) + (else + (xmltrans:parse-error #f "FILE must be a valid string")))) + #f) + (xmltrans:end-tag "NODE" (tag attr text) (cond (p-article (if (not (null? (current-node-get #:p-list))) @@ -359,13 +378,13 @@ (set! p-article #f))) (cond ((xmltrans:attr attr "__INVALID__")) ; Ignore ((not (current-node-get #:key)) (xmltrans:parse-error #f "K element is missing")) - ((or (null? (current-node-get #:p-list)) (null? (null? (current-node-get #:xref)))) + ((and (null? (current-node-get #:p-list)) (null? (current-node-get #:xref))) (xmltrans:parse-error #f "No articles and no cross references for the node")) (else (push-node current-node))) #f) ;;; Topic @@ -499,13 +518,18 @@ ;;; M - MEANING (xmltrans:end-tag "M" (tag attr text) (expect-context tag "P" "NODE") - (current-article-set #:article text) + (cond + ((and (not p-article) (null? (current-node-get #:p-list))) + (xmltrans:parse-error #f "P element not defined") + (mark-invalid)) + (else + (current-article-set #:article text))) #f) ;;; Formatting elements (xmltrans:end-tag "C" (tag attr text) @@ -627,12 +651,41 @@ (number->string count) ",now())")))) (define dict-index 0) +(define (check-node conn node) + (call-with-current-continuation + (lambda (return) + (for-each + (lambda (p-article) + (for-each + (lambda (key) + (let ((res (run-query + conn + (string-append + "SELECT locus.file,locus.line FROM dict, locus WHERE dict.word='" + key + "' AND pos=" + (number->string (p-article-get #:pos p-article)) + " AND dict.ident=locus.ident")))) + (if (not (null? res)) + (begin + (xmltrans:parse-error + (node-get #:locus node) + "Key " key "," (p-article-get #:pos p-article) + " is already in the database") + (xmltrans:parse-error + (cons (caar res) (cadar res)) + "This is the location of previous definition") + (return #f))))) + (node-get #:key node))) + (node-get #:p-list node)) + #t))) + (define (insert-node conn node) (letrec ((insert-link (lambda (type value) (run-query conn (format #f @@ -668,12 +721,22 @@ "INSERT INTO dict (ident,word,sound,pos) VALUES(~A,\"~A\",\"~A\",~A)" dict-index key sound (p-article-get #:pos p-article))))) + ;;; Insert source information + (let ((loc (node-get #:locus node))) + (run-query + conn + (format #f + "INSERT INTO locus (ident,file,line) VALUES(~A,\"~A\",~A)" + dict-index + (car loc) + (cdr loc)))) + ;;; Insert cross-references (for-each (lambda (x) (insert-link "XREF" x)) (append (node-get #:xref node) @@ -820,13 +883,14 @@ (cleanup-db conn)) (get-dict-index conn) (for-each (lambda (node) - (insert-node conn node)) + (and (check-node conn node) + (insert-node conn node))) (reverse node-list)) (pending-fixup conn) (update-stat conn) (sql-connect-close conn)) |