diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2008-06-22 11:56:02 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2008-06-22 11:56:02 +0000 |
commit | 68b9d63d7721d2c1c375c96355e9a542c62004ef (patch) | |
tree | eda423b77e24710d35d3890e34a48f1d1c467ef1 /src/ellinika | |
parent | 7d34b25dac463e53f3a93cf021f7706913deeb42 (diff) | |
download | ellinika-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.scm | 66 |
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)))) |