summaryrefslogtreecommitdiffabout
path: root/src/ellinika
authorSergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 (GMT)
commit68b9d63d7721d2c1c375c96355e9a542c62004ef (patch) (unidiff)
treeeda423b77e24710d35d3890e34a48f1d1c467ef1 /src/ellinika
parent7d34b25dac463e53f3a93cf021f7706913deeb42 (diff)
downloadellinika-68b9d63d7721d2c1c375c96355e9a542c62004ef.tar.gz
ellinika-68b9d63d7721d2c1c375c96355e9a542c62004ef.tar.bz2
Implement levenshtein, basic regex, and general-purpose selector matches.
* src/ellinika/dico.scm: Implement matching using strategy selectors. git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@528 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'src/ellinika') (more/less context) (ignore whitespace changes)
-rw-r--r--src/ellinika/dico.scm66
1 files changed, 59 insertions, 7 deletions
diff --git a/src/ellinika/dico.scm b/src/ellinika/dico.scm
index 9383d1f..c156862 100644
--- a/src/ellinika/dico.scm
+++ b/src/ellinika/dico.scm
@@ -221,8 +221,57 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
221 "\" AND dict.ident=articles.ident " 221 "\" AND dict.ident=articles.ident "
222 "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1"))) 222 "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
223 223
224(define (match-basic-regex dbh strat word) 224;; Implementation of a Common LISP mapcan function
225 #f) ;FIXME 225(define (mapcan fun list)
226 (apply (lambda ( . slist)
227 (let loop ((elt '())
228 (slist slist))
229 (cond
230 ((null? slist)
231 (reverse elt))
232 ((not (car slist))
233 (loop elt (cdr slist)))
234 (else
235 (loop (cons (car slist) elt) (cdr slist))))))
236 (map fun list)))
237
238;; Convert SLIST, which is a list of strings, into a string of
239;; comma-separated values.
240(define (list->csv slist)
241 (apply string-append
242 (let loop ((elt '())
243 (slist slist))
244 (cond
245 ((null? (cdr slist))
246 (reverse
247 (cons "\"" (cons (car slist) (cons "\"" elt)))))
248 (else
249 (loop (cons "\"," (cons (car slist) (cons "\"" elt)))
250 (cdr slist)))))))
251
252(define (match-selector dbh strat key)
253 (let* ((sound (ellinika:sounds-like key))
254 (dlist (mapcan
255 (lambda (elt)
256 (let ((word (car elt)))
257 (and (dico-strat-select? strat word sound)
258 word)))
259 (my-sql-query
260 (dbh:conn dbh)
261 (string-append
262 "SELECT DISTINCT dict.sound FROM dict,articles "
263 "WHERE dict.ident=articles.ident "
264 "AND articles.lang='" (dbh:lang dbh)
265 "' ORDER BY 1")))))
266 (if (not (null? dlist))
267 (my-sql-query
268 (dbh:conn dbh)
269 (string-append
270 "SELECT DISTINCT dict.word FROM dict "
271 "WHERE dict.sound IN ("
272 (list->csv dlist)
273 ")"))
274 #f)))
226 275
227(define (match-default dbh strat word) 276(define (match-default dbh strat word)
228 (my-sql-query 277 (my-sql-query
@@ -238,14 +287,17 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
238 (list (cons "exact" match-exact) 287 (list (cons "exact" match-exact)
239 (cons "prefix" match-prefix) 288 (cons "prefix" match-prefix)
240 (cons "suffix" match-suffix) 289 (cons "suffix" match-suffix)
241 (cons "re" match-extnd-regex) 290 (cons "re" match-extnd-regex)))
242 (cons "regexp" match-basic-regex)))
243 291
244(define (match-word dbh strat word) 292(define (match-word dbh strat word)
245 (let ((sp (assoc (dico-strat-name strat) strategy-list))) 293 (let ((sp (assoc (dico-strat-name strat) strategy-list)))
246 (let ((res (if sp 294 (let ((res (cond
247 ((cdr sp) dbh strat word) 295 (sp
248 (match-default dbh strat word)))) 296 ((cdr sp) dbh strat word))
297 ((dico-strat-selector? strat)
298 (match-selector dbh strat word))
299 (else
300 (match-default dbh strat word)))))
249 (if res 301 (if res
250 (cons #f (map car res)) 302 (cons #f (map car res))
251 #f)))) 303 #f))))

Return to:

Send suggestions and report system problems to the System administrator.