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 | |
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')
-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 @@ -218,14 +218,63 @@ Invariant Sections, no Front-Cover and Back-Cover Texts")) (string-append "SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word regexp \"" (ellinika:translate-input word) "\" AND dict.ident=articles.ident " "AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1"))) -(define (match-basic-regex dbh strat word) - #f) ;FIXME +;; Implementation of a Common LISP mapcan function +(define (mapcan fun list) + (apply (lambda ( . slist) + (let loop ((elt '()) + (slist slist)) + (cond + ((null? slist) + (reverse elt)) + ((not (car slist)) + (loop elt (cdr slist))) + (else + (loop (cons (car slist) elt) (cdr slist)))))) + (map fun list))) + +;; Convert SLIST, which is a list of strings, into a string of +;; comma-separated values. +(define (list->csv slist) + (apply string-append + (let loop ((elt '()) + (slist slist)) + (cond + ((null? (cdr slist)) + (reverse + (cons "\"" (cons (car slist) (cons "\"" elt))))) + (else + (loop (cons "\"," (cons (car slist) (cons "\"" elt))) + (cdr slist))))))) + +(define (match-selector dbh strat key) + (let* ((sound (ellinika:sounds-like key)) + (dlist (mapcan + (lambda (elt) + (let ((word (car elt))) + (and (dico-strat-select? strat word sound) + word))) + (my-sql-query + (dbh:conn dbh) + (string-append + "SELECT DISTINCT dict.sound FROM dict,articles " + "WHERE dict.ident=articles.ident " + "AND articles.lang='" (dbh:lang dbh) + "' ORDER BY 1"))))) + (if (not (null? dlist)) + (my-sql-query + (dbh:conn dbh) + (string-append + "SELECT DISTINCT dict.word FROM dict " + "WHERE dict.sound IN (" + (list->csv dlist) + ")")) + #f))) (define (match-default dbh strat word) (my-sql-query (dbh:conn dbh) (string-append "SELECT DISTINCT dict.word FROM dict,articles WHERE dict.sound LIKE \"" @@ -235,20 +284,23 @@ Invariant Sections, no Front-Cover and Back-Cover Texts")) (define strategy-list (list (cons "exact" match-exact) (cons "prefix" match-prefix) (cons "suffix" match-suffix) - (cons "re" match-extnd-regex) - (cons "regexp" match-basic-regex))) + (cons "re" match-extnd-regex))) (define (match-word dbh strat word) (let ((sp (assoc (dico-strat-name strat) strategy-list))) - (let ((res (if sp - ((cdr sp) dbh strat word) - (match-default dbh strat word)))) + (let ((res (cond + (sp + ((cdr sp) dbh strat word)) + ((dico-strat-selector? strat) + (match-selector dbh strat word)) + (else + (match-default dbh strat word))))) (if res (cons #f (map car res)) #f)))) (define (output res n) (let ((type (car res)) |