aboutsummaryrefslogtreecommitdiff
path: root/src/ellinika
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 +0000
commit68b9d63d7721d2c1c375c96355e9a542c62004ef (patch)
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')
-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
@@ -223,4 +223,53 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
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
@@ -240,4 +289,3 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
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
@@ -245,5 +293,9 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
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

Return to:

Send suggestions and report system problems to the System administrator.