aboutsummaryrefslogtreecommitdiff
path: root/scm/dictrans.scm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2004-10-08 18:51:46 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2004-10-08 18:51:46 +0000
commit7c6fc162fb2c9cba19025cb3237695288216e5c5 (patch)
treedc11b08785f5acb19dba16dbad7f5c2ce7e6f333 /scm/dictrans.scm
parent72d789af56bad636cfc1a8d6e55fee928118b22b (diff)
downloadellinika-7c6fc162fb2c9cba19025cb3237695288216e5c5.tar.gz
ellinika-7c6fc162fb2c9cba19025cb3237695288216e5c5.tar.bz2
Mostly finished :^)
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@198 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'scm/dictrans.scm')
-rw-r--r--scm/dictrans.scm508
1 files changed, 339 insertions, 169 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm
index 5cfc50e..ff99dea 100644
--- a/scm/dictrans.scm
+++ b/scm/dictrans.scm
@@ -80,8 +80,11 @@
80;;;; </NODE> 80;;;; </NODE>
81 81
82(set! %load-path (cons "/usr/local/share/guile-sql" %load-path)) 82(set! %load-path (cons "/usr/local/share/guile-sql" %load-path))
83(set! %load-path (cons "/home/gray/linguae/ellinika" %load-path))
84
83(use-modules (xmltools xmltrans) 85(use-modules (xmltools xmltrans)
84 (sql) 86 (sql)
87 (ellinika xlat)
85 (ice-9 getopt-long)) 88 (ice-9 getopt-long))
86 89
87(use-syntax (ice-9 syncase)) 90(use-syntax (ice-9 syncase))
@@ -110,6 +113,31 @@
110 (newline)))) 113 (newline))))
111 114
112 115
116(define pos-xlat #f)
117
118(define (convert-pos pos)
119 (cond
120 (compile-only
121 pos)
122 ((assoc pos pos-xlat) =>
123 (lambda (x)
124 (cdr x)))
125 (else
126 (xmltrans:parse-error #f "unknown or misspelled part of speech")
127 (mark-invalid)
128 pos)))
129
130(define (read-pos conn)
131 (set! pos-xlat
132 (map
133 (lambda (p)
134 (cons (car p) (string->number (cadr p))))
135 (append
136 (run-query conn "SELECT abbr, id FROM pos")
137 (run-query conn "SELECT abbr_lat, id FROM pos")
138 (run-query conn "SELECT name, id FROM pos")))))
139
140
113;;;; XML definitions 141;;;; XML definitions
114 142
115;;; Set the default handler 143;;; Set the default handler
@@ -137,93 +165,105 @@
137 165
138(define-syntax node-get 166(define-syntax node-get
139 (syntax-rules () 167 (syntax-rules ()
140 ((node-get #:key) 168 ((node-get #:key node)
141 (vector-ref current-node 0)) 169 (vector-ref node 0))
142 ((node-get #:forms) 170 ((node-get #:forms node)
143 (vector-ref current-node 1)) 171 (vector-ref node 1))
144 ((node-get #:xref) 172 ((node-get #:xref node)
145 (vector-ref current-node 2)) 173 (vector-ref node 2))
146 ((node-get #:p-list) 174 ((node-get #:p-list node)
147 (vector-ref current-node 3)))) 175 (vector-ref node 3))))
176
177(define-macro (current-node-get key)
178 `(node-get ,key current-node))
148 179
149(define (mark-invalid) 180(define (mark-invalid)
150 (xmltrans:set-attr "NODE" "__INVALID__" 1)) 181 (xmltrans:set-attr "NODE" "__INVALID__" 1))
151 182
152(define-syntax node-set 183(define-syntax node-set
153 (syntax-rules () 184 (syntax-rules ()
154 ((node-set #:key k) 185 ((node-set #:key node k)
155 (cond 186 (cond
156 ((node-get #:key) => 187 ((node-get #:key node) =>
157 (lambda (klist) 188 (lambda (klist)
158 (vector-set! current-node 0 (append klist (list k))))) 189 (vector-set! node 0 (append klist (list k)))))
159 (else 190 (else
160 (vector-set! current-node 0 (list k))))) 191 (vector-set! node 0 (list k)))))
161 ((node-set #:forms f) 192 ((node-set #:forms node f)
162 (begin 193 (begin
163 (cond 194 (cond
164 ((node-get #:forms) 195 ((node-get #:forms node)
165 (xmltrans:parse-error #f "Forms already set") 196 (xmltrans:parse-error #f "Forms already set")
166 (mark-invalid))) 197 (mark-invalid)))
167 (vector-set! current-node 1 f))) 198 (vector-set! node 1 f)))
168 ((node-set #:xref x) 199 ((node-set #:xref node x)
169 (cond 200 (cond
170 ((node-get #:xref) => 201 ((node-get #:xref node) =>
171 (lambda (xlist) 202 (lambda (xlist)
172 (vector-set! current-node 2 (append xlist (list x))))) 203 (vector-set! node 2 (append xlist (list x)))))
173 (else 204 (else
174 (vector-set! current-node 2 (list x))))) 205 (vector-set! node 2 (list x)))))
175 ((node-set! #:p-article p) 206 ((node-set #:p-article node p)
176 (cond 207 (cond
177 ((node-get #:p-list) => 208 ((node-get #:p-list node) =>
178 (lambda (plist) 209 (lambda (plist)
179 (vector-set! current-node 3 (append plist (list p))))) 210 (vector-set! node 3 (append plist (list p)))))
180 (else 211 (else
181 (vector-set! current-node 3 (list p))))) 212 (vector-set! node 3 (list p)))))
182 ((node-set #:topic t) 213 ((node-set #:topic node t)
183 (for-each 214 (for-each
184 (lambda (p) 215 (lambda (p)
185 ;; FIXME: Use p-article-set 216 (p-article-set #:topic p t))
186 (vector-set! p 4 (append (vector-ref p 4) (list t)))) 217 (node-get #:p-list node)))))
187 (node-get #:p-list))))) 218
219(define-macro (current-node-set key val)
220 `(node-set ,key current-node ,val))
221
188 222
189(define p-article #f) 223(define p-article #f)
190 224
191(define-syntax p-article-get 225(define-syntax p-article-get
192 (syntax-rules () 226 (syntax-rules ()
193 ((p-article-get #:pos) 227 ((p-article-get #:pos article)
194 (vector-ref p-article 0)) 228 (vector-ref article 0))
195 ((p-article-get #:article) 229 ((p-article-get #:article article)
196 (vector-ref p-article 1)) 230 (vector-ref article 1))
197 ((p-article-get #:aref) 231 ((p-article-get #:aref article)
198 (vector-ref p-article 2)) 232 (vector-ref article 2))
199 ((p-article-get #:xref) 233 ((p-article-get #:xref article)
200 (vector-ref p-article 3)) 234 (vector-ref article 3))
201 ((p-article-get #:topic) 235 ((p-article-get #:topic article)
202 (vector-ref p-article 4)))) 236 (vector-ref article 4))))
203 237
204(define-syntax p-set 238(define-syntax p-set
205 (syntax-rules () 239 (syntax-rules ()
206 ((p-set key n val) 240 ((p-set key article n val)
207 (vector-set! p-article n 241 (vector-set! article n
208 (cond 242 (cond
209 ((p-article-get key) => 243 ((p-article-get key article) =>
210 (lambda (alst) 244 (lambda (alst)
211 (append alst (list val)))) 245 (append alst (list val))))
212 (else 246 (else
213 (list val))))))) 247 (list val)))))))
214 248
249(define-macro (current-article-get key)
250 `(p-article-get ,key p-article))
251
215(define-syntax p-article-set 252(define-syntax p-article-set
216 (syntax-rules () 253 (syntax-rules ()
217 ((p-article-set #:pos val) 254 ((p-article-set #:pos article val)
218 (vector-set! p-article 0 val)) 255 (vector-set! article 0 val))
219 ((p-article-set #:article val) 256 ((p-article-set #:article article val)
220 (p-set #:article 1 val)) 257 (p-set #:article article 1 val))
221 ((p-article-set #:aref val) 258 ((p-article-set #:aref article val)
222 (p-set #:aref 2 val)) 259 (p-set #:aref article 2 val))
223 ((p-article-set #:xref val) 260 ((p-article-set #:xref article val)
224 (p-set #:xref 3 val)) 261 (p-set #:xref article 3 val))
225 ((p-article-set #:topic val) 262 ((p-article-set #:topic article val)
226 (p-set #:topic 4 val)))) 263 (p-set #:topic article 4 val))))
264
265(define-macro (current-article-set key val)
266 `(p-article-set ,key p-article ,val))
227 267
228 268
229;;; Node list 269;;; Node list
@@ -251,7 +291,7 @@
251 (debug 10 "APPEND") 291 (debug 10 "APPEND")
252 (for-each 292 (for-each
253 (lambda (x) 293 (lambda (x)
254 (p-article-set #:topic x)) 294 (current-article-set #:topic x))
255 topic-list)) 295 topic-list))
256 296
257;;; 297;;;
@@ -299,17 +339,17 @@
299 (tag attr text) 339 (tag attr text)
300 (cond 340 (cond
301 (p-article 341 (p-article
302 (if (not (null? (node-get #:p-list))) 342 (if (not (null? (current-node-get #:p-list)))
303 (xmltrans:parse-warning #f "Mixed definition style")) 343 (xmltrans:parse-warning #f "Mixed definition style"))
304 (append-topics) 344 (append-topics)
305 (node-set #:p-article p-article) 345 (current-node-set #:p-article p-article)
306 (set! p-article #f))) 346 (set! p-article #f)))
307 347
308 (cond 348 (cond
309 ((xm